Two days one door ...

diff --git a/add-object.lisp b/add-object.lisp
index a68a2cb..1a14a35 100755 (executable)
--- a/add-object.lisp
+++ b/add-object.lisp
@@ -37,6 +37,10 @@ for. Classes: ~A ~A"
   (must-be-listened-by obj place 'player 'moving-enemy 'moving-item)
   (call-next-method))
 
+(defmethod add-object ((obj teleporter) (place room))
+  (must-be-listened-by obj place 'player)
+  (call-next-method))
+
 (defmethod add-object ((obj moving-enemy) (place room))
   (i-wanna-listen-to obj place 'player 'stone)
   (must-be-listened-by obj place 'player)

diff --git a/constants.lisp b/constants.lisp
index c5527e1..c788c2d 100755 (executable)
--- a/constants.lisp
+++ b/constants.lisp
@@ -10,4 +10,5 @@
   uxul-world::room uxul-world::stone uxul-world::xy-coordinates
   uxul-world::bottom uxul-world::moving-enemy
   uxul-world::standing-enemy uxul-world::moving-item
-  uxul-world::standing-item uxul-world::game-object-with-animation))
\ No newline at end of file
+  uxul-world::standing-item uxul-world::game-object-with-animation
+  uxul-world::teleporter))
\ No newline at end of file

diff --git a/game.lisp b/game.lisp
index fd366fd..5b98d6a 100755 (executable)
--- a/game.lisp
+++ b/game.lisp
@@ -12,7 +12,7 @@
              #'(lambda () (create-room-from-item-list item-list))))
 
 (defun start-game (&key (music nil)
-                  (room-function #'make-testing-room)
+                  (room-function #'make-additional-testing-room)
                   (15-fps nil))
   "Start the Game: Call room-function for getting the room-object to
 run. Music is ignored so far. 15-fps makes only every second frame be
@@ -100,4 +100,4 @@ drawn (for very slow computers)"
              (draw my-anim)
              
              (sdl:update-display)
-        ))))))
\ No newline at end of file
+        ))))))

diff --git a/grass_colored.png b/grass_colored.png
new file mode 100644 (file)
index 0000000..60697a1
Binary files /dev/null and b/grass_colored.png differ

diff --git a/on-collision.lisp b/on-collision.lisp
index 8647884..45d7d07 100755 (executable)
--- a/on-collision.lisp
+++ b/on-collision.lisp
@@ -41,6 +41,16 @@
         (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)

diff --git a/room.lisp b/room.lisp
index e51b6d3..e041a17 100755 (executable)
--- a/room.lisp
+++ b/room.lisp
@@ -172,4 +172,64 @@
           (add-object (make-instance type
                                      :x (* 128 x)
                                      :y (* 128 y)) room)))))
