X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=55e9cc2654f476355f2019e379a4a4b9d73cbd2b;hp=085822681aede781b2ae326cd68d622f56029bd7;hb=e16f5c202440d4091b54b1b45d7e023b4fcd4a6d;hpb=30b63e1ad9cab75cf45509e7e58dc713ddc82a21

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index 0858226..55e9cc2 100644
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -56,9 +56,9 @@
            #:init-thunk (build-actions
                          (cmd-read readable-cmd-read))))
 
-(define (readable-cmd-read actor message)
+(define (readable-cmd-read actor message . _)
   (<- (message-from message) 'tell
-      #:text (string-append (slot-ref actor 'read-text) "\n")))
+      #:text (slot-ref actor 'read-text)))
 
 
 ;; This one allows you to take from items that are proxied by it
@@ -286,7 +286,8 @@ wanted to."
     <sign-in-form> 'lobby
     #:name "sign-in form"
     #:goes-by '("sign-in form" "form" "signin form")
-    #:desc "It looks like you could sign this form and set your name.")
+    #:desc '("It looks like you could sign this form and set your name like so: "
+             (i "sign form as <my-name-here>")))
 
    ;; Object: curio cabinets
    ;; TODO: respond to attempts to open the curio cabinet
@@ -464,6 +465,22 @@ labeled \"RL02.5\".")
       #:exclude player)
   (gameobj-self-destruct gameobj))
 
