Two days one door ...
[uxul-world.git] / room.lisp
index 7e99218..e041a17 100755 (executable)
--- a/room.lisp
+++ b/room.lisp
            (x (cadr item))
            (type (caddr item))
            (arg1 (cadddr item))
-           (arg2 (caddddr item)))
+           (arg2 (car (cddddr item))))
        (cond
+         ((eq type 'anchor))
          ((eq type 'uxul)
           (setf (x player) (* 128 x))
           (setf (y player) (* 128 y))
           (add-object (make-instance 'flying-nasobem
                                      :x (* 128 x)
                                      :y (* 128 y)) room))
+         ((eq type 'key)
+          (add-object (make-instance 'key
+                                     :x (* 128 x)
+                                     :y (* 128 y)
+                                     :dungeon arg1) room))
+         ((eq type 'door)
+          (add-object (make-instance 'door
+                                     :x (* 128 x)
+                                     :y (* 128 y)
+                                     :dungeon arg1) room))
+         ((eq type 'burning-marshmallow)
+          (add-object (make-instance 'burning-marshmallow
+                                     :x (* 128 x)
+                                     :y (* 128 y)
+                                     :inner-rectangle
+                                     (and (not (string= arg1 "")) (not (string= arg2 ""))
+                                          (list
+                                           (* 128 (car (gethash arg1 anchor-table)))
+                                           (* 128 (cdr (gethash arg1 anchor-table)))
+                                           (* 128 (1+ (car (gethash arg2 anchor-table))))
+                                           (* 128 (1+ (cdr (gethash arg2 anchor-table))))))) room))
          (T
           (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