aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorColin Okay <okay@toyful.space>2022-07-20 14:10:00 -0500
committerColin Okay <okay@toyful.space>2022-07-20 14:10:00 -0500
commit030111b871ab1a75f299411b8e9cadad13d06b8d (patch)
treef9875eb6c90d25531d22fff5cd9562ccdb074273
parent3e6c73a2ac2899cfb094adbad028ce281503ee9c (diff)
[rename] canvas-api and updated the [example]
-rw-r--r--examples/12-canvas-drawing-language.lisp52
-rw-r--r--src/canvas-language.lisp21
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))))