diff options
author | Colin Okay <colin@cicadas.surf> | 2022-07-18 10:21:08 -0500 |
---|---|---|
committer | Colin Okay <colin@cicadas.surf> | 2022-07-18 10:21:08 -0500 |
commit | 84cfbd5c52d035a166bcb8d8ce9bd566b01e4513 (patch) | |
tree | c0cf8893b683cf02c09a62add9267bb72ccc71c5 /examples/01-bitmap-display.lisp | |
parent | 55ad89e92a9796979d6f075afba74a6076f45d6d (diff) |
[add] mouse event bubbling; [example] click-and-drag to 01
Diffstat (limited to 'examples/01-bitmap-display.lisp')
-rw-r--r-- | examples/01-bitmap-display.lisp | 26 |
1 files changed, 25 insertions, 1 deletions
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))))) |