Ability to move up / down into laboratory
authorChristopher Allan Webber <cwebber@dustycloud.org>
Mon, 30 Jan 2017 17:59:18 +0000 (11:59 -0600)
committerChristopher Allan Webber <cwebber@dustycloud.org>
Mon, 30 Jan 2017 17:59:18 +0000 (11:59 -0600)
worlds/bricabrac.scm

index 582e7019e9071630441528e14cf97e6fbeb4939b..8d3e03a9f8018d67843f7dcb7bd9036cd6b38981 100644 (file)
@@ -1180,7 +1180,20 @@ hinges which suggest it could be opened."))
     #:exits
     (list (make <exit>
             #:name "east"
-            #:to 'playroom)))
+            #:to 'playroom)
+          (make <exit>
+            #:name "down"
+            #:to 'underground-lab
+            #:traverse-check
+            (lambda (exit room whos-exiting)
+              (define panel-open
+                (mbody-val (<-wait (dyn-ref room 'computer-room:floor-panel)
+                                   'open?)))
+              (if panel-open
+                  (values #t "You descend the spiral staircase.")
+                  (values #f '("You'd love to go down, but the only way "
+                               "through is through that metal panel, "
+                               "which seems closed.")))))))
    ('computer-room:hard-drive
     <hard-drive> 'computer-room
     #:name "the hard drive"
@@ -1201,13 +1214,26 @@ hinges which suggest it could be opened."))
     #:goes-by '("floor panel" "panel"))))
 
 
+(define underground-lab
+  (lol
+   ('underground-lab
+    <room> #f
+    #:name "Underground laboratory"
+    #:desc '("This appears to be some sort of underground laboratory. "
+             )
+    #:exits
+    (list (make <exit>
+            #:name "up"
+            #:to 'computer-room)))))
+
+
 \f
 ;;; Game
 ;;; ----
 
 (define (game-spec)
   (append lobby grand-hallway smoking-parlor
-          playroom break-room computer-room))
+          playroom break-room computer-room underground-lab))
 
 ;; TODO: Provide command line args
 (define (run-game . args)