用 DrScheme 画简单的图形

win_hate

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)
     

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

win_hate

• SICP 上的 draw-line 接受两个点（向量），画出两点间的连线。我们可以定义一个同样接口的函数 Draw-line
  
  
  1. 
     
  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" 上多加了一条线。
  
  
  1. 
     
  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)))
     

  复制代码
  
  
• 标准框架
  
  1. 
     
  2. (define normal-frame
     
  3.   (make-frame (make-vect 0 0) (make-vect 100 0) (make-vect 0 100)))
     

  复制代码
  
  
• X 在标准框架内作画
  
  
  1. 
     
  2. (X normal-frame)
     

  复制代码
  
  
  
  
  
• 反转的 "X",
  
  
  1. 
     
  2. ((flip-vert X) normal-frame)
     

  复制代码
  
  
  
  
  
• 在另一个框架中的 "X"
  
  
  1. 
     
  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)))
     

  复制代码
  
  
  
  
  

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

win_hate

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

GUI: PLT Graphics Toolkit.

win_hate

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

1. 
   
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)))
   

复制代码

1. 
   
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:

flip, beside:

squash:

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

win_hate

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

MMMIX

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

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

win_hate

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

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

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

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

win_hate

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

• wave4
  
  
  
  
• right split
  
  
  
  
• up split
  
  
  
  
• corner split
  
  
  
  
• square limit
  
  
  
  

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

zft19

能画曲线吗？

win_hate

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

DrScheme 提供的库能画曲线。