blob: 070f24fa3a6559dc00e83f3be4d57089b913d8fe (
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
|
(
(globals . (
(mac . [(def mac (litmac litfn () (name params . body)
`(def ,name (litmac litfn () ,params ,@body))))])
(when . [(mac when (cond body)
`(if ,cond ,body ()))])
(let . [(mac let (var val . body)
`((fn (,var) ,@body) ,val))])
(hline . [(def hline (fn (screen y color)
(hline1 screen y 0 (width screen) color)))])
(hline1 . [(def hline1 (fn (screen y x xmax color)
(while (< x xmax)
(pixel screen x y color)
(set x (+ x 1)))))])
(vline . [(def vline (fn (screen x color)
(vline1 screen x 0 (height screen) color)))])
(vline1 . [(def vline1 (fn (screen x y ymax color)
(while (< y ymax)
(pixel screen x y color)
(set y (+ y 1)))))])
(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)))))])
(brline . [(def brline (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)))])
(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)))))])
(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))))))])
(brcircle . [(def brcircle (fn (screen cx cy r color)
((fn (x y err continue)
(while continue
(pixel screen (- cx x) (+ cy y) color)
(pixel screen (- cx y) (- cy x) color)
(pixel screen (+ cx x) (- cy y) color)
(pixel screen (+ cx y) (+ cy x) color)
(set r err)
(if (<= r y)
(set err (+ err (+ 1 (* 2 (set y (+ y 1))))))
())
(if (or (> r x) (> err y))
(set err (+ err (+ 1 (* 2 (set x (+ x 1))))))
())
(set continue (< x 0))
))
(- 0 r)
0
(- 2 (* 2 r))
1
)))])
(main . [(def main (fn (screen keyboard)
(chessboard screen 16)))])
))
(sandbox . (brline screen 1 1 5 5 4))
)
|