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