aboutsummaryrefslogtreecommitdiffhomepage
path: root/examples
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-07-28 09:38:35 -0500
committerColin Okay <colin@cicadas.surf>2022-07-28 09:38:35 -0500
commitfdfee6053fb8430566eb7a9960b77cf28826aa01 (patch)
treec372850aaa0a6c50b485ec61abd2db873ad9d096 /examples
parent259b8df3630487055f5d3e1bc98d245973b3a95e (diff)
[add] canvas-paint example; [refactor] with-current-pen
Diffstat (limited to 'examples')
-rw-r--r--examples/13-menus.lisp2
-rw-r--r--examples/14-canvas-paint.lisp51
2 files changed, 52 insertions, 1 deletions
diff --git a/examples/13-menus.lisp b/examples/13-menus.lisp
index 2c797f3..07094c8 100644
--- a/examples/13-menus.lisp
+++ b/examples/13-menus.lisp
@@ -1,4 +1,4 @@
-;;;; menus.lisp
+;;;; 13-menus.lisp
(defpackage #:ww.examples/13
(:use #:cl)
diff --git a/examples/14-canvas-paint.lisp b/examples/14-canvas-paint.lisp
new file mode 100644
index 0000000..bca6a13
--- /dev/null
+++ b/examples/14-canvas-paint.lisp
@@ -0,0 +1,51 @@
+;;;; 14-canvas-paint.lisp
+
+(defpackage #:ww.examples/14
+ (:use #:cl)
+ (:export #:start))
+
+(in-package #:ww.examples/14)
+
+(defclass pixel-whomp (ww:application) ())
+
+(defclass pwcanvas (ww:canvas)
+ ((pen-down-p :accessor pen-down-p :initform nil)))
+
+
+(ww:defhandler canvas-mousebutton-down
+ (ww:on-mousedown (target x y clicks button winx winy)
+ (format t "(~a,~a) :clicks ~a :button ~a :winx ~a :winy ~a~%"
+ x y clicks button winx winy)
+ (unless (pen-down-p target)
+ (setf (pen-down-p target) (list x y)))))
+
+(ww::defhandler canvas-mousebutton-up
+ (ww::on-mouseup (target)
+ (setf (pen-down-p target) nil)))
+
+(ww::defhandler canvas-mouse-move
+ (ww::on-mousemotion (target x y xrel yrel state)
+ (with-slots (pen-down-p) target
+ (when pen-down-p
+ (ww:with-canvas target
+ (ww:with-pen (:position pen-down-p)
+ (ww:stroke-to x y)))
+ (setf (car pen-down-p) x (cadr pen-down-p) y)
+ (ww:blit target)))))
+
+(defmethod initialize-instance :after ((ob pwcanvas) &key)
+ (ww:add-handler ob #'canvas-mousebutton-down)
+ (ww:add-handler ob #'canvas-mousebutton-up)
+ (ww:add-handler ob #'canvas-mouse-move))
+
+(defmethod ww:boot ((app pixel-whomp))
+ (let ((canvas
+ (make-instance 'pwcanvas
+ :pixel-width 800
+ :pixel-height 800)))
+ (ww:add-unit canvas)))
+
+(defun start ()
+ (ww:start
+ (make-instance 'pixel-whomp)
+ :x 2350))