+
+;;; Grand hallway
+
+(define lobby-map-text
+  "\
+                        |  :       :  |
+  .----------.----------.  :   &   :  .----------.----------.
+  | computer |          |& :YOU ARE: &|  smoking | *UNDER*  |
+  | room     + playroom +  : HERE  :  +  parlor  | *CONS-   |
+  |    >     |          |& :       : &|          | TRUCTION*|
+  '----------'----------'-++-------++-'-------+--'----------'
+                       |    '-----'    |     |   |
+                       :     LOBBY     :     '---'
+                        '.           .'
+                          '---------'")
+
 (define grand-hallway
   (lol
    ('grand-hallway
@@ -487,6 +504,15 @@ room\", while a door to the west is labeled \"playroom\"."))
           (make <exit>
             #:name "east"
             #:to 'smoking-parlor)))
+   ('grand-hallway:map
+    <readable> 'grand-hallway
+    #:name "the hotel map"
+    #:desc '("This appears to be a map of the hotel. "
+             "Like the hotel itself, it seems to be "
+             "incomplete."
+             "You could read it if you want to.")
+    #:read-text `(pre ,lobby-map-text)
+    #:goes-by '("map" "hotel map"))
    ('grand-hallway:carpet
     <gameobj> 'grand-hallway
     #:name "the Grand Hallway carpet"
@@ -1023,12 +1049,12 @@ the paint, but the wires themselves seem to be unusually sturdy."
                                  #:key direct-obj indir-obj preposition
                                  (player (message-from message)))
   (define (tell-room text)
-    (<- (gameobj-loc gameobj) 'tell-room
-        #:text text))
+    (<-wait (gameobj-loc gameobj) 'tell-room
+            #:text text))
   (define (tell-room-excluding-player text)
-    (<- (gameobj-loc gameobj) 'tell-room
-        #:text text
-        #:exclude player))
+    (<-wait (gameobj-loc gameobj) 'tell-room
+            #:text text
+            #:exclude player))
   (cond
    ((ci-member direct-obj '("button" "load button" "load"))
     (tell-room-excluding-player
@@ -1094,25 +1120,195 @@ the paint, but the wires themselves seem to be unusually sturdy."
         #:text '((p "You insert the glowing disc into the drive.")
                  (p "The LOAD button begins to glow."))))))
 
+;; The computar
+(define-actor <computer> (<gameobj>)
+  ((cmd-run-program computer-run-program)
+   (cmd-run-what (lambda (gameobj message . _)
+                   (<- (message-from message) 'tell
+                       #:text '("The computer is already running, and a program appears "
+                                "ready to run."
+                                "you mean to \"run the program on the computer\"")))))
+  (commands #:allocation #:each-subclass
+            #:init-thunk (build-commands
+                          ("run" ((prep-indir-command cmd-run-program
+                                                      '("on"))
+                                  (direct-command cmd-run-what))))))
+
+(define* (computer-run-program gameobj message
+                               #:key direct-obj indir-obj preposition
+                               (player (message-from message)))
+  (define (hd-state)
+    (mbody-val (<-wait (dyn-ref gameobj 'computer-room:hard-drive) 'get-state)))
+  (define (tell-room text)
+    (<-wait (gameobj-loc gameobj) 'tell-room
+        #:text text))
+  (define (tell-room-excluding-player text)
+    (<-wait (gameobj-loc gameobj) 'tell-room
+            #:text text
+            #:exclude player))
+  (define (tell-player text)
+    (<-wait player 'tell
+            #:text text))
+  (cond
+   ((ci-member direct-obj '("program"))
+    (tell-room-excluding-player
+     `(,(mbody-val (<-wait player 'get-name))
+       " runs the program loaded on the computer..."))
+    (tell-player "You run the program on the computer...")
+
+    (cond
+     ((not (eq? (hd-state) 'ready))
+      (tell-room '("... but it errors out. "
+                   "It seems to be complaining about a " (b "DISK ERROR!")
+                   ". It looks like it is missing some essential software.")))
+     (else
+      (<- (dyn-ref gameobj 'computer-room:floor-panel) 'open-up))))))
+
+
+;; floor panel
+(define-actor <floor-panel> (<gameobj>)
+  ;; TODO: Add "open" verb, since obviously people will try that
+  ((open? (lambda (panel message)
+            (<-reply message (slot-ref panel 'open))))
+   (open-up floor-panel-open-up))
+  (open #:init-value #f))
+
+(define (floor-panel-open-up panel message)
+  (if (slot-ref panel 'open)
+      (<- (gameobj-loc panel) 'tell-room
+          #:text '("You hear some gears grind around the hinges of the "
+                   "floor panel, but it appears to already be open."))
+      (begin
+        (slot-set! panel 'open #t)
+        (<- (gameobj-loc panel) 'tell-room
+            #:text '("You hear some gears grind, as the metal panel on "
+                     "the ground opens and reveals a stairwell going down!")))))
+
+(define* (floor-panel-desc panel #:optional whos-looking)
+  `("It's a large metal panel on the floor in the middle of the room. "
+    ,(if (slot-ref panel 'open)
+         '("It's currently wide open, revealing a spiraling staircase "
+           "which descends into darkness.")
+         '("It's currently closed shut, but there are clearly hinges, and "
+           "it seems like there is a mechanism which probably opens it via "
+           "some automation.  What could be down there?"))))
+
 (define computer-room
   (lol
    ('computer-room
     <room> #f
     #:name "Computer Room"
-    #:desc '((p "A sizable computer cabinet covers a good portion of the left
-wall.  It emits a pleasant hum which covers the room like a warm blanket.
-Connected to a computer is a large hard drive.")
-             (p "On the floor is a large steel panel.  It is closed, but it has
-hinges which suggest it could be opened."))
+    #:desc (lambda (gameobj whos-looking)
+             (define panel-open
+               (mbody-val (<-wait (dyn-ref gameobj 'computer-room:floor-panel)
+                                  'open?)))
+             `((p "A sizable computer cabinet covers a good portion of the left
+ wall.  It emits a pleasant hum which covers the room like a warm blanket.
+ Connected to a computer is a large hard drive.")
+               (p "On the floor is a large steel panel.  "
+                  ,(if panel-open
+                       '("It is wide open, exposing a spiral staircase "
+                         "which descends into darkness.")
+                       '("It is closed, but it has 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 "a hard drive"
+    #:name "the hard drive"
     #:desc (wrap-apply hard-drive-desc)
-    #:goes-by '("hard drive" "drive" "hard disk"))))
+    #:goes-by '("hard drive" "drive" "hard disk"))
+   ('computer-room:computer
+    <computer> 'computer-room
+    #:name "the computer"
+    #:desc '((p "It's a coat closet sized computer labeled \"PDP-11.5\". ")
+             (p "The computer is itself turned on, and it looks like it is "
+                "all set up for you to run a program on it."))
+    #:goes-by '("computer"))
+   ('computer-room:floor-panel
+    <floor-panel> 'computer-room
+    #:name "a floor panel"
+    #:desc (wrap-apply floor-panel-desc)
+    #:invisible? #t
+    #:goes-by '("floor panel" "panel"))))
+
+
+;;; * UNDERGROUND SECTION OF THE GAME! *
+
+
+;;; The lab
+
+(define underground-map-text
+  "\
+                            _______           |
+                         .-' @     '-.         \\   ?????
+                       .'             '.       .\\             
+                       |  [8sync Hive] |======'  '-_____
+                       ',      M      ,'
+                        '.         @ .'                                  
+                          \\  @     /                    
+                           '-__+__-'                
+                            '.  @ .'
+     .--------------.         \\ /
+     | [Guile Async |  .-------+------.
+     |    Museum]   |  |     [Lab] #!#|  .-------------.
+     |             @|  |  MM          |  |[Federation  |
+     | &      ^     +##+@ ||     <    +##|     Station]|
+     |              |  |           @  |  |             |
+     |         &  # |  |*You-Are-Here*|  '-------------'
+     | #   ^        | #+-------+------'
+     '-------+------' #        #
+             #        #        #
+             #        #   .-----------.
+           .-+----.   #   |#       F  |
+           |@?+%? +####   | ^   f##   |
+           '------'       |  f    f  %|
+                          |F [Mudsync |
+                          | $  Swamp] |
+                          '-----------'")
+
+(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
+            #:traverse-check
+            (lambda (exit room whos-exiting)
+              (values #t "You climb the spiral staircase.")))))
+
+   ;; Test tubes
+   ;; map
+   ('underground-lab:map
+    <readable> 'underground-lab
+    #:name "the underground map"
+    #:desc '("This appears to be a map of the surrounding area. "
+             "You could read it if you want to.")
+    #:read-text `(pre ,underground-map-text)
+    #:goes-by '("map" "underground map" "lab map"))))
+
+
+
 
 
 
@@ -1121,7 +1317,7 @@ hinges which suggest it could be opened."))
 
 (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)