1 files changed, 51 insertions, 0 deletions
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))