diff options
| -rw-r--r-- | examples/12-canvas-drawing-language.lisp | 25 | ||||
| -rw-r--r-- | src/canvas-language.lisp | 7 |
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))) |