blob: 4bcdba8bbcc8781a41307591089f40f19e103483 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
;;; 01-bitmap-display.lisp
(defpackage #:ww.examples/1
(:use #:cl)
(:export #:start))
(in-package :ww.examples/1)
(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
:texture (ww::get-asset "Fezghoul.png"))))
(describe (ww::model-matrix bm))
(describe bm)
(describe app)
(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)))))
|