blob: 3278af5dd4fa5b37e6f05485a664a4b0f1846190 (
plain) (
blame)
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
133
134
135
|
(
(globals . (
(mac . [(def mac (litmac litfn () (name params . body)
`(def ,name (litmac litfn () ,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) ()))])
(hline1 . [(def hline1 (fn (screen y x xmax color)
(while (< x xmax)
(pixel screen x y color)
(set x (+ x 1)))))])
(vline1 . [(def vline1 (fn (screen x y ymax color)
(while (< y ymax)
(pixel screen x y color)
(set y (+ y 1)))))])
(hline . [(def hline (fn (screen y color)
(hline1 screen y 0 (width screen) color)))])
(vline . [(def vline (fn (screen x color)
(vline1 screen x 0 (height screen) color)))])
(line . [(def line (fn (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)
(set x (+ x sx)))
(when (<= e2 dx)
(set y (+ y sy)))
(set err
(+ err
(+ (if (>= e2 dy)
dy
0)
(if (<= e2 dx)
dx
0))))))))))))))])
(read_line . [(def read_line (fn (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 (fn (screen x1 y1 x2 y2 color)
(while (< y1 y2)
(hline1 screen y1 x1 x2 color)
(set y1 (+ y1 1)))))])
(chessboard_row . [(def chessboard_row (fn (screen px y x xmax)
(while (< x xmax)
(fill_rect screen
x y
(+ x px) (+ y px) 15)
(set x (+ x (* px 2))))))])
(chessboard . [(def chessboard (fn (screen px)
(clear screen)
(let xmax (width screen)
(let ymax (height screen)
(let y 0
(while (< y ymax)
(chessboard_row screen px y 0 xmax)
(set y (+ y px))
(chessboard_row screen px y px xmax)
(set y (+ y px))))))))])
(circle . [(def circle (fn (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)
(set y (+ y 1))
(set err
(+ err
(+ 1 (* 2 y)))))
(when (or (> r x) (> err y))
(set x (+ x 1))
(set err
(+ err
(+ 1 (* 2 x)))))
(set continue (< x 0)))))))))])
(ring . [(def ring (fn(screen cx cy r w clr)
(let rmax (+ r w)
(while (< r rmax)
(circle screen cx cy r clr)
(set r (+ r 1))))))])
(circle_rainbow . [(def circle_rainbow (fn(scr cx cy r w)
(ring scr cx cy r w 37)
(set r (+ r w))
(ring scr cx cy r w 33)
(set r (+ r w))
(ring scr cx cy r w 55)
(set r (+ r w))
(ring scr cx cy r w 52)
(set r (+ r w))
(ring scr cx cy r w 47)
(set r (+ r w))
(ring scr cx cy r w 45)
(set r (+ r w))
(ring scr cx cy r w 44)
(set r (+ r w))
(ring scr cx cy r w 42)
(set r (+ r w))
(ring scr cx cy r w 41)
(set r (+ r w))
(ring scr cx cy r w 40)))])
(bowboard . [(def bowboard (fn (screen side)
(let xmax (width screen)
(let ymax (height screen)
(let y side
(while (< y ymax)
(let x side
(while (< x xmax)
(circle_rainbow screen x y (- side 100) 10)
(set x (+ x (* 2 side)))))
(set y (+ y (* 2 side)))))))))])
(main . [(def main (fn (screen keyboard)
(circle_rainbow screen 90 90 8 1)))])
(task . [(def task (fn (screen)
(circle_rainbow screen 32 24 8 1)))])
))
(sandbox . (+ 3 4))
)
|