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