path: root/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) ()))])
    (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))
)