马虎浏览完一遍 SICP ，设计一个玩具Lisp方言，用C++实现一个玩具解释器，勿笑版本 2.0

主要增加了图形和事件驱动，以及其它一些特性。

一个 DFS 的例子。

dfs.jk
  1; dfs.jk
  2;
  3; Copyright (C) 2012, coreBugZJ, all rights reserved.
  4;
  5; 鼠标左键点击，设置可达区域
  6; 鼠标右键点击，开始自动 dfs
  7; 左上角为起点，右下角为终点
  8;
  9; 有判重版
10;
11
12
13
14(begin
15        (var unit-len 32)
16        (var width  (div +display-width+  unit-len))
17        (var height (div +display-height+ unit-len))
18        (var elapse 500)
19
20        ;
21        ;    +-------->  x width
22        ;    |
23        ;    |
24        ;    y  height
25        ;
26        ;
27        ; dir
28        ;
29        ;           3
30        ;           |
31        ;    2  <---+---> 0
32        ;           |
33        ;           1
34        ;
35        (var dx (list 1 0 -1 0))
36        (var dy (list 0 1 0 -1))
37
38        (var img-left  (load-image "left.png"))
39        (var img-right (load-image "right.png"))
40        (var img-up    (load-image "up.png"))
41        (var img-down  (load-image "down.png"))
42        (var img-dir (list img-right img-down img-left img-up))
43        (var img-erase (load-image "erase.png"))
44        (var img-wall  (load-image "wall.png"))
45        (var img-node  (load-image "node.png"))
46
47        (var map (list2d-create height width img-wall))
48        (list2d-set-at map 1 1 img-erase)
49        (list2d-set-at map (- height 2) (- width 2) img-erase)
50
51        (var pass (list2d-create height width false))
52        (list2d-set-at pass 1 1 true)
53
54        ; stack top  [  dir x y dir x y dir x y  ]  bottom
55        (var stack-top (list 0 1 1))
56        (func draw-stack()
57                (func draw-sub(top)
58                        (if (nil? top)
59                                nil
60                                (begin
61                                        (draw-sub (rest (rest (rest top))))
62                                        (if (pair? (rest top))
63                                                nil
64                                                (put-line "not pair? (rest top)")
65                                        )
66                                        (draw-image
67                                                img-node
68                                                (* unit-len (first (rest top)))
69                                                (* unit-len (first (rest (rest top))))
70                                        )
71                                )
72                        )
73                )
74                (if (not (nil? stack-top))
75                        (begin
76                                (draw-sub (rest (rest (rest stack-top))))
77                                (if (< (first stack-top) 4)
78                                        (draw-image
79                                                (list-get-at img-dir (first stack-top))
80                                                (+ 2 (* unit-len (first (rest stack-top))))
81                                                (+ 2 (* unit-len (first (rest (rest stack-top)))))
82                                        )
83                                        (draw-image
84                                                img-node
85                                                (* unit-len (first (rest stack-top)))
86                                                (* unit-len (first (rest (rest stack-top))))
87                                        )
88                                )
89                        )
90                )
91        )
92
93        (var inited   false)
94        (var finished false)
95
96        (func draw-map()
97                (var x 0)
98                (var y 0)
99                (func draw-unit(u)
100                        (if (nil? u)
101                                nil
102                                (begin
103                                        (draw-image (first u) x y)
104                                        (set! x (+ x unit-len))
105                                        (draw-unit (rest u))
106                                )
107                        )
108                )
109                (func draw-row(r)
110                        (if (nil? r)
111                                nil
112                                (begin
113                                        (set! x 0)
114                                        (draw-unit (first r))
115                                        (set! y (+ y unit-len))
116                                        (draw-row (rest r))
117                                )
118                        )
119                )
120                (draw-row map)
121        )
122
123        (func init-display()
124                (draw-map)
125                (refresh)
126                (set-timer 1 elapse)
127        )
128
129        (func keyboard-callback(c)
130        )
131
132        (func mouse-callback(type x y flag)
133                (if inited
134                        nil
135                        (begin
136                                (if (= type +mouse-left-down+)
137                                        (begin
138                                                (var uy (div y unit-len))
139                                                (var ux (div x unit-len))
140                                                (if (and (< 0 uy (- height 1)) (< 0 ux (- width 1)))
141                                                        (begin
142                                                                (list2d-set-at
143                                                                        map
144                                                                        uy
145                                                                        ux
146                                                                        img-erase
147                                                                )
148                                                                (draw-map)
149                                                                (refresh)
150                                                        )
151                                                )
152                                        )
153                                )
154                                (if (= type +mouse-right-down+)
155                                        (begin
156                                                (set! inited true)
157                                        )
158                                )
159                        )
160                )
161        )
162
163        (func find?()
164                (and (= (- height 2) (first (rest (rest stack-top))))
165                     (= (- width 2)  (first (rest stack-top)))
166                )
167        )
168
169        (func can-move()
170                (var x (+ (list-get-at dx (first stack-top)) (first (rest stack-top))))
171                (var y (+ (list-get-at dy (first stack-top)) (first (rest (rest stack-top)))))
172                (if (same? img-wall (list2d-get-at map y x))
173                        false
174                        (if (nil? (rest (rest (rest stack-top))))
175                                true
176                                (if (= 2 (abs (- (first stack-top) (first (rest (rest (rest stack-top)))))))
177                                        false
178                                        (if (list2d-get-at pass y x)
179                                                false
180                                                true
181                                        )
182                                )
183                        )
184                )
185        )
186
187        (func move()
188                (var x (+ (list-get-at dx (first stack-top)) (first (rest stack-top))))
189                (var y (+ (list-get-at dy (first stack-top)) (first (rest (rest stack-top)))))
190                (set! stack-top (pair y stack-top))
191                (set! stack-top (pair x stack-top))
192                (set! stack-top (pair 0 stack-top))
193                (list2d-set-at pass y x true)
194        )
195
196        (func back()
197                (set! stack-top (rest (rest (rest stack-top))))
198                (if (not (nil? stack-top))
199                        (set-first! stack-top (+ 1 (first stack-top)))
200                )
201        )
202
203        (func draw-all()
204                (draw-map)
205                (draw-stack)
206                (refresh)
207        )
208
209        (func timer-callback(id)
210                (if (and inited (not finished))
211                        (if (nil? stack-top)
212                                (begin
213                                        (set! finished true)
214                                        (draw-all)
215                                )
216                                (if (find?)
217                                        (begin
218                                                (set! finished true)
219                                                (draw-all)
220                                        )
221                                        (if (> (first stack-top) 3)
222                                                (begin
223                                                        (back)
224                                                        (draw-all)
225                                                )
226                                                (if (can-move)
227                                                        (begin
228                                                                (move)
229                                                                (draw-all)
230                                                        )
231                                                        (begin
232                                                                (set-first! stack-top (+ 1 (first stack-top)))
233                                                                (draw-all)
234                                                        )
235                                                )
236                                        )
237                                )
238                        )
239                )
240        )
241
242        (display)
243)
244

