136 lines
3.7 KiB
Plaintext
136 lines
3.7 KiB
Plaintext
(
|
|
(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) ()))])
|
|
(hline1 . [(def (hline1 screen y x xmax color)
|
|
(while (< x xmax)
|
|
(pixel screen x y color)
|
|
(set x (+ x 1))))])
|
|
(vline1 . [(def (vline1 screen x y ymax color)
|
|
(while (< y ymax)
|
|
(pixel screen x y color)
|
|
(set y (+ y 1))))])
|
|
(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)
|
|
(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 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)
|
|
(while (< y1 y2)
|
|
(hline1 screen y1 x1 x2 color)
|
|
(set y1 (+ y1 1))))])
|
|
(chessboard_row . [(def (chessboard_row 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 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 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 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 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 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 screen keyboard)
|
|
(circle_rainbow screen 90 90 8 1))])
|
|
))
|
|
(sandbox . (+ 3 4))
|
|
)
|