+    room))
+
+(defparameter *additional-testing-room*
+  '((14 8 NASOBEM "" "") (3 9 BURNING-MARSHMALLOW "" "")
+    (5 10 DOOR "" "")
+    (5 14 BROWN-STONE "" "") (5 13 BROWN-STONE "" "") (5 12 BROWN-STONE "" "")
+    (5 11 BROWN-STONE "" "") (5 6 BROWN-STONE "" "") (5 9 BROWN-STONE "" "")
+    (5 8 BROWN-STONE "" "") (5 7 BROWN-STONE "" "") (7 14 TULIP "" "")
+    (1 2 KEY "" "") (1 1 TULIP "" "") (2 3 DOOR "" "") (3 4 BROWN-STONE "" "")
+    (2 4 BROWN-STONE "" "") (1 4 BROWN-STONE "" "") (2 2 BROWN-STONE "" "")
+    (2 1 BROWN-STONE "" "") (4 3 BROWN-STONE "" "") (4 2 BROWN-STONE "" "")
+    (7 6 DOOR "" "") (11 3 DOOR "" "") (5 1 KEY "" "") (5 3 BROWN-STONE "" "")
+    (5 2 DOOR "" "") (5 4 BROWN-STONE "" "") (5 5 BROWN-STONE "" "")
+    (6 5 BROWN-STONE "" "") (7 5 BROWN-STONE "" "") (7 3 BROWN-STONE "" "")
+    (6 1 BROWN-STONE "" "") (7 2 BROWN-STONE "" "") (7 1 TULIP "" "")
+    (9 3 BROWN-STONE "" "") (9 2 BROWN-STONE "" "") (11 1 BROWN-STONE "" "")
+    (11 2 BROWN-STONE "" "") (13 9 BROWN-STONE "" "") (11 5 DOOR "" "")
+    (9 14 KEY "" "") (9 12 KEY "" "") (8 14 BROWN-STONE "" "")
+    (9 13 BROWN-STONE "" "") (8 13 BROWN-STONE "" "") (7 13 BROWN-STONE "" "")
+    (7 12 BROWN-STONE "" "") (7 11 BROWN-STONE "" "") (7 10 BROWN-STONE "" "")
+    (7 9 BROWN-STONE "" "") (7 8 BROWN-STONE "" "") (7 7 BROWN-STONE "" "")
+    (8 7 BROWN-STONE "" "") (9 7 BROWN-STONE "" "") (9 6 BROWN-STONE "" "")
+    (9 5 BROWN-STONE "" "") (9 4 BROWN-STONE "" "") (10 4 BROWN-STONE "" "")
+    (11 4 BROWN-STONE "" "") (11 6 BROWN-STONE "" "") (11 7 BROWN-STONE "" "")
+    (11 8 BROWN-STONE "" "") (10 10 KEY "" "") (10 11 BROWN-STONE "" "")
+    (9 11 BROWN-STONE "" "") (9 10 BROWN-STONE "" "") (9 9 BROWN-STONE "" "")
+    (10 9 BROWN-STONE "" "") (11 9 BROWN-STONE "" "") (12 12 KEY "" "")
+    (11 14 BROWN-STONE "" "") (11 13 BROWN-STONE "" "") (11 12 BROWN-STONE "" "")
+    (11 11 BROWN-STONE "" "") (12 11 BROWN-STONE "" "") (13 13 BROWN-STONE "" "")
+    (13 12 BROWN-STONE "" "") (13 11 BROWN-STONE "" "") (13 10 BROWN-STONE "" "")
+    (13 8 BROWN-STONE "" "") (13 7 BROWN-STONE "" "") (13 6 BROWN-STONE "" "")
+    (13 5 BROWN-STONE "" "") (13 4 BROWN-STONE "" "") (13 3 BROWN-STONE "" "")
+    (13 2 BROWN-STONE "" "") (14 1 UXUL "" "") (0 14 BROWN-STONE "" "")
+    (0 13 BROWN-STONE "" "") (0 12 BROWN-STONE "" "") (0 11 BROWN-STONE "" "")
+    (0 10 BROWN-STONE "" "") (0 9 BROWN-STONE "" "") (0 8 BROWN-STONE "" "")
+    (0 7 BROWN-STONE "" "") (0 6 BROWN-STONE "" "") (0 5 BROWN-STONE "" "")
+    (0 4 BROWN-STONE "" "") (0 3 BROWN-STONE "" "") (0 2 BROWN-STONE "" "")
+    (0 1 BROWN-STONE "" "") (0 0 BROWN-STONE "" "") (1 0 BROWN-STONE "" "")
+    (2 0 BROWN-STONE "" "") (3 0 BROWN-STONE "" "") (6 0 BROWN-STONE "" "")
+    (5 0 BROWN-STONE "" "") (4 0 BROWN-STONE "" "") (7 0 BROWN-STONE "" "")
+    (8 0 BROWN-STONE "" "") (9 0 BROWN-STONE "" "") (10 0 BROWN-STONE "" "")
+    (11 0 BROWN-STONE "" "") (12 0 BROWN-STONE "" "") (13 0 BROWN-STONE "" "")
+    (14 0 BROWN-STONE "" "") (8 15 BROWN-STONE "" "") (7 15 BROWN-STONE "" "")
+    (5 15 BROWN-STONE "" "") (6 15 BROWN-STONE "" "") (4 15 BROWN-STONE "" "")
+    (3 15 BROWN-STONE "" "") (2 15 BROWN-STONE "" "") (1 15 BROWN-STONE "" "")
+    (0 15 BROWN-STONE "" "") (9 15 BROWN-STONE "" "") (10 15 BROWN-STONE "" "")
+    (11 15 BROWN-STONE "" "") (12 15 BROWN-STONE "" "") (13 15 BROWN-STONE "" "")
+    (14 15 BROWN-STONE "" "") (15 15 BROWN-STONE "" "") (15 14 BROWN-STONE "" "")
+    (15 13 BROWN-STONE "" "") (15 12 BROWN-STONE "" "") (15 11 BROWN-STONE "" "")
+    (15 10 BROWN-STONE "" "") (15 9 BROWN-STONE "" "") (15 8 BROWN-STONE "" "")
+    (15 7 BROWN-STONE "" "") (15 6 BROWN-STONE "" "") (15 5 BROWN-STONE "" "")
+    (15 4 BROWN-STONE "" "") (15 3 BROWN-STONE "" "") (15 2 BROWN-STONE "" "")
+    (15 1 BROWN-STONE "" "") (15 0 BROWN-STONE "" "")))
+(defun make-additional-testing-room ()
+  (let
+      ((room (create-room-from-item-list *additional-testing-room*)))
+    (add-object (make-instance 'teleporter
+                              :next-room-function #'make-testing-room
+                              :x (* 128 9) :y (* 128 14)
+                              :active nil :redraw T :visible T :colliding T) room)
     room))
