From 84cfbd5c52d035a166bcb8d8ce9bd566b01e4513 Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Mon, 18 Jul 2022 10:21:08 -0500
Subject: [add] mouse event bubbling; [example] click-and-drag to 01

---
 examples/01-bitmap-display.lisp | 26 +++++++++++++++++++++++++-
 1 file changed, 25 insertions(+), 1 deletion(-)

(limited to 'examples/01-bitmap-display.lisp')

diff --git a/examples/01-bitmap-display.lisp b/examples/01-bitmap-display.lisp
index c9e0275..4bcdba8 100644
--- a/examples/01-bitmap-display.lisp
+++ b/examples/01-bitmap-display.lisp
@@ -8,6 +8,24 @@
 
 (defclass bitmap-display (ww::application ) ())
 
+(ww::defhandler dragging-unit
+    (ww::on-mousemotion (app x y)
+      (let ((unit
+              (first (ww:container-units app))))
+        (setf (ww:x unit) x
+              (ww:y unit) y))))
+
+(ww:defhandler start-drag
+    (ww:on-mousedown (target)
+      (ww::add-handler
+       (ww::unit-container target)
+       #'dragging-unit)))
+
+(ww:defhandler stop-drag
+    (ww::on-mouseup (app)
+      (ww::remove-handler app #'dragging-unit)))
+
+
 (defmethod ww::boot ((app bitmap-display))
   (let ((bm
           (make-instance 'ww::bitmap
@@ -15,13 +33,19 @@
     (describe (ww::model-matrix bm))
     (describe bm)
     (describe app)
-    (ww::add-unit app bm)))
+    (ww::add-unit app bm)
+    (ww::add-handler bm #'start-drag)
+    (ww::add-handler app #'stop-drag)
+    (format t "CLICK AND DRAG THE GHOUL~%")
+    ))
 
 
 (defun start ()
   (ww::start
    (make-instance
     'bitmap-display
+    :mouse-button-events-bubble-p t 
+    :mouse-motion-events-bubble-p t
     :asset-root (merge-pathnames
                  "examples/"
                  (asdf:system-source-directory :wheelwork)))))
-- 
cgit v1.2.3