Major Changes. Windows Compatibility.

[uxul-world.git] / on-collision.lisp

diff --git a/on-collision.lisp b/on-collision.lisp
index d9e47f7..45d7d07 100755 (executable)
--- a/on-collision.lisp
+++ b/on-collision.lisp
@@ -24,6 +24,34 @@
       )
   (collide-blocks moving-rectangle standing-rectangle collision))
 
+(defmethod on-collision
+    ((moving-rectangle player)
+     (standing-rectangle door)
+     (collision collision))
+  (cond ((find-if #'(lambda (x) (string= x (dungeon standing-rectangle))) (keys moving-rectangle))
+        (setf (keys moving-rectangle) (delete (dungeon standing-rectangle) (keys moving-rectangle) :count 1))
+        (setf (visible standing-rectangle) nil)
+        (setf (active standing-rectangle) nil)
+        (setf (colliding standing-rectangle) nil))
+       ((eql (direction collision) :DOWN)
+        ;; "bottom" - allow jumping again
+        (setf (mayjump moving-rectangle) T))
+        ;; "ceiling" - dont allow continuing jump
+       ((eql (direction collision) :UP)
+        (setf (maycontjump moving-rectangle) nil)))
+  (collide-blocks moving-rectangle standing-rectangle collision))
+
+(defmethod on-collision
+    ((moving-rectangle player)
+     (standing-rectangle teleporter)
+     (collision collision))
+  ;; make rectangle active to check for overlapping
+  (setf (active standing-rectangle) T)
+  ;; walk through
+  (setf (colliding standing-rectangle) nil)
+  (move-about moving-rectangle (desired-movement collision))
+  (setf (colliding standing-rectangle) t))
+
 (defmethod on-collision
     ((moving-rectangle player)
      (standing-rectangle tulip)
@@ -54,11 +82,16 @@
   (collide-blocks moving-rectangle
                  standing-rectangle
                  collision)
+  (setf (bounced moving-rectangle) T)
   (setf (mayjump moving-rectangle) T)
   (setf (autojump moving-rectangle) 5)
   (player-hits-enemy moving-rectangle
                     standing-rectangle
-                    collision))
+                    collision)
+  (setf (colliding standing-rectangle) nil)
+  (move-about moving-rectangle (desired-movement collision))
+  (setf (colliding standing-rectangle) t)
+)
 
 (defmethod on-collision
     ((moving-rectangle player)
@@ -206,4 +239,8 @@
                  collision)
   (enemy-hits-player moving-rectangle
                     standing-rectangle
-                    collision))
+                    collision)
+  (setf (colliding standing-rectangle) nil)
+  (move-about moving-rectangle (desired-movement collision))
+  (setf (colliding standing-rectangle) t)
+)