[bugfix] in ww::setf-many; [example] fiddling with example 10

2 files changed, 37 insertions, 11 deletions

diff --git a/examples/10-canvas.lisp b/examples/10-canvas.lisp
index cdade2b..7d701df 100644
--- a/examples/10-canvas.lisp
+++ b/examples/10-canvas.lisp
@@ -12,22 +12,42 @@
 (defclass/std canvas-example (ww::application)
   ())
 
+(defun color-clamp ( x)
+  (max (min (round x) 255) 0))
+
+(ww:defhandler color-shifts
+    (ww:on-perframe ()
+      (let ((time-class (1+ (mod time 256))))
+        (ww::with-pixels-rect (x y r g b a) (target)
+          (if (or (zerop (mod time-class (1+ x)))
+                  (zerop (mod time-class (1+ y))))
+              
+              (setf
+               r (mod (* x time) time-class)
+               g (mod (* y time) time-class)
+               b (mod time time-class)
+               a 255)
+              (ww::setf-many r g b a 0))))
+      (ww::blit target)))
+
 (defmethod ww::boot ((app canvas-example))
   "Adds the intro text and sets up the start button handler."
   (let ((c (make-instance
             'ww::canvas
-            :x 100 :y 100
-            :pixel-height 100
-            :pixel-width 100)))
+            :pixel-height 10
+            :pixel-width 10)))
     
     (ww::with-pixels-rect (x y r g b a) (c)
-      (setf r (- 255 x)
-            g (- 255 y)
-            b (+ x y)))
+      (setf r (- 255 (* 25 x))
+            g (- 255 (* 25 y))
+            b (color-clamp (* 25 (+ x y)))))
     
     (ww::blit c)
-    ;(ww:scale-by c 100)
-    (ww:add-unit app c)))
+    (setf (ww:width c) 800
+          (ww:height c) 600)
+    
+    (ww:add-unit app c)
+    (ww:add-handler c #'color-shifts )))
 
 (defun start (&optional (scale 1.0))
   (ww::start
diff --git a/src/utils.lisp b/src/utils.lisp
index 0f268be..9e1e46b 100644
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -105,9 +105,15 @@ the path."
 
 (defmacro setf-many (&rest places-and-value)
   "e.g. (setf-many a b c 10) would set a b and c to 10"
-  (let ((value-form
-          (first (last places-and-value))))
-    `(setf ,@(butlast places-and-value) ,value-form)))
+  (let* ((value-form
+           (first (last places-and-value)))
+         (value
+           (gensym))
+         (clauses
+           (loop for place in (butlast places-and-value)
+                 append `(,place ,value))))
+    `(let ((,value ,value-form))
+       (setf ,@clauses))))
 
 
 (defmacro with-line