joke.jk
  1; joke.jk
  2;
  3; Copyright (C) 2012, coreBugZJ, all rights reserved.
  4;
  5; 标准库文件
  6; 解释器直接通过此文件名寻找此文件，故注意放置：当与解释器在同一文件夹中。
  7; ANSI GB2312 编码
  8;
  9
10
11(begin
12        ; IO --------------------------------------------------------
13                ; 输出整数
14        (func put-integer(i)
15                (put-string (integer->string i))
16        )
17                ; 输出整数，并换行
18        (func put-integer-line(i)
19                (put-line (integer->string i))
20        )
21
22        ; math ------------------------------------------------------
23                ; 绝对值
24        (func abs(x)
25                (if (>= x 0) x (- x))
26        )
27
28                ; 平方根
29        (func sqrt
30                (var y 1)
31                (while (> (abs (- (* y y) x)) 0.0001)
32                        (set! y (/ (+ y (/ x y)) 2))
33                )
34                y
35        )
36
37        ; list ------------------------------------------------------
38                ; 创建长度为 n 的列表，并置所有元素为 v
39        (func list-create(n v)
40                (if (<= n 0)
41                        nil
42                        (pair v (list-create (- n 1) v))
43                )
44        )
45                ; 求列表长度
46        (func list-length(lis)
47                (if (nil? lis)
48                        0
49                        (if (pair? lis)
50                                (+ 1 (list-length (rest lis)))
51                                1
52                        )
53                )
54        )
55                ; 取列表中下标为 i 的元素
56                ; 认为下标从 0 开始
57        (func list-get-at(lis i)
58                (if (< i 0)
59                        nil
60                        (if (= i 0)
61                                (first lis)
62                                (list-get-at (rest lis) (- i 1))
63                        )
64                )
65        )
66                ; 设置列表中下标为 i 的元素
67        (func list-set-at(lis i v)
68                (if (< i 0)
69                        nil
70                        (if (= i 0)
71                                (set-first! lis v)
72                                (list-set-at (rest lis) (- i 1) v)
73                        )
74                )
75        )
76
77        ; list2d ----------------------------------------------------
78                ; 创建列表的列表，即二维列表，
79                ; 即，创建长度为 n 的列表，其元素也为列表，长度为 m ，元素为 v
80        (func list2d-create(n m v)
81                (if (<= n 0)
82                        nil
83                        (pair (list-create m v) (list2d-create (- n 1) m v))
84                )
85        )
86                ; 取下标为 i j 的元素
87        (func list2d-get-at(lis i j)
88                (if (< i 0)
89                        nil
90                        (if (= i 0)
91                                (list-get-at (first lis) j)
92                                (list2d-get-at (rest lis) (- i 1) j)
93                        )
94                )
95        )
96                ; 设置下标为 i j 的元素
97        (func list2d-set-at(lis i j v)
98                (if (< i 0)
99                        nil
100                        (if (= i 0)
101                                (list-set-at (first lis) j v)
102                                (list2d-set-at (rest lis) (- i 1) j v)
103                        )
104                )
105        )
106
107
108
109
110
111
112)
113

马虎浏览完一遍 SICP ，设计一个玩具Lisp方言，用C++实现一个玩具解释器，勿笑 版本 2.0