diff options
| -rw-r--r-- | examples/12-canvas-drawing-language.lisp | 52 | ||||
| -rw-r--r-- | src/canvas-language.lisp | 21 |
2 files changed, 34 insertions, 39 deletions
diff --git a/examples/12-canvas-drawing-language.lisp b/examples/12-canvas-drawing-language.lisp index f89a48a..8020550 100644 --- a/examples/12-canvas-drawing-language.lisp +++ b/examples/12-canvas-drawing-language.lisp @@ -9,33 +9,35 @@ (defclass canvas-lang-demo (ww:application) ()) (ww:defhandler quit - (ww::on-keydown (app scancode) + (ww:on-keydown (app scancode) (when (eql :scancode-q scancode) - (ww::stop)))) + (ww:stop)))) (ww:defhandler clear-and-draw - (ww::on-perframe (canvas time) - (ww::clear-canvas canvas :r 255 :g 255 :b 255) + (ww:on-perframe (canvas time) + (ww:clear-canvas canvas :r 255 :g 255 :b 255) (draw-stuff canvas) - (ww::blit canvas))) + (ww:blit canvas))) ;; draw a triangle, each side is a different color (defun triangle-at (x y) - (ww::move-to x y) - (ww::canvas-pen-color (list 0 200 200 255)) - (ww::stroke-rel 150 0) - (ww::canvas-pen-color (list 0 0 200 255)) - (ww::stroke-rel -50 100) - (ww::canvas-pen-color (list 0 200 0 255)) - (ww::stroke-rel -100 -100)) + (ww:with-current-pen + (ww:move-pen-to x y) + (ww:canvas-pen-color (list 0 200 200 255)) + (ww:stroke-rel 150 0) + (ww:canvas-pen-color (list 0 0 200 255)) + (ww:stroke-rel -50 100) + (ww:canvas-pen-color (list 0 200 0 255)) + (ww:stroke-rel -100 -100))) ;; draw a filled triangle using the current pen (defun filled-triangle-at (x y) - (ww::move-to x y) - (ww::fill-rel-path - '((100 100) - (100 -100)))) + (ww:with-current-pen + (ww:move-pen-to x y) + (ww:fill-rel-path + '((100 100) + (100 -100))))) ;; a pen function - gets more blue the closer x y is to 0 0 (defun lower-the-bluer (x y) @@ -53,7 +55,7 @@ ;; draws a "flower" like pinwheel using bezier curves (defun flower (&optional (petals 5)) - (ww::with-pen (:width 1) + (ww:with-pen (:width 1) (let ((r ; radius (sqrt (+ (* 25 25) (* 100 100)))) (psw ; petal semi-width @@ -69,21 +71,21 @@ (* r (cos (+ a psw)))) (list 0 0)) do - (ww::fill-rel-bezier ctls 12) + (ww:fill-rel-bezier ctls 12) ;; draw border of each petal - (ww::with-pen (:color (list 0 50 200 255)) - (ww::stroke-rel-bezier ctls 12)))))) + (ww:with-pen (:color (list 0 50 200 255)) + (ww:stroke-rel-bezier ctls 12)))))) (defun draw-stuff (canvas) - (ww::with-canvas canvas + (ww:with-canvas canvas ;; set canvas color. - (ww::canvas-pen-color #'plaid1) + (ww:canvas-pen-color #'plaid1) (filled-triangle-at 250 200) ;; temporarily use a different pen configuration - (ww::with-pen (:color #'lower-the-bluer :width 2) + (ww:with-pen (:color #'lower-the-bluer :width 2) ;; draw a flower stem - (ww::stroke-bezier + (ww:stroke-bezier '((0 0) (200 120) (50 350) (200 100) (300 400)) 12) ;; draw a flower @@ -111,7 +113,7 @@ (ww:add-handler canvas #'quit))) (defun start (&optional (side 500)) - (ww::start + (ww:start (make-instance 'canvas-lang-demo :fps 10 diff --git a/src/canvas-language.lisp b/src/canvas-language.lisp index fb3b679..8188e53 100644 --- a/src/canvas-language.lisp +++ b/src/canvas-language.lisp @@ -8,11 +8,11 @@ (defvar *current-pen-position* '(0 0)) (defvar *saved-state* nil) -(defmacro with-current-pen-state ( &body body) +(defmacro with-current-pen ( &body body) "Saves the current pen state (color width position) so that it can be restored from using (restore-pen-state) from within the BODY. After BODY executes the state is restored to whatever it was - before WITH-CURRENT-PEN-STATE was evaluated." + before WITH-CURRENT-PEN was evaluated." `(let ((*saved-state* (list *current-pen-width* @@ -21,7 +21,7 @@ ,@body)) (defmacro with-pen ((&key position (color nil color-supplied-p) width) &body body) - "Like WITH-CURRENT-PEN-STATE, but lets you set the state of the pen + "Like WITH-CURRENT-PEN, but lets you set the state of the pen EXECUTION BODY. After BODY executes, the state is restored to whatever it was before WITH-PEN-STATE was evaluated." `(let ((*current-pen-position* ,(if position nil '*current-pen-position*)) @@ -33,16 +33,9 @@ `(canvas-pen-color ,color)) ,(when width `(canvas-pen-width ,width)) - (with-current-pen-state + (with-current-pen ,@body))) -(defmacro with-pen-color (list-or-fn &body body) - "Temporarily bind pen color to the value of LIST-OR-FN and execute BODY." - `(let ((*current-pen-color* nil)) - (canvas-pen-color ,list-or-fn) - ,@body)) - - (defmacro with-canvas (canvas &body body) "Perform drawing commands in BODY using the value of CANVAS as the target of any drawing operations." @@ -50,7 +43,7 @@ (*current-pen-width* 1) (*current-pen-position* (list 0 0)) (*current-pen-color* (list 0 0 0 255))) - (with-current-pen-state + (with-current-pen ,@body))) (defun restore-pen () @@ -103,11 +96,11 @@ integer." (destructuring-bind (cx cy) *current-pen-position* (loop for (x y) in path collect (list (+ cx x) (+ cy y))))) -(defun move-to (x y) +(defun move-pen-to (x y) "Sets the pen's position without drawing. " (setf *current-pen-position* (list x y))) -(defun move-rel (dx dy) +(defun move-pen-rel (dx dy) "Moves the current pen by dx dy." (setf *current-pen-position* (mapcar #'+ *current-pen-position* (list dx dy)))) |