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))
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))
45 (defmethod on-collision
46 ((moving-rectangle player)
47 (standing-rectangle tulip)
48 (collision collision))
49 (setf (visible standing-rectangle) nil)
50 (setf (active standing-rectangle) nil)
51 (setf (colliding standing-rectangle) nil)
52 (if (< (power moving-rectangle) 10)
53 (incf (power moving-rectangle)))
54 (incf (tulips moving-rectangle)))
56 (defmethod on-collision
57 ((moving-rectangle player)
58 (standing-rectangle bottom)
59 (collision collision))
60 (if (eql (direction collision) :DOWN)
64 (setf (colliding standing-rectangle) nil)
65 (move-about moving-rectangle (desired-movement collision))
66 (setf (colliding standing-rectangle) t))))
68 (defmethod on-collision
69 ((moving-rectangle player)
70 (standing-rectangle moving-enemy)
71 (collision collision))
72 (collide-blocks moving-rectangle
75 (setf (bounced moving-rectangle) T)
76 (setf (mayjump moving-rectangle) T)
77 (setf (autojump moving-rectangle) 5)
78 (player-hits-enemy moving-rectangle
82 (defmethod on-collision
83 ((moving-rectangle player)
84 (standing-rectangle standing-enemy)
85 (collision collision))
86 (collide-blocks moving-rectangle
89 (player-hits-enemy moving-rectangle
93 (defmethod on-collision
94 ((moving-rectangle player)
95 (standing-rectangle standing-item)
96 (collision collision))
97 (collide-blocks moving-rectangle
100 (item-catch standing-rectangle moving-rectangle))
102 (defmethod on-collision
103 ((moving-rectangle player)
104 (standing-rectangle moving-item)
105 (collision collision))
106 (collide-blocks moving-rectangle
109 (item-catch standing-rectangle moving-rectangle))
112 ;; moving-item colliding with other objects
114 (defmethod on-collision
115 ((moving-rectangle moving-item)
116 (standing-rectangle player)
117 (collision collision))
118 (collide-blocks moving-rectangle
121 (item-catch moving-rectangle standing-rectangle))
123 (defmethod on-collision
124 ((moving-rectangle moving-item)
125 (standing-rectangle bottom)
126 (collision collision))
127 (if (eql (direction collision) :DOWN)
131 (setf (colliding standing-rectangle) nil)
132 (move-about moving-rectangle (desired-movement collision))
133 (setf (colliding standing-rectangle) t))))
135 (defmethod on-collision
136 ((moving-rectangle moving-item)
137 (standing-rectangle stone)
138 (collision collision))
139 (collide-blocks moving-rectangle standing-rectangle collision))
141 ;; simple-enemy special methods
143 (defmethod on-collision ((m simple-enemy) (s stone) (c collision))
144 (cond ((eql (direction c) :left)
145 (setf (direction m) :right))
146 ((eql (direction c) :right)
147 (setf (direction m) :left)))
148 (collide-blocks m s c))
150 ;; burning-marshmallow special methods
152 (defmethod on-collision ((m burning-marshmallow) (s stone) (c collision))
154 ((eql (direction c) :LEFT)
155 (setf (horizontal-direction m) :RIGHT))
156 ((eql (direction c) :RIGHT)
157 (setf (horizontal-direction m) :LEFT))
158 ((eql (direction c) :UP)
159 (setf (vertical-direction m) :DOWN))
160 ((eql (direction c) :DOWN)
161 (setf (vertical-direction m) :UP))
163 (setf (horizontal-direction m)
164 (if (eql (horizontal-direction m) :LEFT) :RIGHT :LEFT))
165 (setf (vertical-direction m)
166 (if (eql (vertical-direction m) :UP) :DOWN :UP))))
167 (set-burning-marshmallow-animation m))
169 (defmethod on-collision
170 ((moving-rectangle burning-marshmallow)
171 (standing-rectangle bottom)
172 (collision collision))
173 (if (eql (direction collision) :DOWN)
177 (setf (colliding standing-rectangle) nil)
178 (move-about moving-rectangle (desired-movement collision))
179 (setf (colliding standing-rectangle) t))))
181 (defmethod on-collision
182 ((moving-rectangle burning-marshmallow)
183 (standing-rectangle player)
184 (collision collision))
185 (enemy-hits-player moving-rectangle
188 (setf (colliding standing-rectangle) nil)
189 (move-about moving-rectangle (desired-movement collision))
190 (setf (colliding standing-rectangle) t))
192 (defmethod on-collision
193 ((moving-rectangle player)
194 (standing-rectangle burning-marshmallow)
195 (collision collision))
196 (enemy-hits-player standing-rectangle
199 (setf (colliding standing-rectangle) nil)
200 (move-about moving-rectangle (desired-movement collision))
201 (setf (colliding standing-rectangle) t))
202 ;; moving-enemy colliding with other objects
204 (defmethod on-collision ((m moving-enemy) (s stone) (c collision))
205 (collide-blocks m s c))
207 (defmethod on-collision
208 ((moving-rectangle moving-enemy)
209 (standing-rectangle bottom)
210 (collision collision))
211 (if (eql (direction collision) :DOWN)
215 (setf (colliding standing-rectangle) nil)
216 (move-about moving-rectangle (desired-movement collision))
217 (setf (colliding standing-rectangle) t))))
219 (defmethod on-collision
220 ((moving-rectangle moving-enemy)
221 (standing-rectangle player)
222 (collision collision))
223 (collide-blocks moving-rectangle
226 (enemy-hits-player moving-rectangle