From 5654b8b4c30fd783dd1d1d1eb716e4f21c0ac83e Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Fri, 15 Jul 2022 17:10:33 -0500
Subject: [bugfix] in ww::setf-many; [example] fiddling with example 10

---
 examples/10-canvas.lisp | 36 ++++++++++++++++++++++++++++--------
 1 file changed, 28 insertions(+), 8 deletions(-)

(limited to 'examples')

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
-- 
cgit v1.2.3