on-collision.lisp

   1 ;;; Copyright 2009 Christoph Senjak
   2
   3 (in-package :uxul-world)
   4
   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))))
  11
  12 ;; Player colliding with other objects
  13
  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))
  24       )
  25   (collide-blocks moving-rectangle standing-rectangle collision))
  26
  27 (defmethod on-collision
  28     ((moving-rectangle player)
  29      (standing-rectangle door)
  30      (collision collision))
  31
  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))
  44
  45
  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)))
  56
  57 (defmethod on-collision
  58     ((moving-rectangle player)
  59      (standing-rectangle bottom)
  60      (collision collision))
  61   (if (eql (direction collision) :DOWN)
  62       (call-next-method)
  63       ;; else
  64       (progn
  65         (setf (colliding standing-rectangle) nil)
  66         (move-about moving-rectangle (desired-movement collision))
  67         (setf (colliding standing-rectangle) t))))
  68
  69 (defmethod on-collision
  70     ((moving-rectangle player)
  71      (standing-rectangle moving-enemy)
  72      (collision collision))
  73   (collide-blocks moving-rectangle
  74                   standing-rectangle
  75                   collision)
  76   (setf (bounced moving-rectangle) T)
  77   (setf (mayjump moving-rectangle) T)
  78   (setf (autojump moving-rectangle) 5)
  79   (player-hits-enemy moving-rectangle
  80                      standing-rectangle
  81                      collision))
  82
  83 (defmethod on-collision
  84     ((moving-rectangle player)
  85      (standing-rectangle standing-enemy)
  86      (collision collision))
  87   (collide-blocks moving-rectangle
  88                   standing-rectangle
  89                   collision)
  90   (player-hits-enemy moving-rectangle
  91                      standing-rectangle
  92                      collision))
  93
  94 (defmethod on-collision
  95     ((moving-rectangle player)
  96      (standing-rectangle standing-item)
  97      (collision collision))
  98   (collide-blocks moving-rectangle
  99                   standing-rectangle
 100                   collision)
 101   (item-catch standing-rectangle moving-rectangle))
 102
 103 (defmethod on-collision
 104     ((moving-rectangle player)
 105      (standing-rectangle moving-item)
 106      (collision collision))
 107   (collide-blocks moving-rectangle
 108                   standing-rectangle
 109                   collision)
 110   (item-catch standing-rectangle moving-rectangle))
 111
 112
 113 ;; moving-item colliding with other objects
 114
 115 (defmethod on-collision
 116     ((moving-rectangle moving-item)
 117      (standing-rectangle player)
 118      (collision collision))
 119   (collide-blocks moving-rectangle
 120                   standing-rectangle
 121                   collision)
 122   (item-catch moving-rectangle standing-rectangle))
 123
 124 (defmethod on-collision
 125     ((moving-rectangle moving-item)
 126      (standing-rectangle bottom)
 127      (collision collision))
 128   (if (eql (direction collision) :DOWN)
 129       (call-next-method)
 130       ;; else
 131       (progn
 132         (setf (colliding standing-rectangle) nil)
 133         (move-about moving-rectangle (desired-movement collision))
 134         (setf (colliding standing-rectangle) t))))
 135
 136 (defmethod on-collision
 137     ((moving-rectangle moving-item)
 138      (standing-rectangle stone)
 139      (collision collision))
 140   (collide-blocks moving-rectangle standing-rectangle collision))
 141
 142 ;; simple-enemy special methods
 143
 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))
 150
 151 ;; burning-marshmallow special methods
 152
 153 (defmethod on-collision ((m burning-marshmallow) (s stone) (c collision))
 154   (cond
 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))
 163     (T ;; diagonal
 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))
 169
 170 (defmethod on-collision
 171     ((moving-rectangle burning-marshmallow)
 172      (standing-rectangle bottom)
 173      (collision collision))
 174   (if (eql (direction collision) :DOWN)
 175       (call-next-method)
 176       ;; else
 177       (progn
 178         (setf (colliding standing-rectangle) nil)
 179         (move-about moving-rectangle (desired-movement collision))
 180         (setf (colliding standing-rectangle) t))))
 181
 182 (defmethod on-collision
 183     ((moving-rectangle burning-marshmallow)
 184      (standing-rectangle player)
 185      (collision collision))
 186   (enemy-hits-player moving-rectangle
 187                      standing-rectangle
 188                      collision)
 189   (setf (colliding standing-rectangle) nil)
 190   (move-about moving-rectangle (desired-movement collision))
 191   (setf (colliding standing-rectangle) t))
 192
 193 (defmethod on-collision
 194     ((moving-rectangle player)
 195      (standing-rectangle burning-marshmallow)
 196      (collision collision))
 197   (enemy-hits-player standing-rectangle
 198                      moving-rectangle
 199                      collision)
 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
 204
 205 (defmethod on-collision ((m moving-enemy) (s stone) (c collision))
 206   (collide-blocks m s c))
 207
 208 (defmethod on-collision
 209     ((moving-rectangle moving-enemy)
 210      (standing-rectangle bottom)
 211      (collision collision))
 212   (if (eql (direction collision) :DOWN)
 213       (call-next-method)
 214       ;; else
 215       (progn
 216         (setf (colliding standing-rectangle) nil)
 217         (move-about moving-rectangle (desired-movement collision))
 218         (setf (colliding standing-rectangle) t))))
 219
 220 (defmethod on-collision
 221     ((moving-rectangle moving-enemy)
 222      (standing-rectangle player)
 223      (collision collision))
 224   (collide-blocks moving-rectangle
 225                   standing-rectangle
 226                   collision)
 227   (enemy-hits-player moving-rectangle
 228                      standing-rectangle
 229                      collision))