1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
(
(globals . (
(mac . [(define mac (litmac litfn () ((name . params) . body)
`(define ,name (litmac litfn () ,params ,@body))))])
(def . [(mac (def (name . params) . body)
`(define ,name (fn ,params ,@body)))])
(do . [(mac (do . body) `((fn () ,@body)))])
(let . [(mac (let var val . body)
`((fn (,var) ,@body) ,val))])
(when . [(mac (when cond . body)
`(if ,cond (do ,@body) ()))])
(++ . [(mac (++ var) `(set ,var (+ ,var 1)))])
(+= . [(mac (+= var inc)
`(set ,var (+ ,var ,inc)))])
(for . [(mac (for var init test update . body)
`(let ,var ,init
(while ,test
,@body
,update)))])
(hline1 . [(def (hline1 screen y x xmax color)
(while (< x xmax)
(pixel screen x y color)
(++ x)))])
(vline1 . [(def (vline1 screen x y ymax color)
(while (< y ymax)
(pixel screen x y color)
(++ y)))])
(hline . [(def (hline screen y color)
(hline1 screen y 0 (width screen) color))])
(vline . [(def (vline screen x color)
(vline1 screen x 0 (height screen) color))])
(line . [(def (line screen x0 y0 x1 y1 color)
(let (x y) `(,x0 ,y0)
(let dx (abs (- x1 x0))
(let dy (- 0 (abs (- y1 y0)))
(let sx (sgn (- x1 x0))
(let sy (sgn (- y1 y0))
(let err (+ dx dy)
(while (not (and (= x x1)
(= y y1)))
(pixel screen x y color)
(let e2 (* err 2)
(when (>= e2 dy)
(+= x sx))
(when (<= e2 dx)
(+= y sy))
(+= err
(+ (if (>= e2 dy)
dy
0)
(if (<= e2 dx)
dx
0))))))))))))])
(read_line . [(def (read_line keyboard)
(let str (stream)
(let c (key keyboard)
(while (not (or (= c 0) (= c 10)))
(write str c)
(set c (key keyboard))))
str))])
(fill_rect . [(def (fill_rect screen x1 y1 x2 y2 color)
(for y y1 (< y y2) (++ y)
(hline1 screen y x1 x2 color)))])
(chessboard_row . [(def (chessboard_row screen px y x xmax)
(while (< x xmax)
(fill_rect screen
x y
(+ x px) (+ y px) 15)
(+= x (* px 2))))])
(chessboard . [(def (chessboard screen px)
(clear screen)
(let xmax (width screen)
(let ymax (height screen)
(for y 0 (< y ymax) (+= y px)
(chessboard_row screen px y 0 xmax)
(+= y px)
(chessboard_row screen px y px xmax)))))])
(circle . [(def (circle screen cx cy r clr)
(let x (- 0 r)
(let y 0
(let err (- 2 (* 2 r))
(let continue 1
(while continue
(pixel screen (- cx x) (+ cy y) clr)
(pixel screen (- cx y) (- cy x) clr)
(pixel screen (+ cx x) (- cy y) clr)
(pixel screen (+ cx y) (+ cy x) clr)
(set r err)
(when (<= r y)
(++ y)
(+= err
(+ 1 (* 2 y))))
(when (or (> r x) (> err y))
(++ x)
(+= err
(+ 1 (* 2 x))))
(set continue (< x 0))))))))])
(ring . [(def (ring screen cx cy r0 w clr)
(for r r0 (< r (+ r0 w)) (++ r)
(circle screen cx cy r clr)))])
(circle_rainbow . [(def (circle_rainbow scr cx cy r w)
(ring scr cx cy r w 37)
(+= r w)
(ring scr cx cy r w 33)
(+= r w)
(ring scr cx cy r w 55)
(+= r w)
(ring scr cx cy r w 52)
(+= r w)
(ring scr cx cy r w 47)
(+= r w)
(ring scr cx cy r w 45)
(+= r w)
(ring scr cx cy r w 44)
(+= r w)
(ring scr cx cy r w 42)
(+= r w)
(ring scr cx cy r w 41)
(+= r w)
(ring scr cx cy r w 40))])
(bowboard . [(def (bowboard screen r)
(let xmax (width screen)
(let ymax (height screen)
(let side (* 2 r)
(for y r (< y ymax) (+= y side)
(for x r (< x xmax) (+= x side)
(circle_rainbow screen x y (- r 100) 10)))))))])
(main . [(def (main screen keyboard)
(bowboard screen 128))])
))
(sandbox . (+ 3 4))
)
|