blob: c2a7805c3ad28c0ee84f82d6526e1243693a46ef (
plain) (
tree)
|
|
(
(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)
(let (x xmax) `(0 ,(width screen))
(while (< x xmax)
(pixel screen x y color)
(set x (+ x 1))))))])
(vline . [(def vline (fn (screen x color)
(let (y ymax) `(0 ,(height screen))
(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)
((fn (dx dy sx sy)
((fn (err)
(brline1 screen x0 y0 x1 y1 dx dy sx sy err color))
(+ dx dy)))
(abs (- x1 x0))
(- 0 (abs (- y1 y0)))
(sgn (- x1 x0))
(sgn (- y1 y0)))))])
(brline1 . [(def brline1 (fn (screen x y xlast ylast dx dy sx sy err color)
(while (not (and (= x xlast) (= y ylast)))
(pixel screen x y color)
((fn (e2)
(if (>= e2 dy)
(set x (+ x sx))
())
(if (<= e2 dx)
(set y (+ y sy)))
(set err (+ err
(+
(if (>= e2 dy)
dy
0)
(if (<= e2 dx)
dx
0)))))
(* err 2)))))])
(read_line_2 . [(def read_line_2 (fn (keyboard stream)
((fn (c)
(if (= c 10)
stream
(if (= c 0)
stream
(read_line_2 keyboard (write stream c)))))
(key keyboard))))])
(read_line . [(def read_line (fn (keyboard)
(read_line_2 keyboard (stream))))])
(chessboard . [(def chessboard (fn (screen px)
(chessboard1 screen px 0 15)))])
(chessboard1 . [(def chessboard1 (fn (screen px y color)
(clear screen)
(while (< y (height screen))
(chessboard2 screen px y 0 color)
(set y (+ y px))
(chessboard2 screen px y px color)
(set y (+ y px)))))])
(chessboard2 . [(def chessboard2 (fn (screen px y x color)
(while (< x (width screen))
(fill_rect screen x y (+ x px) (+ y px) color)
(set x (+ x px))
(set x (+ x px)))))])
(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 . (fill_rect screen 0 0 8 8 2))
)
|