diff options
| -rw-r--r-- | examples/12-canvas-drawing-language.lisp | 26 | ||||
| -rw-r--r-- | src/canvas-language.lisp | 5 |
2 files changed, 27 insertions, 4 deletions
diff --git a/examples/12-canvas-drawing-language.lisp b/examples/12-canvas-drawing-language.lisp index 526ec2d..d79bc82 100644 --- a/examples/12-canvas-drawing-language.lisp +++ b/examples/12-canvas-drawing-language.lisp @@ -28,14 +28,32 @@ (defun filled-triangle-at (x y) (ww::move-to x y) (ww::fill-rel-path - '((-10 100) - (10 -30)))) + '((100 100) + (100 -100)))) + +(defun lower-the-bluer (x y) + (list (* 256 (/ x 500)) + (* 256 (/ y 500)) + 255 + 255)) + +(defun plaid1 (x y) + (list (mod (* x x) 256) + (mod (* y y) 256) + (mod (* x y) 256) + 255)) (defun draw-stuff (canvas time) (declare (ignorable time)) (ww::with-canvas canvas (triangle-at 100 100) - (filled-triangle-at 200 200))) + (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))) (defmethod ww:boot ((app canvas-lang-demo )) (let ((canvas @@ -50,7 +68,7 @@ (ww:add-unit app canvas) ;; handlers - (ww::add-handler canvas #'clear-and-draw) + (ww:add-handler canvas #'clear-and-draw) (ww:add-handler app #'quit) (ww:add-handler canvas #'quit))) diff --git a/src/canvas-language.lisp b/src/canvas-language.lisp index 24a3394..b77ad02 100644 --- a/src/canvas-language.lisp +++ b/src/canvas-language.lisp @@ -27,6 +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) + (setf *current-pen-color-function* + (lambda (x y) + (mapcar #'colfix (funcall fn x y))))) + (defun canvas-pen-width (n) (setf *current-pen-width* (round n))) |