blob: 9e4710f02ca78bebb58d5ddd5e91a1eefe6ff454 (
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
;;; 01-image-transforms-and-events.lisp
(defpackage #:ww.examples/2
(:use #:cl)
(:export #:start))
(in-package :ww.examples/2)
(defclass image-transforms-etc (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::x target) 4))
(:scancode-right (incf (ww::x target) 4))
(:scancode-down (decf (ww::y target) 4))
(:scancode-up (incf (ww::y target) 4))
(:scancode-w (incf (ww::width target) 20))
(:scancode-r (incf (ww::rotation target) (/ pi 3)))
(:scancode-l (decf (ww::rotation target) (/ pi 3)))
(:scancode-equals
(when (or (member :lshift modifiers) (member :rshift modifiers))
(ww::scale-by target 1.10)))
(:scancode-minus
(ww::scale-by target 0.9)))
(format t "ghoul pos: ~a,~a~%"
(ww::x target) (ww::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::x target))
(ty (ww::y target))
(destx tx)
(desty ty)
(dx 0)
(dy 0))
(case scancode
(:scancode-down (setf dy -1 desty (- ty (ww::height target))))
(:scancode-up (setf dy 1 desty (+ ty (ww::height target))))
(:scancode-left (setf dx -1 destx (- tx (ww::width target))))
(:scancode-right (setf dx 1 destx (+ tx (ww::width target)))))
(ww::add-handler
target
(ww::on-perframe ()
(with-accessors ((cx ww::x) (cy ww::y)) target
(if (and (= cx destx) (= cy desty))
(progn
(remhash target *shared-anim-table*)
(ww::remove-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::rotation target) (ww::radians 180) )))
(ww::defhandler twirl-on-click
(ww::on-mousedown ()
(unless (gethash target *shared-anim-table*)
(let ((rot 0))
(setf (gethash target *shared-anim-table*) t)
(ww::add-handler
target
(ww::on-perframe ()
(if (< rot (* 8 pi))
(setf rot (+ 0.3 rot)
(ww::rotation target) rot)
(progn
(setf (ww::rotation target) 0.0)
(ww::remove-handler target 'ww::perframe)
(remhash target *shared-anim-table*)))))))))
(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 image-transforms-etc))
(let ((bm
(make-instance 'ww::image
:texture (ww::get-asset "Fezghoul.png")))
(bm2
(make-instance 'ww::image
:texture (ww::get-asset "GelatinousCube.png")
:alpha 0.5)))
(ww::add-handler app #'wheelie)
;; first
(ww::refocus-on bm)
(ww::add-handler bm #'animate-move-thing )
(ww::add-handler bm #'thing-clicked)
(ww::add-handler bm #'mouse-over)
;;second
(setf (ww::x bm2) 90
(ww::y bm2) 90)
(ww::add-handler bm2 #'move-thing)
(ww::add-handler bm2 #'twirl-on-click )
(ww::add-handler bm2 #'look-at-me)
(ww::add-handler bm2 #'look-away)
(ww::add-handler bm2 #'wheelie)
(ww::add-unit bm)
(ww::add-unit bm2)))
(defun start ()
(ww::start (make-instance 'image-transforms-etc
:scale 2.0
:fps 60
:width 800
:height 600
:asset-root (merge-pathnames
"examples/"
(asdf:system-source-directory :wheelwork)))))
|
