1 ;;; Copyright 2009 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))
32 (cond ((find (dungeon standing-rectangle) (keys moving-rectangle))
33 (setf (keys moving-rectangle) (delete (dungeon standing-rectangle) (keys moving-rectangle) :count 1))
34 (setf (visible standing-rectangle) nil)
35 (setf (active standing-rectangle) nil)
36 (setf (colliding standing-rectangle) nil))
37 ((eql (direction collision) :DOWN)
38 ;; "bottom" - allow jumping again
39 (setf (mayjump moving-rectangle) T))
40 ;; "ceiling" - dont allow continuing jump
41 ((eql (direction collision) :UP)
42 (setf (maycontjump moving-rectangle) nil)))
43 (collide-blocks moving-rectangle standing-rectangle collision))
46 (defmethod on-collision
47 ((moving-rectangle player)
48 (standing-rectangle tulip)
49 (collision collision))
50 (setf (visible standing-rectangle) nil)
51 (setf (active standing-rectangle) nil)
52 (setf (colliding standing-rectangle) nil)
53 (if (< (power moving-rectangle) 10)
54 (incf (power moving-rectangle)))
55 (incf (tulips moving-rectangle)))
57 (defmethod on-collision
58 ((moving-rectangle player)
59 (standing-rectangle bottom)
60 (collision collision))
61 (if (eql (direction collision) :DOWN)
65 (setf (colliding standing-rectangle) nil)
66 (move-about moving-rectangle (desired-movement collision))
67 (setf (colliding standing-rectangle) t))))
69 (defmethod on-collision
70 ((moving-rectangle player)
71 (standing-rectangle moving-enemy)
72 (collision collision))
73 (collide-blocks moving-rectangle
76 (setf (bounced moving-rectangle) T)
77 (setf (mayjump moving-rectangle) T)
78 (setf (autojump moving-rectangle) 5)
79 (player-hits-enemy moving-rectangle
83 (defmethod on-collision
84 ((moving-rectangle player)
85 (standing-rectangle standing-enemy)
86 (collision collision))
87 (collide-blocks moving-rectangle
90 (player-hits-enemy moving-rectangle
94 (defmethod on-collision
95 ((moving-rectangle player)
96 (standing-rectangle standing-item)
97 (collision collision))
98 (collide-blocks moving-rectangle
101 (item-catch standing-rectangle moving-rectangle))
103 (defmethod on-collision
104 ((moving-rectangle player)
105 (standing-rectangle moving-item)
106 (collision collision))
107 (collide-blocks moving-rectangle
110 (item-catch standing-rectangle moving-rectangle))
113 ;; moving-item colliding with other objects
115 (defmethod on-collision
116 ((moving-rectangle moving-item)
117 (standing-rectangle player)
118 (collision collision))
119 (collide-blocks moving-rectangle
122 (item-catch moving-rectangle standing-rectangle))
124 (defmethod on-collision
125 ((moving-rectangle moving-item)
126 (standing-rectangle bottom)
127 (collision collision))
128 (if (eql (direction collision) :DOWN)
132 (setf (colliding standing-rectangle) nil)
133 (move-about moving-rectangle (desired-movement collision))
134 (setf (colliding standing-rectangle) t))))
136 (defmethod on-collision
137 ((moving-rectangle moving-item)
138 (standing-rectangle stone)
139 (collision collision))
140 (collide-blocks moving-rectangle standing-rectangle collision))
142 ;; simple-enemy special methods
144 (defmethod on-collision ((m simple-enemy) (s stone) (c collision))
145 (cond ((eql (direction c) :left)
146 (setf (direction m) :right))
147 ((eql (direction c) :right)
148 (setf (direction m) :left)))
149 (collide-blocks m s c))
151 ;; burning-marshmallow special methods
153 (defmethod on-collision ((m burning-marshmallow) (s stone) (c collision))
155 ((eql (direction c) :LEFT)
156 (setf (horizontal-direction m) :RIGHT))
157 ((eql (direction c) :RIGHT)
158 (setf (horizontal-direction m) :LEFT))
159 ((eql (direction c) :UP)
160 (setf (vertical-direction m) :DOWN))
161 ((eql (direction c) :DOWN)
162 (setf (vertical-direction m) :UP))
164 (setf (horizontal-direction m)
165 (if (eql (horizontal-direction m) :LEFT) :RIGHT :LEFT))
166 (setf (vertical-direction m)
167 (if (eql (vertical-direction m) :UP) :DOWN :UP))))
168 (set-burning-marshmallow-animation m))
170 (defmethod on-collision
171 ((moving-rectangle burning-marshmallow)
172 (standing-rectangle bottom)
173 (collision collision))
174 (if (eql (direction collision) :DOWN)
178 (setf (colliding standing-rectangle) nil)
179 (move-about moving-rectangle (desired-movement collision))
180 (setf (colliding standing-rectangle) t))))
182 (defmethod on-collision
183 ((moving-rectangle burning-marshmallow)
184 (standing-rectangle player)
185 (collision collision))
186 (enemy-hits-player moving-rectangle
189 (setf (colliding standing-rectangle) nil)
190 (move-about moving-rectangle (desired-movement collision))
191 (setf (colliding standing-rectangle) t))
193 (defmethod on-collision
194 ((moving-rectangle player)
195 (standing-rectangle burning-marshmallow)
196 (collision collision))
197 (enemy-hits-player standing-rectangle
200 (setf (colliding standing-rectangle) nil)
201 (move-about moving-rectangle (desired-movement collision))
202 (setf (colliding standing-rectangle) t))
203 ;; moving-enemy colliding with other objects
205 (defmethod on-collision ((m moving-enemy) (s stone) (c collision))
206 (collide-blocks m s c))
208 (defmethod on-collision
209 ((moving-rectangle moving-enemy)
210 (standing-rectangle bottom)
211 (collision collision))
212 (if (eql (direction collision) :DOWN)
216 (setf (colliding standing-rectangle) nil)
217 (move-about moving-rectangle (desired-movement collision))
218 (setf (colliding standing-rectangle) t))))
220 (defmethod on-collision
221 ((moving-rectangle moving-enemy)
222 (standing-rectangle player)
223 (collision collision))
224 (collide-blocks moving-rectangle
227 (enemy-hits-player moving-rectangle