(
(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])
(ret . [mac (ret var val . body)
`(let ,var ,val ,@body ,var)])
(len . [def (len l)
if (no l)
0
(+ 1 (len (cdr l)))])
(nth . [def (nth n xs)
if (< n 1)
(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)
ret str (stream)
let c (key keyboard)
while (not (or (= c 0) (= c 10)))
(write str c)
(set c (key keyboard))])
(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)])
(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)])
(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)])
(pat . [def (pat screen)
(let w (width screen)
(let h (height screen)
(for y 0 (< y h) (++ y)
(for x 0 (< x w) (++ x)
(pixel screen x y
(* x y))))))])
(main . [def (main screen keyboard)
(pat screen)])
))
(sandbox . (pat screen))
)