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   (setf (colliding standing-rectangle) nil)
  82   (move-about moving-rectangle (desired-movement collision))
  83   (setf (colliding standing-rectangle) t)
  84 )
  85
  86 (defmethod on-collision
  87     ((moving-rectangle player)
  88      (standing-rectangle standing-enemy)
  89      (collision collision))
  90   (collide-blocks moving-rectangle
  91                   standing-rectangle
  92                   collision)
  93   (player-hits-enemy moving-rectangle
  94                      standing-rectangle
  95                      collision))
  96
  97 (defmethod on-collision
  98     ((moving-rectangle player)
  99      (standing-rectangle standing-item)
 100      (collision collision))
 101   (collide-blocks moving-rectangle
 102                   standing-rectangle
 103                   collision)
 104   (item-catch standing-rectangle moving-rectangle))
 105
 106 (defmethod on-collision
 107     ((moving-rectangle player)
 108      (standing-rectangle moving-item)
 109      (collision collision))
 110   (collide-blocks moving-rectangle
 111                   standing-rectangle
 112                   collision)
 113   (item-catch standing-rectangle moving-rectangle))
 114
 115
 116 ;; moving-item colliding with other objects
 117
 118 (defmethod on-collision
 119     ((moving-rectangle moving-item)
 120      (standing-rectangle player)
 121      (collision collision))
 122   (collide-blocks moving-rectangle
 123                   standing-rectangle
 124                   collision)
 125   (item-catch moving-rectangle standing-rectangle))
 126
 127 (defmethod on-collision
 128     ((moving-rectangle moving-item)
 129      (standing-rectangle bottom)
 130      (collision collision))
 131   (if (eql (direction collision) :DOWN)
 132       (call-next-method)
 133       ;; else
 134       (progn
 135         (setf (colliding standing-rectangle) nil)
 136         (move-about moving-rectangle (desired-movement collision))
 137         (setf (colliding standing-rectangle) t))))
 138
 139 (defmethod on-collision
 140     ((moving-rectangle moving-item)
 141      (standing-rectangle stone)
 142      (collision collision))
 143   (collide-blocks moving-rectangle standing-rectangle collision))
 144
 145 ;; simple-enemy special methods
 146
 147 (defmethod on-collision ((m simple-enemy) (s stone) (c collision))
 148   (cond ((eql (direction c) :left)
 149          (setf (direction m) :right))
 150         ((eql (direction c) :right)
 151          (setf (direction m) :left)))
 152   (collide-blocks m s c))
 153
 154 ;; burning-marshmallow special methods
 155
 156 (defmethod on-collision ((m burning-marshmallow) (s stone) (c collision))
 157   (cond
 158     ((eql (direction c) :LEFT)
 159      (setf (horizontal-direction m) :RIGHT))
 160     ((eql (direction c) :RIGHT)
 161      (setf (horizontal-direction m) :LEFT))
 162     ((eql (direction c) :UP)
 163      (setf (vertical-direction m) :DOWN))
 164     ((eql (direction c) :DOWN)
 165      (setf (vertical-direction m) :UP))
 166     (T ;; diagonal
 167      (setf (horizontal-direction m)
 168            (if (eql (horizontal-direction m) :LEFT) :RIGHT :LEFT))
 169      (setf (vertical-direction m)
 170            (if (eql (vertical-direction m) :UP) :DOWN :UP))))
 171   (set-burning-marshmallow-animation m))
 172
 173 (defmethod on-collision
 174     ((moving-rectangle burning-marshmallow)
 175      (standing-rectangle bottom)
 176      (collision collision))
 177   (if (eql (direction collision) :DOWN)
 178       (call-next-method)
 179       ;; else
 180       (progn
 181         (setf (colliding standing-rectangle) nil)
 182         (move-about moving-rectangle (desired-movement collision))
 183         (setf (colliding standing-rectangle) t))))
 184
 185 (defmethod on-collision
 186     ((moving-rectangle burning-marshmallow)
 187      (standing-rectangle player)
 188      (collision collision))
 189   (enemy-hits-player moving-rectangle
 190                      standing-rectangle
 191                      collision)
 192   (setf (colliding standing-rectangle) nil)
 193   (move-about moving-rectangle (desired-movement collision))
 194   (setf (colliding standing-rectangle) t))
 195
 196 (defmethod on-collision
 197     ((moving-rectangle player)
 198      (standing-rectangle burning-marshmallow)
 199      (collision collision))
 200   (enemy-hits-player standing-rectangle
 201                      moving-rectangle
 202                      collision)
 203   (setf (colliding standing-rectangle) nil)
 204   (move-about moving-rectangle (desired-movement collision))
 205   (setf (colliding standing-rectangle) t))
 206 ;; moving-enemy colliding with other objects
 207
 208 (defmethod on-collision ((m moving-enemy) (s stone) (c collision))
 209   (collide-blocks m s c))
 210
 211 (defmethod on-collision
 212     ((moving-rectangle moving-enemy)
 213      (standing-rectangle bottom)
 214      (collision collision))
 215   (if (eql (direction collision) :DOWN)
 216       (call-next-method)
 217       ;; else
 218       (progn
 219         (setf (colliding standing-rectangle) nil)
 220         (move-about moving-rectangle (desired-movement collision))
 221         (setf (colliding standing-rectangle) t))))
 222
 223 (defmethod on-collision
 224     ((moving-rectangle moving-enemy)
 225      (standing-rectangle player)
 226      (collision collision))
 227   (collide-blocks moving-rectangle
 228                   standing-rectangle
 229                   collision)
 230   (enemy-hits-player moving-rectangle
 231                      standing-rectangle
 232                      collision)
 233   (setf (colliding standing-rectangle) nil)
 234   (move-about moving-rectangle (desired-movement collision))
 235   (setf (colliding standing-rectangle) t)
 236 )