[fix] setting of pen function in canvas

2 files changed, 20 insertions, 12 deletions

diff --git a/examples/12-canvas-drawing-language.lisp b/examples/12-canvas-drawing-language.lisp
index d79bc82..c87876c 100644
--- a/examples/12-canvas-drawing-language.lisp
+++ b/examples/12-canvas-drawing-language.lisp
@@ -16,14 +16,17 @@
 (ww:defhandler clear-and-draw
     (ww::on-perframe (canvas time)
       (ww::clear-canvas canvas :r 255 :g 255 :b 255)
-      (draw-stuff canvas time)
+      (draw-stuff canvas)
       (ww::blit canvas)))
 
 (defun triangle-at (x y)
-    (ww::move-to x y)
-    (ww::stroke-rel 150 0)
-    (ww::stroke-rel 0 130)
-    (ww::stroke-rel -150 -130))
+  (ww::move-to x y)
+  (ww::canvas-pen-color 0 200 200 255)
+  (ww::stroke-rel 150 0)
+  (ww::canvas-pen-color 0 0 200 255)
+  (ww::stroke-rel -50 100)
+  (ww::canvas-pen-color 0 200 0 255)
+  (ww::stroke-rel -100 -100))
 
 (defun filled-triangle-at (x y)
   (ww::move-to x y)
@@ -43,17 +46,21 @@
         (mod (* x y) 256)
         255))
 
-(defun draw-stuff (canvas time)
-  (declare (ignorable time))
+(defun draw-stuff (canvas)
   (ww::with-canvas canvas
-    (triangle-at 100 100)
     (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)))
+     1000)
+        ()
+    (ww::canvas-pen-color-function)
+    (ww::canvas-pen-width 1)
+    (dotimes (x 50)
+      (when (evenp x)
+        (triangle-at 30 (+ 250 x))))))
 
 (defmethod ww:boot ((app canvas-lang-demo ))
   (let ((canvas
diff --git a/src/canvas-language.lisp b/src/canvas-language.lisp
index b77ad02..6583fc8 100644
--- a/src/canvas-language.lisp
+++ b/src/canvas-language.lisp
@@ -27,10 +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)
+(defun canvas-pen-color-function (&optional fn)
   (setf *current-pen-color-function*
-        (lambda (x y)
-          (mapcar #'colfix (funcall fn x y)))))
+        (when fn
+         (lambda (x y)
+           (mapcar #'colfix (funcall fn x y))))))
 
 (defun canvas-pen-width (n)
   (setf *current-pen-width* (round n)))