1 ;;; Copyright 2009-2011 Christoph Senjak
3 (in-package :uxul-world)
5 (defmethod on-collision ((obj T) (obj2 T) collision)
6 "Per default do not react on objects at all. Warn only."
7 (format t "Warning: On-Collision is not overridden for some object
8 it is called for. Classes of Arguments: ~A ~A~%"
9 (class-name (class-of obj))
10 (class-name (class-of obj))))
12 ;; Player colliding with other objects
14 (defmethod on-collision
15 ((moving-rectangle player)
16 (standing-rectangle stone)
17 (collision collision))
18 (if (eql (direction collision) :DOWN)
19 ;; "bottom" - allow jumping again
20 (setf (mayjump moving-rectangle) T)
21 ;; "ceiling" - dont allow continuing jump
22 (if (eql (direction collision) :UP)
23 (setf (maycontjump moving-rectangle) nil))
25 (collide-blocks moving-rectangle standing-rectangle collision))
27 (defmethod on-collision
28 ((moving-rectangle player)
29 (standing-rectangle door)
30 (collision collision))
31 (cond ((find-if #'(lambda (x) (string= x (dungeon standing-rectangle))) (keys moving-rectangle))
32 (setf (keys moving-rectangle) (delete (dungeon standing-rectangle) (keys moving-rectangle) :count 1))
33 (setf (visible standing-rectangle) nil)
34 (setf (active standing-rectangle) nil)
35 (setf (colliding standing-rectangle) nil))
36 ((eql (direction collision) :DOWN)
37 ;; "bottom" - allow jumping again
38 (setf (mayjump moving-rectangle) T))
39 ;; "ceiling" - dont allow continuing jump
40 ((eql (direction collision) :UP)
41 (setf (maycontjump moving-rectangle) nil)))
42 (collide-blocks moving-rectangle standing-rectangle collision))
44 (defmethod on-collision
45 ((moving-rectangle player)
46 (standing-rectangle teleporter)
47 (collision collision))
48 ;; make rectangle active to check for overlapping
49 (setf (active standing-rectangle) T)
51 (setf (colliding standing-rectangle) nil)
52 (move-about moving-rectangle (desired-movement collision))
53 (setf (colliding standing-rectangle) t))
55 (defmethod on-collision
56 ((moving-rectangle player)
57 (standing-rectangle tulip)
58 (collision collision))
59 (setf (visible standing-rectangle) nil)
60 (setf (active standing-rectangle) nil)
61 (setf (colliding standing-rectangle) nil)
62 (if (< (power moving-rectangle) 10)
63 (incf (power moving-rectangle)))
64 (incf (tulips moving-rectangle)))
66 (defmethod on-collision
67 ((moving-rectangle player)
68 (standing-rectangle bottom)
69 (collision collision))
70 (if (eql (direction collision) :DOWN)
74 (setf (colliding standing-rectangle) nil)
75 (move-about moving-rectangle (desired-movement collision))
76 (setf (colliding standing-rectangle) t))))
78 (defmethod on-collision
79 ((moving-rectangle player)
80 (standing-rectangle moving-enemy)
81 (collision collision))
82 (collide-blocks moving-rectangle
85 (setf (bounced moving-rectangle) T)
86 (setf (mayjump moving-rectangle) T)
87 (setf (autojump moving-rectangle) 5)
88 (player-hits-enemy moving-rectangle
91 (setf (colliding standing-rectangle) nil)
92 (move-about moving-rectangle (desired-movement collision))
93 (setf (colliding standing-rectangle) t)
96 (defmethod on-collision
97 ((moving-rectangle player)
98 (standing-rectangle standing-enemy)
99 (collision collision))
100 (collide-blocks moving-rectangle
103 (player-hits-enemy moving-rectangle
107 (defmethod on-collision
108 ((moving-rectangle player)
109 (standing-rectangle standing-item)
110 (collision collision))
111 (collide-blocks moving-rectangle
114 (item-catch standing-rectangle moving-rectangle))
116 (defmethod on-collision
117 ((moving-rectangle player)
118 (standing-rectangle moving-item)
119 (collision collision))
120 (collide-blocks moving-rectangle
123 (item-catch standing-rectangle moving-rectangle))
126 ;; moving-item colliding with other objects
128 (defmethod on-collision
129 ((moving-rectangle moving-item)
130 (standing-rectangle player)
131 (collision collision))
132 (collide-blocks moving-rectangle
135 (item-catch moving-rectangle standing-rectangle))
137 (defmethod on-collision
138 ((moving-rectangle moving-item)
139 (standing-rectangle bottom)
140 (collision collision))
141 (if (eql (direction collision) :DOWN)
145 (setf (colliding standing-rectangle) nil)
146 (move-about moving-rectangle (desired-movement collision))
147 (setf (colliding standing-rectangle) t))))
149 (defmethod on-collision
150 ((moving-rectangle moving-item)
151 (standing-rectangle stone)
152 (collision collision))
153 (collide-blocks moving-rectangle standing-rectangle collision))
155 ;; simple-enemy special methods
157 (defmethod on-collision ((m simple-enemy) (s stone) (c collision))
158 (cond ((eql (direction c) :left)
159 (setf (direction m) :right))
160 ((eql (direction c) :right)
161 (setf (direction m) :left)))
162 (collide-blocks m s c))
164 ;; burning-marshmallow special methods
166 (defmethod on-collision ((m burning-marshmallow) (s stone) (c collision))
168 ((eql (direction c) :LEFT)
169 (setf (horizontal-direction m) :RIGHT))
170 ((eql (direction c) :RIGHT)
171 (setf (horizontal-direction m) :LEFT))
172 ((eql (direction c) :UP)
173 (setf (vertical-direction m) :DOWN))
174 ((eql (direction c) :DOWN)
175 (setf (vertical-direction m) :UP))
177 (setf (horizontal-direction m)
178 (if (eql (horizontal-direction m) :LEFT) :RIGHT :LEFT))
179 (setf (vertical-direction m)
180 (if (eql (vertical-direction m) :UP) :DOWN :UP))))
181 (set-burning-marshmallow-animation m))
183 (defmethod on-collision
184 ((moving-rectangle burning-marshmallow)
185 (standing-rectangle bottom)
186 (collision collision))
187 (if (eql (direction collision) :DOWN)
191 (setf (colliding standing-rectangle) nil)
192 (move-about moving-rectangle (desired-movement collision))
193 (setf (colliding standing-rectangle) t))))
195 (defmethod on-collision
196 ((moving-rectangle burning-marshmallow)
197 (standing-rectangle player)
198 (collision collision))
199 (enemy-hits-player moving-rectangle
202 (setf (colliding standing-rectangle) nil)
203 (move-about moving-rectangle (desired-movement collision))
204 (setf (colliding standing-rectangle) t))
206 (defmethod on-collision
207 ((moving-rectangle player)
208 (standing-rectangle burning-marshmallow)
209 (collision collision))
210 (enemy-hits-player standing-rectangle
213 (setf (colliding standing-rectangle) nil)
214 (move-about moving-rectangle (desired-movement collision))
215 (setf (colliding standing-rectangle) t))
216 ;; moving-enemy colliding with other objects
218 (defmethod on-collision ((m moving-enemy) (s stone) (c collision))
219 (collide-blocks m s c))
221 (defmethod on-collision
222 ((moving-rectangle moving-enemy)
223 (standing-rectangle bottom)
224 (collision collision))
225 (if (eql (direction collision) :DOWN)
229 (setf (colliding standing-rectangle) nil)
230 (move-about moving-rectangle (desired-movement collision))
231 (setf (colliding standing-rectangle) t))))
233 (defmethod on-collision
234 ((moving-rectangle moving-enemy)
235 (standing-rectangle player)
236 (collision collision))
237 (collide-blocks moving-rectangle
240 (enemy-hits-player moving-rectangle
243 (setf (colliding standing-rectangle) nil)
244 (move-about moving-rectangle (desired-movement collision))
245 (setf (colliding standing-rectangle) t)