aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--examples/14-canvas-paint.lisp33
1 files changed, 27 insertions, 6 deletions
diff --git a/examples/14-canvas-paint.lisp b/examples/14-canvas-paint.lisp
index 35c74ba..3db904e 100644
--- a/examples/14-canvas-paint.lisp
+++ b/examples/14-canvas-paint.lisp
@@ -6,7 +6,8 @@
(in-package #:ww.examples/14)
-(defclass pixel-whomp (ww:application) ())
+(defclass pixel-whomp (ww:application)
+ ())
(defclass pwcanvas (ww:canvas)
((pen-down-pos :accessor pen-down-pos :initform nil)
@@ -61,27 +62,36 @@
(ww::on-keyup ()
(setf (mode target) :draw)))
+
(ww::defhandler zoom
- (ww::on-mousewheel (target h v)
- (format t "v: ~a~% " v)
- (ww:scale-by target
- (if (plusp v) 1.1 0.9))))
+ (ww::on-mousewheel (u h v)
+ (multiple-value-bind
+ (ox oy)
+ (apply #'scale-pos-to-canvas u *last-mouse-pos*)
+ (ww:scale-by u (if (plusp v) 1.1 0.9))
+ (multiple-value-bind
+ (nx ny)
+ (apply #'scale-pos-to-canvas u *last-mouse-pos*)
+ (incf (ww:x u) (* (ww:scale-x u) (- nx ox)))
+ (incf (ww:y u) (* (ww:scale-x u) (- ny oy)))))))
(ww:defhandler canvas-mousebutton-down
(ww:on-mousedown (target x y clicks button winx winy)
(unless (pen-down-pos target)
(set-pen-position target x y)
(when (eq :draw (mode target))
- (format t "foo")
(ww::with-canvas target
(ww:with-pen (:width (pen-width target))
(apply 'ww:apply-pen-at (mapcar #'floor (pen-down-pos target))))
(ww:blit target))))))
+
(ww::defhandler canvas-mousebutton-up
(ww::on-mouseup (target)
(setf (pen-down-pos target) nil)))
+
+
(defun draw (canvas x y)
(let ((old-pos (copy-seq (pen-down-pos canvas))))
(destructuring-bind (nx ny) (set-pen-position canvas x y)
@@ -100,6 +110,15 @@
(incf (ww:x canvas) tx)
(incf (ww:y canvas) ty)))))
+(defvar *last-mouse-pos* (list 0 0))
+
+
+
+(ww::defhandler moust-tracker
+ (ww::on-mousemotion (target x y)
+ (setf (car *last-mouse-pos*) x
+ (cadr *last-mouse-pos*) y)))
+
(ww::defhandler canvas-mouse-move
(ww::on-mousemotion (target x y)
(when (pen-down-pos target)
@@ -121,6 +140,8 @@
(make-instance 'pwcanvas
:pixel-width 800
:pixel-height 800)))
+ (ww:add-handler app #'moust-tracker)
+ (ww:add-handler canvas #'moust-tracker)
(ww:add-unit canvas)))
(defun start ()