(
(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) ()))])
(iflet . [(mac (iflet var expr then else)
`(let ,var ,expr
(if ,var ,then ,else)))])
(aif . [(mac (aif expr then else)
`(iflet it ,expr ,then ,else))])
(list . [(def (list . args)
# we should probably make a copy here
args)])
(len . [(def (len l)
(if (no l)
0
(+ 1 (len (cdr l)))))])
(nth . [(def (nth n xs)
(if (<= n 0)
(car xs)
(nth (- n 1) (cdr xs))))])
(map1 . [(def (map1 f xs)
(if (no xs)
()
(cons (f (car xs))
(map1 f (cdr xs)))))])
(compose . [(def (compose f g)
(fn args
(f (g args))))])
(some . [(def (some f xs)
(if (no xs)
()
(if (f (car xs))
xs
(some f (cdr xs)))))])
(any . some)
(all . [(def (all f xs)
(if (no xs)
1
(if (f (car xs))
(all f (cdr xs))
())))])
(find . [(def (find x xs)
(if (no xs)
()
(if (= x (car xs))
1
(find x (cdr xs)))))])
(afn . [(mac (afn params . body)
`(let self ()
(set self (fn ,params ,@body))))])
(seq . [(def (seq n)
((afn (i)
(if (> i n)
()
(cons i (self (+ i 1)))))
1))])
(each . [(mac (each x xs . body)
`(walk ,xs (fn (,x) ,@body)))])
(walk . [(def (walk xs f)
(when xs
(f (car xs))
(walk (cdr xs) f))) ])
(rem . [(def (rem f xs)
(if (no xs)
()
(let rest (rem f (cdr xs))
(if (f (car xs))
rest
(cons (car xs) rest)))))])
(keep . [(def (keep f xs)
(if (no xs)
()
(let rest (keep f (cdr xs))
(if (f (car xs))
(cons (car xs) rest)
rest))))])
(++ . [(mac (++ var) `(set ,var (+ ,var 1)))])
(+= . [(mac (+= var inc)
`(set ,var (+ ,var ,inc)))])
(for . [(mac (for var init test update . body)
`(let ,var ,init
(while ,test
,@body
,update)))])
(hline1 . [(def (hline1 screen y x xmax color)
(while (< x xmax)
(pixel screen x y color)
(++ x)))])
(vline1 . [(def (vline1 screen x y ymax color)
(while (< y ymax)
(pixel screen x y color)
(++ y)))])
(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)
(+= x sx))
(when (<= e2 dx)
(+= y sy))
(+= 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))])
(wait . [(def (wait keyboard)
(while (= 0 (key keyboard))))])
(sq . [(def (sq n) (* n n))])
(cube . [(def (cube n) (* (* n n) n))])
(fill_rect . [(def (fill_rect screen x1 y1 x2 y2 color)
(for y y1 (< y y2) (++ y)
(hline1 screen y x1 x2 color)))])
(chessboard_row . [(def (chessboard_row screen px y x xmax)
(while (< x xmax)
(fill_rect screen
x y
(+ x px) (+ y px) 15)
(+= x (* px 2))))])
(chessboard . [(def (chessboard screen px)
(clear screen)
(let xmax (width screen)
(let ymax (height screen)
(for y 0 (< y ymax) (+= y px)
(chessboard_row screen px y 0 xmax)
(+= y px)
(chessboard_row screen px y px xmax)))))])
(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)
(++ y)
(+= err
(+ 1 (* 2 y))))
(when (or (> r x) (> err y))
(++ x)
(+= err
(+ 1 (* 2 x))))
(set continue (< x 0))))))))])
(ring . [(def (ring screen cx cy r0 w clr)
(for r r0 (< r (+ r0 w)) (++ r)
(circle screen cx cy r clr)))])
(circle_rainbow . [(def (circle_rainbow scr cx cy r w)
(ring scr cx cy r w 37)
(+= r w)
(ring scr cx cy r w 33)
(+= r w)
(ring scr cx cy r w 55)
(+= r w)
(ring scr cx cy r w 52)
(+= r w)
(ring scr cx cy r w 47)
(+= r w)
(ring scr cx cy r w 45)
(+= r w)
(ring scr cx cy r w 44)
(+= r w)
(ring scr cx cy r w 42)
(+= r w)
(ring scr cx cy r w 41)
(+= r w)
(ring scr cx cy r w 40))])
(bowboard . [(def (bowboard screen r)
(let xmax (width screen)
(let ymax (height screen)
(let side (* 2 r)
(for y r (< y ymax) (+= y side)
(for x r (< x xmax) (+= x side)
(circle_rainbow screen x y (- r 100) 10)))))))])
(Greys . [(define Greys
(map1 (fn(n) (+ n 15))
(seq 16)))])
(Pinks . [(define Pinks '(84 85 59 60 61
13 36 37 5 108))])
(palette . [(def (palette p i)
(nth (% i (len p)) p))])
(task . [(def (task screen keyboard)
(let width (width screen)
(let t (/ width 3)
(let height (height screen)
(let (i y) '(1 0)
(while (< y height)
(hline1 screen y 0 t
# color
(if (= 0 (% i 3))
10
7))
(hline1 screen y t (* 2 t)
# color
(if (= 0 (% i 5))
12
7))
(hline1 screen y (* 2 t) (* 3 t)
# color
(if (= 0 (% i 3))
(if (= 0 (% i 5))
14
10)
(if (= 0 (% i 5))
12
7)))
(+= y 3)
(++ i)))))))])
(main . [(def (main screen keyboard)
(task screen keyboard))])
))
(sandbox . (task screen keyboard))
)