[example] fiddling with the example

2 files changed, 27 insertions, 4 deletions

diff --git a/examples/12-canvas-drawing-language.lisp b/examples/12-canvas-drawing-language.lisp
index 526ec2d..d79bc82 100644
--- a/examples/12-canvas-drawing-language.lisp
+++ b/examples/12-canvas-drawing-language.lisp
@@ -28,14 +28,32 @@
 (defun filled-triangle-at (x y)
   (ww::move-to x y)
   (ww::fill-rel-path
-   '((-10 100)
-     (10 -30))))
+   '((100 100)
+     (100 -100))))
+
+(defun lower-the-bluer (x y)
+  (list (* 256 (/ x 500))
+        (* 256 (/ y 500))
+        255
+        255))
+
+(defun plaid1 (x y)
+  (list (mod (* x x) 256)
+        (mod (* y y) 256)
+        (mod (* x y) 256)
+        255))
 
 (defun draw-stuff (canvas time)
   (declare (ignorable time))
   (ww::with-canvas canvas
     (triangle-at 100 100)
-    (filled-triangle-at 200 200)))
+    (ww::canvas-pen-color-function #'plaid1)
+    (filled-triangle-at 250 200)
+    (ww::canvas-pen-color-function  #'lower-the-bluer)
+    (ww::canvas-pen-width 2)
+    (ww::stroke-bezier
+     '((0 0) (200 120) (50 350) (200 100) (300 400))
+     1000)))
 
 (defmethod ww:boot ((app canvas-lang-demo ))
   (let ((canvas
@@ -50,7 +68,7 @@
     (ww:add-unit app canvas)
 
     ;; handlers
-    (ww::add-handler canvas #'clear-and-draw)
+    (ww:add-handler canvas #'clear-and-draw)
     (ww:add-handler app #'quit)
     (ww:add-handler canvas #'quit)))
 
diff --git a/src/canvas-language.lisp b/src/canvas-language.lisp
index 24a3394..b77ad02 100644
--- a/src/canvas-language.lisp
+++ b/src/canvas-language.lisp
@@ -27,6 +27,11 @@
 (defun canvas-pen-color (r g b a)
   (setf *current-pen-color* (mapcar #'colfix (list r g b a))))
 
+(defun canvas-pen-color-function (fn)
+  (setf *current-pen-color-function*
+        (lambda (x y)
+          (mapcar #'colfix (funcall fn x y)))))
+
 (defun canvas-pen-width (n)
   (setf *current-pen-width* (round n)))