akkartik
/
mu
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

shell: moar macros

This commit is contained in:
Kartik K. Agaram 2021-06-05 17:49:03 -07:00
parent f3ee7be683
commit 3ac99829c7
1 changed files with 42 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
shell/data.limg
View File

@ -9,14 +9,22 @@
`((fn (,var) ,@body) ,val))])
(when . [(mac (when cond . body)
`(if ,cond (do ,@body) ()))])
(++ . [(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)
(set x (+ x 1))))])
(++ x)))])
(vline1 . [(def (vline1 screen x y ymax color)
(while (< y ymax)
(pixel screen x y color)
(set y (+ y 1))))])
(++ y)))])
(hline . [(def (hline screen y color)
(hline1 screen y 0 (width screen) color))])
(vline . [(def (vline screen x color)
@ -33,17 +41,16 @@
(pixel screen x y color)
(let e2 (* err 2)
(when (>= e2 dy)
(set x (+ x sx)))
(+= x sx))
(when (<= e2 dx)
(set y (+ y sy)))
(set err
(+ err
(+ (if (>= e2 dy)
dy
0)
(if (<= e2 dx)
dx
0)))))))))))))])
(+= 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)
@ -54,13 +61,13 @@
(fill_rect . [(def (fill_rect screen x1 y1 x2 y2 color)
(while (< y1 y2)
(hline1 screen y1 x1 x2 color)
(set y1 (+ y1 1))))])
(++ y1)))])
(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)))))])
(+= x (* px 2))))])
(chessboard . [(def (chessboard screen px)
(clear screen)
(let xmax (width screen)
@ -68,9 +75,9 @@
(let y 0
(while (< y ymax)
(chessboard_row screen px y 0 xmax)
(set y (+ y px))
(+= y px)
(chessboard_row screen px y px xmax)
(set y (+ y px)))))))])
(+= y px))))))])
(circle . [(def (circle screen cx cy r clr)
(let x (- 0 r)
(let y 0
@ -83,51 +90,45 @@
(pixel screen (+ cx y) (+ cy x) clr)
(set r err)
(when (<= r y)
(set y (+ y 1))
(set err
(+ err
(+ 1 (* 2 y)))))
(++ y)
(+= err
(+ 1 (* 2 y))))
(when (or (> r x) (> err y))
(set x (+ x 1))
(set err
(+ err
(+ 1 (* 2 x)))))
(++ x)
(+= 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)))))])
(++ r))))])
(circle_rainbow . [(def (circle_rainbow scr cx cy r w)
(ring scr cx cy r w 37)
(set r (+ r w))
(+= r w)
(ring scr cx cy r w 33)
(set r (+ r w))
(+= r w)
(ring scr cx cy r w 55)
(set r (+ r w))
(+= r w)
(ring scr cx cy r w 52)
(set r (+ r w))
(+= r w)
(ring scr cx cy r w 47)
(set r (+ r w))
(+= r w)
(ring scr cx cy r w 45)
(set r (+ r w))
(+= r w)
(ring scr cx cy r w 44)
(set r (+ r w))
(+= r w)
(ring scr cx cy r w 42)
(set r (+ r w))
(+= r w)
(ring scr cx cy r w 41)
(set r (+ r w))
(+= 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))))))))])
(for y side (< y ymax) (+= y (* 2 side))
(for x side (< x xmax) (+= x (* 2 side))
(circle_rainbow screen x y (- side 100) 10))))))])
(main . [(def (main screen keyboard)
(circle_rainbow screen 90 90 8 1))])
))