mu/shell/data.limg

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