blob: 5d33de866c17de812633033395ce92bdfbcc15dd (
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
52
53
54
55
56
57
58
59
60
61
62
63
64
|
;;; 01-bitmap-display.lisp
(defpackage #:ww.examples/2
(:use #:cl)
(:export #:start))
(in-package :ww.examples/2)
(defclass bitmap-display (ww::application ) ())
(ww::defhandler move-thing
(ww::on-keydown (unit code mods)
(case code
(:scancode-left (decf (ww::unit-x unit) (ww::unit-width unit)))
(:scancode-right (incf (ww::unit-x unit) (ww::unit-width unit)))
(:scancode-down (decf (ww::unit-y unit) (ww::unit-height unit)))
(:scancode-up (incf (ww::unit-y unit) (ww::unit-height unit)))
(:scancode-equals
(when (or (member :lshift mods) (member :rshift mods))
(incf (ww::unit-height unit) 20.0)
(incf (ww::unit-width unit) 20.0)))
(:scancode-minus
(decf (ww::unit-height unit) 20.0)
(decf (ww::unit-width unit) 20.0)))
(format t "ghoul pos: ~a,~a~%"
(ww::unit-x unit) (ww::unit-y unit))))
(ww::defhandler thing-clicked
(ww::on-mousedown (unit x y clicks button)
(format t "~a was clicked at ~a,~a!~%" unit x y)))
(ww::defhandler mouse-over
(ww::on-mousemotion (target x y xrel yrel state)
(print (list target x y xrel yrel state))))
(defmethod ww::boot ((app bitmap-display))
(let ((bm
(make-instance 'ww::bitmap
:texture (ww::get-asset "Fezghoul.png")))
(bm2
(make-instance 'ww::bitmap
:texture (ww::get-asset "RootBear.png"))))
;; first
(ww::refocus-on bm)
(ww::set-handler bm #'move-thing)
(ww::set-handler bm #'thing-clicked)
(ww::set-handler bm #'mouse-over)
(ww::add-unit app bm)
;;second
(setf (ww::unit-x bm2) 90
(ww::unit-y bm2) 90)
(ww::set-handler bm2 #'move-thing)
(ww::set-handler bm2 #'thing-clicked)
(ww::add-unit app bm2)))
(defun start ()
(ww::start (make-instance 'bitmap-display
:scale 2.0
:asset-root #P"~/projects/wheelwork/examples/")))
|
