diff options
| -rw-r--r-- | examples/10-canvas.lisp | 36 | ||||
| -rw-r--r-- | src/utils.lisp | 12 |
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 |