on-collision.lisp

   1 ;;; Copyright 2009-2011 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   (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))
  43
  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)
  50   ;; walk through
  51   (setf (colliding standing-rectangle) nil)
  52   (move-about moving-rectangle (desired-movement collision))
  53   (setf (colliding standing-rectangle) t))
  54
  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)))
  65
  66 (defmethod on-collision
  67     ((moving-rectangle player)
  68      (standing-rectangle bottom)
  69      (collision collision))
  70   (if (eql (direction collision) :DOWN)
  71       (call-next-method)
  72       ;; else
  73       (progn
  74         (setf (colliding standing-rectangle) nil)
  75         (move-about moving-rectangle (desired-movement collision))
  76         (setf (colliding standing-rectangle) t))))
  77
  78 (defmethod on-collision
  79     ((moving-rectangle player)
  80      (standing-rectangle moving-enemy)
  81      (collision collision))
  82   (collide-blocks moving-rectangle
  83                   standing-rectangle
  84                   collision)
  85   (setf (bounced moving-rectangle) T)
  86   (setf (mayjump moving-rectangle) T)
  87   (setf (autojump moving-rectangle) 5)
  88   (player-hits-enemy moving-rectangle
  89                      standing-rectangle
  90                      collision)
  91   (setf (colliding standing-rectangle) nil)
  92   (move-about moving-rectangle (desired-movement collision))
  93   (setf (colliding standing-rectangle) t)
  94 )
  95
  96 (defmethod on-collision
  97     ((moving-rectangle player)
  98      (standing-rectangle standing-enemy)
  99      (collision collision))
 100   (collide-blocks moving-rectangle
 101                   standing-rectangle
 102                   collision)
 103   (player-hits-enemy moving-rectangle
 104                      standing-rectangle
 105                      collision))
 106
 107 (defmethod on-collision
 108     ((moving-rectangle player)
 109      (standing-rectangle standing-item)
 110      (collision collision))
 111   (collide-blocks moving-rectangle
 112                   standing-rectangle
 113                   collision)
 114   (item-catch standing-rectangle moving-rectangle))
 115
 116 (defmethod on-collision
 117     ((moving-rectangle player)
 118      (standing-rectangle moving-item)
 119      (collision collision))
 120   (collide-blocks moving-rectangle
 121                   standing-rectangle
 122                   collision)
 123   (item-catch standing-rectangle moving-rectangle))
 124
 125
 126 ;; moving-item colliding with other objects
 127
 128 (defmethod on-collision
 129     ((moving-rectangle moving-item)
 130      (standing-rectangle player)
 131      (collision collision))
 132   (collide-blocks moving-rectangle
 133                   standing-rectangle
 134                   collision)
 135   (item-catch moving-rectangle standing-rectangle))
 136
 137 (defmethod on-collision
 138     ((moving-rectangle moving-item)
 139      (standing-rectangle bottom)
 140      (collision collision))
 141   (if (eql (direction collision) :DOWN)
 142       (call-next-method)
 143       ;; else
 144       (progn
 145         (setf (colliding standing-rectangle) nil)
 146         (move-about moving-rectangle (desired-movement collision))
 147         (setf (colliding standing-rectangle) t))))
 148
 149 (defmethod on-collision
 150     ((moving-rectangle moving-item)
 151      (standing-rectangle stone)
 152      (collision collision))
 153   (collide-blocks moving-rectangle standing-rectangle collision))
 154
 155 ;; simple-enemy special methods
 156
 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))
 163
 164 ;; burning-marshmallow special methods
 165
 166 (defmethod on-collision ((m burning-marshmallow) (s stone) (c collision))
 167   (cond
 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))
 176     (T ;; diagonal
 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))
 182
 183 (defmethod on-collision
 184     ((moving-rectangle burning-marshmallow)
 185      (standing-rectangle bottom)
 186      (collision collision))
 187   (if (eql (direction collision) :DOWN)
 188       (call-next-method)
 189       ;; else
 190       (progn
 191         (setf (colliding standing-rectangle) nil)
 192         (move-about moving-rectangle (desired-movement collision))
 193         (setf (colliding standing-rectangle) t))))
 194
 195 (defmethod on-collision
 196     ((moving-rectangle burning-marshmallow)
 197      (standing-rectangle player)
 198      (collision collision))
 199   (enemy-hits-player moving-rectangle
 200                      standing-rectangle
 201                      collision)
 202   (setf (colliding standing-rectangle) nil)
 203   (move-about moving-rectangle (desired-movement collision))
 204   (setf (colliding standing-rectangle) t))
 205
 206 (defmethod on-collision
 207     ((moving-rectangle player)
 208      (standing-rectangle burning-marshmallow)
 209      (collision collision))
 210   (enemy-hits-player standing-rectangle
 211                      moving-rectangle
 212                      collision)
 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
 217
 218 (defmethod on-collision ((m moving-enemy) (s stone) (c collision))
 219   (collide-blocks m s c))
 220
 221 (defmethod on-collision
 222     ((moving-rectangle moving-enemy)
 223      (standing-rectangle bottom)
 224      (collision collision))
 225   (if (eql (direction collision) :DOWN)
 226       (call-next-method)
 227       ;; else
 228       (progn
 229         (setf (colliding standing-rectangle) nil)
 230         (move-about moving-rectangle (desired-movement collision))
 231         (setf (colliding standing-rectangle) t))))
 232
 233 (defmethod on-collision
 234     ((moving-rectangle moving-enemy)
 235      (standing-rectangle player)
 236      (collision collision))
 237   (collide-blocks moving-rectangle
 238                   standing-rectangle
 239                   collision)
 240   (enemy-hits-player moving-rectangle
 241                      standing-rectangle
 242                      collision)
 243   (setf (colliding standing-rectangle) nil)
 244   (move-about moving-rectangle (desired-movement collision))
 245   (setf (colliding standing-rectangle) t)
 246 )