\ No newline at end of file

diff --git a/small-classes.lisp b/small-classes.lisp
index cd597c5..d1d8659 100755 (executable)
--- a/small-classes.lisp
+++ b/small-classes.lisp
@@ -64,4 +64,33 @@
    (dungeon :initarg :dungeon
            :accessor dungeon
            :initform nil
-           :documentation "To provide information in which room this door is.")))
\ No newline at end of file
+           :documentation "To provide information in which room this door is.")))
+
+(defclass teleporter (game-object-with-animation)
+  ((animation :initarg :animation
+             :accessor :animation
+             :initform (make-animation 0 |teleporter|))
+   (width :initarg :width
+         :accessor width
+         :initform 128)
+   (height :initarg :height
+          :accessor height
+          :initform 128)
+   (next-room-function :initarg :next-room-function
+                      :accessor next-room-function
+                      :initform (lambda () *current-room*))))
+
+(defmethod invoke ((obj teleporter))
+  (let
+      ((player (car (get-objects *current-room* 'player))))
+    (cond
+      ((rectangles-overlap (x obj) (y obj)
+                          (+ (x obj) (width obj))
+                          (+ (y obj) (height obj))
+                          (x player) (y player)
+                          (+ (x player) (width player))
+                          (+ (y player) (height player)))
+       (if (key-pressed-up player)
+          ;; change the room
+          (setf *current-room* (funcall (next-room-function obj)))))
+      (T (setf (active obj) nil)))))

diff --git a/teleporter.png b/teleporter.png
new file mode 100644 (file)
index 0000000..f3db38f
Binary files /dev/null and b/teleporter.png differ

diff --git a/uxul-world.asd b/uxul-world.asd
index 155cd02..b11d187 100755 (executable)
--- a/uxul-world.asd
+++ b/uxul-world.asd
@@ -11,8 +11,8 @@
                                 #:cl-fad
                                  #:lispbuilder-sdl-image)
   :components ((:file "uxul-world")
-               (:file "macros")
                (:file "constants")
+               (:file "macros")
                (:file "xy-coordinates")
                (:file "collision")
                (:file "files")