用 DrScheme 画简单的图形

Question

SICP 的 2.2.4 节描述了一种图形语言，并假定用户的 scheme 环境提供了一个 draw-line 画线原语。scheme 环境很多，有一些提供了作图支持。虽然没有图形支持也可以完成此节的习题－－只要写出基于 draw-line 的代码就可以了，但实践一下还是有好处的。

下面我将介绍一点  DrScheme 的画图功能，只涉及做 SICP 习题所需要的部分。

• import 图形库
  
  
  1. 
     
  2. (require scheme/class scheme/gui/base)
     
  复制代码
  
• 建立一个窗体
  
  
  1. 
     
  2. (define frame (new frame% (label "painter")
     
  3.                    (width 320)
     
  4.                    (height 240)))
     
  复制代码
  
  注意，上面的 frame 和书中的 frame 或框架不是同一个概念。DrScheme 的图形库基于 wxwindow，frame 的含义指一般的窗口。
  
• 在窗体中加入一张画布
  
  
  1. 
     
  2. (define canvas
     
  3.   (new canvas% (parent frame)
     
  4.        (paint-callback
     
  5.         (lambda (canvas dc) (draw-face dc)))))
     
  复制代码
  
  上面的代码指明了 canvas 的 parent 是 frame.
  
• 显示窗口
  
  
  1. 
     
  2. (send frame show #t)
     
  复制代码
  
  现在运行代码，可以得到一个空白窗口，之后就可以画图了。
  
• 获取画布和生成画笔
  
  1. 
     
  2. (define dc (send canvas get-dc))
     
  3. (define pen (make-object pen% "BLACK" 1 'solid))
     
  4. (define (draw-face dc)
     
  5.   (send dc set-pen pen)  )
     
  复制代码
  
  用 (send convas get-dc)  获取作图区域，然后可以用 send 向 dc 发送各种作图消息。
  
• 画一条直线
  
  
  1. 
     
  2. (send dc draw-line 0 0 320 240)
     
  复制代码
  

  try.drawline.png (4.7 KB, 下载次数: 23)

  下载附件

  2008-10-04 22:10 上传

  
  
  [ 本帖最后由 win_hate 于 2008-10-4 23:58 编辑 ]

Answer 1

原帖由 zft19 于 2008-10-18 13:16 发表
能画曲线吗？

DrScheme 提供的库能画曲线。

Answer 2

能画曲线吗？

Answer 3

把书上的其它几个图都画出来了。

• wave4

  

  wave4.png (6.57 KB, 下载次数: 28)

  下载附件

  2008-10-07 18:48 上传

  
  

• right split

  

  right.split.png (17.06 KB, 下载次数: 22)

  下载附件

  2008-10-07 18:48 上传

  
  

• up split

  

  up.split.png (13.26 KB, 下载次数: 19)

  下载附件

  2008-10-07 18:48 上传

  
  

• corner split

  

  corner.split.png (22.11 KB, 下载次数: 22)

  下载附件

  2008-10-07 18:48 上传

  
  

• square limit

  

  square.limit.png (32.12 KB, 下载次数: 29)

  下载附件

  2008-10-07 18:48 上传

  
  

[ 本帖最后由 win_hate 于 2008-10-7 18:51 编辑 ]

Answer 4

原帖由 MMMIX 于 2008-10-6 22:38 发表

这个貌似拿透明的坐标纸来搞比较方便点

还没见过这么高级的装备呢，

[ 本帖最后由 win_hate 于 2008-10-7 18:49 编辑 ]

Answer 5

原帖由 win_hate 于 2008-10-6 21:15 发表
我可是拿尺子按书上的图一个点一个点量的，苦。

这个貌似拿透明的坐标纸来搞比较方便点

Answer 6

注意那个 squash。以前看《西游记》的时候，那些妖精就是这样飞的，不知该剧的美工是不是看过 SICP?

Answer 7

终于把那个邪恶的 wave 画出来了。我可是拿尺子按书上的图一个点一个点量的，苦。

2. (define (list->segment xs)
3.   (define (f r x xs)
4.     (if (null? xs) r
5.         (f (cons (make-segment x (car xs)) r) (car xs) (cdr xs))))
6.   (f '() (car xs) (cdr xs)))

复制代码

2. (define wave
3.   (let ((v1 (list (make-vect 0 26)
4.                   (make-vect 6 17)
5.                   (make-vect 12 25)
6.                   (make-vect 14 21)
7.                   (make-vect 10 0)))
8.         (v2 (list (make-vect 16 0)
9.                   (make-vect 21 13)
10.                   (make-vect 25 0)))
11.         (v3 (list (make-vect 31 0)
12.                   (make-vect 25 19)
13.                   (make-vect 41 6)))
14.         (v4 (list (make-vect 41 15)
15.                   (make-vect 31 27)
16.                   (make-vect 25 27)
17.                   (make-vect 27 35)
18.                   (make-vect 25 41)))
19.         (v5 (list (make-vect 16 41)
20.                   (make-vect 14 35)
21.                   (make-vect 16 27)
22.                   (make-vect 12 27)
23.                   (make-vect 6 25)
24.                   (make-vect 0 35))))                  
25.     (let ((segments (map (lambda (z) (list->segment
26.                                      (map (lambda (x) (map (lambda (y) (/ y 41.0)) x)) z)))
27.                         (list v1 v2 v3 v4 v5))))
28.       (segments->painter (foldr append '() segments)))))

复制代码

wave:

wave.png (5.32 KB, 下载次数: 21)

下载附件

2008-10-06 21:15 上传

flip, beside:

flip.beside.png (6.86 KB, 下载次数: 24)

下载附件

2008-10-06 21:15 上传

squash:

xie.png (6.26 KB, 下载次数: 17)

下载附件

2008-10-06 21:15 上传

[ 本帖最后由 win_hate 于 2008-10-6 21:19 编辑 ]

Answer 8

要做 SICP 中的相关习题，上面的知识足够了。如果想继续深入，可以看 PLT Scheme 的帮助文档：

GUI: PLT Graphics Toolkit.

Answer 9

• SICP 上的 draw-line 接受两个点（向量），画出两点间的连线。我们可以定义一个同样接口的函数 Draw-line
  2. (define (Draw-line w v)
  3.   (send dc draw-line (xcor-vect w) (ycor-vect w)
  4.         (xcor-vect v) (ycor-vect v)))

  复制代码

  并把 segments->painter 中的 draw-line 替换为我们的 Draw-line. 注意，这里的 Draw-line 使用了“全局变量” dc.

• 其中一个题目，画家 "X"，为了看出效果，我在 "X" 上多加了一条线。
  2. (define X
  3.   (let* ((y (make-segment (make-vect 0 0) (make-vect 1 1)))
  4.          (z (list (make-segment (make-vect 0 1) (make-vect 1 0)) y))
  5.          (x (cons (make-segment (make-vect 0 0) (make-vect 1 0)) z)))
  6.     (segments->painter x)))

  复制代码

• 标准框架
  2. (define normal-frame
  3.   (make-frame (make-vect 0 0) (make-vect 100 0) (make-vect 0 100)))

  复制代码

• X 在标准框架内作画
  2. (X normal-frame)

  复制代码

  

  X.noraml.png (4.52 KB, 下载次数: 23)

  下载附件

  2008-10-04 22:23 上传

  
  

• 反转的 "X",
  2. ((flip-vert X) normal-frame)

  复制代码

  

  flip.vert.png (4.52 KB, 下载次数: 23)

  下载附件

  2008-10-04 22:23 上传

  
  

• 在另一个框架中的 "X"
  2. (let ((O (make-vect (- 160 (* (sqrt 2) 50)) 120))
  3.         (v1 (make-vect (* (sqrt 2) 50) (* (sqrt 2) -50)))
  4.         (v2 (make-vect (* (sqrt 2) 50) (* (sqrt 2) 50))))
  5.     (X (list O v1 v2)))

  复制代码

  

  X.transformed.png (4.14 KB, 下载次数: 20)

  下载附件

  2008-10-04 22:23 上传

  
  

[ 本帖最后由 win_hate 于 2008-10-4 22:28 编辑 ]