( (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)) )