blob: 318bed424fab18569e74197560be03af63e8cf15 (
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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
;;; 01-bitmap-display.lisp
(defpackage #:ww.examples/2
(:use #:cl)
(:export #:start))
(in-package :ww.examples/2)
(defclass bitmap-display (ww::application ) ())
(defvar *shared-anim-table* (make-hash-table :synchronized t))
(ww::defhandler move-thing
(ww::on-keydown ()
"Move the target around, grow and shrink it. Print out its
position no matter what happens."
(case scancode
(:scancode-left (decf (ww::unit-x target) (ww::unit-width target)))
(:scancode-right (incf (ww::unit-x target) (ww::unit-width target)))
(:scancode-down (decf (ww::unit-y target) (ww::unit-height target)))
(:scancode-up (incf (ww::unit-y target) (ww::unit-height target)))
(:scancode-equals
(when (or (member :lshift modifiers) (member :rshift modifiers))
(incf (ww::unit-height target) 20.0)
(incf (ww::unit-width target) 20.0)))
(:scancode-minus
(decf (ww::unit-height target) 20.0)
(decf (ww::unit-width target) 20.0)))
(format t "ghoul pos: ~a,~a~%"
(ww::unit-x target) (ww::unit-y target))))
(ww::defhandler animate-move-thing
(ww::on-keydown ()
"If the target is not already involved in an animation, add a
perframe handler to the target that animates it to a new position."
(when (member scancode '(:scancode-left :scancode-right :scancode-down :scancode-up))
(unless (gethash target *shared-anim-table*)
(setf (gethash target *shared-anim-table*) t)
(let* ((tx (ww::unit-x target))
(ty (ww::unit-y target))
(destx tx)
(desty ty)
(dx 0)
(dy 0))
(case scancode
(:scancode-down (setf dy -1 desty (- ty (ww::unit-height target))))
(:scancode-up (setf dy 1 desty (+ ty (ww::unit-height target))))
(:scancode-left (setf dx -1 destx (- tx (ww::unit-width target))))
(:scancode-right (setf dx 1 destx (+ tx (ww::unit-width target)))))
(ww::set-handler
target
(ww::on-perframe ()
(with-slots ((cx ww::x) (cy ww::y)) target
(if (and (= cx destx) (= cy desty))
(progn
(remhash target *shared-anim-table*)
(ww::unset-handler target 'ww::perframe))
(setf cx (+ cx dx)
cy (+ cy dy)))))))))))
(ww::defhandler thing-clicked
(ww::on-mousedown ()
(format t "~a was clicked at ~a,~a!~%" target x y)))
(ww::defhandler flip-on-click
(ww::on-mousedown ()
(incf (ww::unit-rotation target) (ww::radians 180) )))
(ww::defhandler mouse-over
(ww::on-mousemotion ()
(print (list target x y xrel yrel state))))
(ww::defhandler look-at-me
(ww::on-focus ()
(format t "~a got focus~%" target)))
(ww::defhandler look-away
(ww::on-blur ()
(format t "~a lost focus~%" target)))
(ww::defhandler wheelie
(ww::on-mousewheel ()
(print (list :mousewheel horiz vert dir))))
(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"))))
(ww::set-handler app #'wheelie)
;; first
(ww::refocus-on bm)
(ww::set-handler bm #'animate-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 #'flip-on-click )
(ww::set-handler bm2 #'look-at-me)
(ww::set-handler bm2 #'look-away)
(ww::set-handler bm2 #'wheelie)
(ww::add-unit app bm2)))
(defun start ()
(ww::start (make-instance 'bitmap-display
:scale 2.0
:fps 30
:asset-root #P"~/projects/wheelwork/examples/")))
|
