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 tulip)
  30      (collision collision))
  31   (setf (visible standing-rectangle) nil)
  32   (setf (active standing-rectangle) nil)
  33   (setf (colliding standing-rectangle) nil)
  34   (if (< (power moving-rectangle) 10)
  35       (incf (power moving-rectangle)))
  36   (incf (tulips moving-rectangle)))
  37
  38 (defmethod on-collision
  39     ((moving-rectangle player)
  40      (standing-rectangle bottom)
  41      (collision collision))
  42   (if (eql (direction collision) :DOWN)
  43       (call-next-method)
  44       ;; else
  45       (progn
  46         (setf (colliding standing-rectangle) nil)
  47         (move-about moving-rectangle (desired-movement collision))
  48         (setf (colliding standing-rectangle) t))))
  49
  50 (defmethod on-collision
  51     ((moving-rectangle player)
  52      (standing-rectangle moving-enemy)
  53      (collision collision))
  54   (collide-blocks moving-rectangle
  55                   standing-rectangle
  56                   collision)
  57   (setf (mayjump moving-rectangle) T)
  58   (setf (autojump moving-rectangle) 5)
  59   (player-hits-enemy moving-rectangle
  60                      standing-rectangle
  61                      collision))
  62
  63 (defmethod on-collision
  64     ((moving-rectangle player)
  65      (standing-rectangle standing-enemy)
  66      (collision collision))
  67   (collide-blocks moving-rectangle
  68                   standing-rectangle
  69                   collision)
  70   (player-hits-enemy moving-rectangle
  71                      standing-rectangle
  72                      collision))
  73
  74 (defmethod on-collision
  75     ((moving-rectangle player)
  76      (standing-rectangle standing-item)
  77      (collision collision))
  78   (collide-blocks moving-rectangle
  79                   standing-rectangle
  80                   collision)
  81   (item-catch standing-rectangle moving-rectangle))
  82
  83 (defmethod on-collision
  84     ((moving-rectangle player)
  85      (standing-rectangle moving-item)
  86      (collision collision))
  87   (collide-blocks moving-rectangle
  88                   standing-rectangle
  89                   collision)
  90   (item-catch standing-rectangle moving-rectangle))
  91
  92
  93 ;; moving-item colliding with other objects
  94
  95 (defmethod on-collision
  96     ((moving-rectangle moving-item)
  97      (standing-rectangle player)
  98      (collision collision))
  99   (collide-blocks moving-rectangle
 100                   standing-rectangle
 101                   collision)
 102   (item-catch moving-rectangle standing-rectangle))
 103
 104 (defmethod on-collision
 105     ((moving-rectangle moving-item)
 106      (standing-rectangle bottom)
 107      (collision collision))
 108   (if (eql (direction collision) :DOWN)
 109       (call-next-method)
 110       ;; else
 111       (progn
 112         (setf (colliding standing-rectangle) nil)
 113         (move-about moving-rectangle (desired-movement collision))
 114         (setf (colliding standing-rectangle) t))))
 115
 116 (defmethod on-collision
 117     ((moving-rectangle moving-item)
 118      (standing-rectangle stone)
 119      (collision collision))
 120   (collide-blocks moving-rectangle standing-rectangle collision))
 121
 122 ;; simple-enemy special methods
 123
 124 (defmethod on-collision ((m simple-enemy) (s stone) (c collision))
 125   (cond ((eql (direction c) :left)
 126          (setf (direction m) :right))
 127         ((eql (direction c) :right)
 128          (setf (direction m) :left)))
 129   (collide-blocks m s c))
 130
 131 ;; burning-marshmallow special methods
 132
 133 (defmethod on-collision ((m burning-marshmallow) (s stone) (c collision))
 134   (cond
 135     ((eql (direction c) :LEFT)
 136      (setf (horizontal-direction m) :RIGHT))
 137     ((eql (direction c) :RIGHT)
 138      (setf (horizontal-direction m) :LEFT))
 139     ((eql (direction c) :UP)
 140      (setf (vertical-direction m) :DOWN))
 141     ((eql (direction c) :DOWN)
 142      (setf (vertical-direction m) :UP))
 143     (T ;; diagonal
 144      (setf (horizontal-direction m)
 145            (if (eql (horizontal-direction m) :LEFT) :RIGHT :LEFT))
 146      (setf (vertical-direction m)
 147            (if (eql (vertical-direction m) :UP) :DOWN :UP))))
 148   (set-burning-marshmallow-animation m))
 149
 150 (defmethod on-collision
 151     ((moving-rectangle burning-marshmallow)
 152      (standing-rectangle bottom)
 153      (collision collision))
 154   (if (eql (direction collision) :DOWN)
 155       (call-next-method)
 156       ;; else
 157       (progn
 158         (setf (colliding standing-rectangle) nil)
 159         (move-about moving-rectangle (desired-movement collision))
 160         (setf (colliding standing-rectangle) t))))
 161
 162 (defmethod on-collision
 163     ((moving-rectangle burning-marshmallow)
 164      (standing-rectangle player)
 165      (collision collision))
 166   (enemy-hits-player moving-rectangle
 167                      standing-rectangle
 168                      collision)
 169   (setf (colliding standing-rectangle) nil)
 170   (move-about moving-rectangle (desired-movement collision))
 171   (setf (colliding standing-rectangle) t))
 172
 173 (defmethod on-collision
 174     ((moving-rectangle player)
 175      (standing-rectangle burning-marshmallow)
 176      (collision collision))
 177   (enemy-hits-player standing-rectangle
 178                      moving-rectangle
 179                      collision)
 180   (setf (colliding standing-rectangle) nil)
 181   (move-about moving-rectangle (desired-movement collision))
 182   (setf (colliding standing-rectangle) t))
 183 ;; moving-enemy colliding with other objects
 184
 185 (defmethod on-collision ((m moving-enemy) (s stone) (c collision))
 186   (collide-blocks m s c))
 187
 188 (defmethod on-collision
 189     ((moving-rectangle moving-enemy)
 190      (standing-rectangle bottom)
 191      (collision collision))
 192   (if (eql (direction collision) :DOWN)
 193       (call-next-method)
 194       ;; else
 195       (progn
 196         (setf (colliding standing-rectangle) nil)
 197         (move-about moving-rectangle (desired-movement collision))
 198         (setf (colliding standing-rectangle) t))))
 199
 200 (defmethod on-collision
 201     ((moving-rectangle moving-enemy)
 202      (standing-rectangle player)
 203      (collision collision))
 204   (collide-blocks moving-rectangle
 205                   standing-rectangle
 206                   collision)
 207   (enemy-hits-player moving-rectangle
 208                      standing-rectangle
 209                      collision))