samples: dumb clicker and simple sprite editor

2 files changed, 237 insertions, 0 deletions

diff --git a/samples/dumbclicker.cl b/samples/dumbclicker.cl
new file mode 100644
index 0000000..f005653
--- /dev/null
+++ b/samples/dumbclicker.cl
@@ -0,0 +1,189 @@
+(= 1+ (fn (a) (+ 1 a)))
+(= % (fn (a b) (- a (* b (floor (/ a b))))))
+(= foreach (fn (a f) (while a (f (car a)) (= a (cdr a)))))
+
+(= vec cons)
+(= vec-copy (fn (v) (vec (car v) (cdr v))))
+(= vec-op
+   (fn (op v0 v1)
+       (vec (op (car v0) (car v1))
+            (op (cdr v0) (cdr v1)))))
+(= vec-dpoint (fn (v) (draw-pixel (car v) (cdr v))))
+(= draw-sprite
+   (fn (s p)
+       (foreach s (fn (v)
+                      (vec-dpoint (vec-op + p v))))))
+
+(= draw-digit
+   (fn (x y a)
+       (if
+         (is a 0) (draw-sprite spr0 (vec x y))
+         (is a 1) (draw-sprite spr1 (vec x y))
+         (is a 2) (draw-sprite spr2 (vec x y))
+         (is a 3) (draw-sprite spr3 (vec x y))
+         (is a 4) (draw-sprite spr4 (vec x y))
+         (is a 5) (draw-sprite spr5 (vec x y))
+         (is a 6) (draw-sprite spr6 (vec x y))
+         (is a 7) (draw-sprite spr7 (vec x y))
+         (is a 8) (draw-sprite spr8 (vec x y))
+         (is a 9) (draw-sprite spr9 (vec x y))
+         (draw-rectangle t x y a a))))
+
+(= draw-number
+   (fn (x y a)
+       (if (is a 0) (draw-digit x y 0))
+       (let div 1)
+       (while (<= div a) (= div (* div 10)))
+       (while (< 0 (floor (/ div 10)))
+              (= div (floor (/ div 10)))
+              (draw-digit x y (% (floor (/ a div)) 10))
+              (= x (+ x 4)))))
+
+(= _init
+   (fn ()
+       (= flash 0)
+       (= n 0)))
+
+(= _update
+   (fn ()
+       (if
+         (< 0 flash) (= flash (- flash 0.1))
+         (= flash 0))
+       (if (key-pressed? key-o)
+         (do
+           (= n (1+ n))
+           (= flash 1)
+           (beep)))))
+
+(= _draw
+   (fn ()
+       (set-draw-color 0.9 0.9 0.8)
+       (draw-clear)
+       (set-draw-color flash flash flash)
+       (draw-number 5 123 n)))
+
+(= spr0
+   (list
+     (cons  -1   -2 )
+     (cons  0   -2 )
+     (cons  1   -2 )
+     (cons  1   -1 )
+     (cons  1   0 )
+     (cons  1   1 )
+     (cons  1   2 )
+     (cons  0   2 )
+     (cons  -1   2 )
+     (cons  -1   1 )
+     (cons  -1   0 )
+     (cons  -1   -1 )))
+(= spr1
+   (list
+     (cons  -1   -2 )
+     (cons  0   -2 )
+     (cons  0   -1 )
+     (cons  0   0 )
+     (cons  0   1 )
+     (cons  0   2 )
+     (cons  -1   2 )
+     (cons  1   2 )))
+(= spr2
+   (list
+     (cons  -1   -2 )
+     (cons  0   -2 )
+     (cons  1   -2 )
+     (cons  1   -1 )
+     (cons  1   0 )
+     (cons  0   0 )
+     (cons  -1   0 )
+     (cons  -1   1 )
+     (cons  -1   2 )
+     (cons  0   2 )
+     (cons  1   2 )))
+(= spr3
+   (list
+     (cons  -1   -2 )
+     (cons  0   -2 )
+     (cons  1   -2 )
+     (cons  1   -1 )
+     (cons  1   0 )
+     (cons  0   0 )
+     (cons  1   1 )
+     (cons  1   2 )
+     (cons  0   2 )
+     (cons  -1   2 )))
+(= spr4
+   (list
+     (cons  -1   -2 )
+     (cons  -1   -1 )
+     (cons  -1   0 )
+     (cons  0   0 )
+     (cons  1   0 )
+     (cons  1   -1 )
+     (cons  1   -2 )
+     (cons  1   1 )
+     (cons  1   2 )))
+(= spr5
+   (list
+     (cons  -1   -2 )
+     (cons  0   -2 )
+     (cons  1   -2 )
+     (cons  -1   -1 )
+     (cons  -1   0 )
+     (cons  0   0 )
+     (cons  1   0 )
+     (cons  1   1 )
+     (cons  1   2 )
+     (cons  0   2 )
+     (cons  -1   2 )))
+(= spr6
+   (list
+     (cons  1   -2 )
+     (cons  0   -2 )
+     (cons  -1   -2 )
+     (cons  -1   -1 )
+     (cons  -1   0 )
+     (cons  -1   1 )
+     (cons  -1   2 )
+     (cons  0   2 )
+     (cons  1   2 )
+     (cons  1   1 )
+     (cons  1   0 )
+     (cons  0   0 )))
+(= spr7
+   (list
+     (cons  -1   -2 )
+     (cons  0   -2 )
+     (cons  1   -2 )
+     (cons  1   -1 )
+     (cons  1   0 )
+     (cons  1   1 )
+     (cons  1   2 )))
+(= spr8
+   (list
+     (cons  -1   -2 )
+     (cons  0   -2 )
+     (cons  1   -2 )
+     (cons  1   -1 )
+     (cons  1   0 )
+     (cons  0   0 )
+     (cons  -1   0 )
+     (cons  -1   -1 )
+     (cons  -1   1 )
+     (cons  -1   2 )
+     (cons  0   2 )
+     (cons  1   2 )
+     (cons  1   1 )))
+(= spr9
+   (list
+     (cons  -1   -2 )
+     (cons  0   -2 )
+     (cons  1   -2 )
+     (cons  1   -1 )
+     (cons  1   0 )
+     (cons  0   0 )
+     (cons  -1   0 )
+     (cons  -1   -1 )
+     (cons  1   1 )
+     (cons  1   2 )
+     (cons  0   2 )
+     (cons  -1   2 )))
diff --git a/samples/editor.cl b/samples/editor.cl
new file mode 100644
index 0000000..160bb8c
--- /dev/null
+++ b/samples/editor.cl
@@ -0,0 +1,48 @@
+(= last (fn (a) (do (while (cdr a) (= a (cdr a))) a)))
+(= append (fn (a v) (do (if a (setcdr (last a) (cons v nil)) (= a (cons v nil))) a)))
+(= foreach (fn (a f) (while a (f (car a)) (= a (cdr a)))))
+(= vec cons)
+(= vec-copy (fn (v) (vec (car v) (cdr v))))
+(= vec-op
+   (fn (op v0 v1)
+       (vec (op (car v0) (car v1))
+            (op (cdr v0) (cdr v1)))))
+(= vec-dpoint (fn (v) (draw-pixel (car v) (cdr v))))
+(= dir-vec
+   (fn (f)
+       (vec
+         (-
+           (or (and (f key-right) 1) 0)
+           (or (and (f key-left) 1) 0))
+         (-
+           (or (and (f key-down) 1) 0)
+           (or (and (f key-up) 1) 0)))))
+(= print-point (fn (v) (= v (vec-op - v center)) (print "(cons " (car v) " " (cdr v) ")")))
+
+(= _init
+   (fn ()
+       (= center-draw nil)
+       (= center (vec 128 128))
+       (= pos (vec-copy center))
+       (= points nil)))
+
+(= _update
+   (fn ()
+       (= pos (vec-op + pos (dir-vec key-pressed?)))
+       (if (key-pressed? key-o)
+         (if points
+           (append points (vec-copy pos))
+           (= points (cons (vec-copy pos) nil))))
+       (if (key-pressed? key-x) (foreach points print-point))
+       (= center-draw (not center-draw))))
+
+(= _draw
+   (fn ()
+       (set-draw-color 0.9 0.9 0.8)
+       (draw-clear)
+       (set-draw-color 0 0 0)
+       (foreach points vec-dpoint)
+       (set-draw-color 0 0 0.8)
+       (vec-dpoint pos)
+       (set-draw-color 0.9 0 0)
+       (if center-draw (vec-dpoint center))))