X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=6bdadca3e6c6af9a39b898f74e354f314767452b;hb=refs%2Fheads%2F8sync-fibers;hp=8ea7451a7701608bf32d132dc514bc794a0adc02;hpb=5ceaf7cba470a311d5ebcacfb471eab1a1e0418a;p=mudsync.git

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index 8ea7451..6bdadca 100644
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -21,6 +21,7 @@
 (use-modules (mudsync)
              (mudsync container)
              (8sync)
+             (8sync daydream)
              (oop goops)
              (ice-9 control)
              (ice-9 format)
@@ -82,8 +83,7 @@
      (for-each
       (lambda (obj-sym)
         (define obj-id (dyn-ref gameobj obj-sym))
-        (define goes-by
-          (mbody-val (<-wait obj-id 'goes-by)))
+        (define goes-by (<-wait obj-id 'goes-by))
         (when (ci-member direct-obj goes-by)
           (<- obj-id 'cmd-take #:direct-obj direct-obj #:player player)
           (escape #f)))
@@ -162,8 +162,7 @@ or 'skribe'?  Now *that's* composition!"))
 
 (define* (sign-cmd-sign-in actor message
                            #:key direct-obj indir-obj preposition)
-  (define old-name
-    (mbody-val (<-wait (message-from message) 'get-name)))
+  (define old-name (<-wait (message-from message) 'get-name))
   (define name indir-obj)
   (if (valid-name? indir-obj)
       (begin
@@ -193,8 +192,7 @@ character.\n")))
   ;; and find out their name.  We'll call *their* get-name message
   ;; handler... meanwhile, this procedure suspends until we get
   ;; their response.
-  (define who-rang
-    (mbody-val (<-wait (message-from message) 'get-name)))
+  (define who-rang (<-wait (message-from message) 'get-name))
 
   ;; Now we'll invoke the "tell" message handler on the player
   ;; who rang us, displaying this text on their screen.
@@ -446,10 +444,10 @@ from the statue a shining outline appears around it... and a
 completely separate, glowing copy of the disc materializes into your
 hands!")))
   (<- (gameobj-loc gameobj) 'tell-room
-        #:text `(,(mbody-val (<-wait player 'get-name))
-                 " pulls on the shield of the statue, and a glowing "
-                 "copy of it materializes into their hands!")
-        #:exclude player)
+      #:text `(,(<-wait player 'get-name)
+               " pulls on the shield of the statue, and a glowing "
+               "copy of it materializes into their hands!")
+      #:exclude player)
   (<- (gameobj-loc gameobj) 'tell-room
       #:text
       '(p "You hear a voice whisper: "
@@ -477,8 +475,8 @@ labeled \"RL02.5\".")
                    (player (message-from message)))
   (<- player 'tell
       #:text "You drop the glowing disc, and it shatters into a million pieces!")
-  (<- (mbody-val (<-wait player 'get-loc)) 'tell-room
-      #:text `(,(mbody-val (<-wait player 'get-name))
+  (<- (<-wait player 'get-loc) 'tell-room
+      #:text `(,(<-wait player 'get-name)
                " drops a glowing disc, and it shatters into a million pieces!")
       #:exclude player)
   (gameobj-self-destruct gameobj))
@@ -597,6 +595,243 @@ platter!  It has \"RL02.5\" written on it.  It looks kind of loose."
 ;;; Playroom
 ;;; --------
 
+(define-actor <rgb-machine> (<gameobj>)
+  ((cmd-run rgb-machine-cmd-run)
+   (cmd-reset rgb-machine-cmd-reset))
+  (commands
+   #:allocation #:each-subclass
+   #:init-thunk (build-commands
+                 (("run" "start") ((direct-command cmd-run)))
+                 ("reset" ((direct-command cmd-reset)))))
+  (resetting #:init-value #f
+             #:accessor .resetting)
+  ;; used to reset, and to kick off the first item in the list
+  (rgb-items #:init-keyword #:rgb-items
+             #:accessor .rgb-items))
+
+(define (rgb-machine-cmd-run rgb-machine message . _)
+  (define player (message-from message))
+  (<-wait player 'tell
+          #:text '("You start the rube goldberg machine."))
+  (<-wait (gameobj-loc rgb-machine) 'tell-room
+          #:text `(,(<-wait player 'get-name)
+                   " runs the rube goldberg machine.")
+          #:exclude player)
+  (daydream 1)
+  (match (.rgb-items rgb-machine)
+    ((first-item rest ...)
+     (<- (dyn-ref rgb-machine first-item) 'trigger))))
+
+(define (rgb-machine-cmd-reset rgb-machine message . _)
+  (define player (message-from message))
+  (cond
+   ((not (.resetting rgb-machine))
+    (set! (.resetting rgb-machine) #t)
+    (<-wait player 'tell
+            #:text '("You reset the rube goldberg machine."))
+    (<-wait (gameobj-loc rgb-machine) 'tell-room
+            #:text `(,(<-wait player 'get-name)
+                     " resets the rube goldberg machine.")
+            #:exclude player)
+    (<-wait (gameobj-loc rgb-machine) 'tell-room
+            #:text '("From a panel in the wall, a white gloved mechanical "
+                     "arm reaches out to reset all the "
+                     "rube goldberg components."))
+    (daydream (/ 1 2))
+    (for-each
+     (lambda (rgb-item)
+       (<- (dyn-ref rgb-machine rgb-item) 'reset)
+       (daydream (/ 1 2)))
+     (.rgb-items rgb-machine))
+    (<- (gameobj-loc rgb-machine) 'tell-room
+        #:text "The machine's mechanical arm retreats into the wall!")
+    (set! (.resetting rgb-machine) #f))
+   (else
+    (<-wait player 'tell
+            #:text '("But it's in the middle of resetting right now!")))))
+
+(define-actor <rgb-item> (<gameobj>)
+  ((trigger rgb-item-trigger)
+   (reset rgb-item-reset))
+  (invisible? #:init-value #t)
+  (steps #:init-keyword #:steps
+         #:accessor .steps)
+  (triggers-as #:init-value #f
+               #:init-keyword #:triggers-as
+               #:getter .triggers-as)
+  (reset-msg #:init-keyword #:reset-msg
+             #:getter .reset-msg)
+  ;; States: ready -> running -> ran
+  (state #:init-value 'ready
+         #:accessor .state))
+
+
+(define (rgb-item-trigger rgb-item message . _)
+  (define room (gameobj-loc rgb-item))
+  (case (.state rgb-item)
+    ((ready)
+     ;; Set state to running
+     (set! (.state rgb-item) 'running)
+
+     ;; Loop through all steps
+     (for-each
+      (lambda (step)
+        (match step
+          ;; A string?  That's the description of what's happening, tell players
+          ((? string? str)
+           (<- room 'tell-room #:text str))
+          ;; A number?  Sleep for that many secs
+          ((? number? num)
+           (daydream num))
+          ;; A symbol?  That's another gameobj to look up dynamically
+          ((? symbol? sym)
+           (<- (dyn-ref rgb-item sym) 'trigger
+               #:triggered-by (.triggers-as rgb-item)))
+          (_ (throw 'unknown-step-type
+                    "Don't know how to process rube goldberg machine step type?"
+                    #:step step))))
+      (.steps rgb-item))
+
+     ;; We're done! Set state to ran
+     (set! (.state rgb-item) 'ran))
+
+    (else
+     (<- room 'tell-room
+         #:text `("... but " ,(slot-ref rgb-item 'name)
+                  " has already been triggered!")))))
+
+(define (rgb-item-reset rgb-item message . _)
+  (define room (gameobj-loc rgb-item))
+  (case (.state rgb-item)
+    ((ran)
+     (set! (.state rgb-item) 'ready)
+     (<- room 'tell-room
+         #:text (.reset-msg rgb-item)))
+    ((running)
+     (<- room 'tell-room
+         #:text `("... but " ,(slot-ref rgb-item 'name)
+                  " is currently running!")))
+    ((ready)
+     (<- room 'tell-room
+         #:text `("... but " ,(slot-ref rgb-item 'name)
+                  " has already been reset.")))))
+
+(define-actor <rgb-kettle> (<rgb-item>)
+  ((trigger rgb-kettle-trigger)
+   (reset rgb-kettle-reset))
+  (heated #:accessor .heated
+          #:init-value #f)
+  (filled #:accessor .filled
+          #:init-value #f))
+
+(define* (rgb-kettle-trigger rgb-item message #:key triggered-by)
+  (define room (gameobj-loc rgb-item))
+  (if (not (eq? (.state rgb-item) 'ran))
+      (begin
+        (match triggered-by
+          ('water-demon
+           (set! (.state rgb-item) 'running)
+           (set! (.filled rgb-item) #t))
+          ('quik-heater
+           (set! (.state rgb-item) 'running)
+           (set! (.heated rgb-item) #t)))
+        (when (and (.filled rgb-item)
+                   (.heated rgb-item))
+          (<- room 'tell-room
+              #:text '((i "*kshhhhhh!*")
+                       " The water has boiled!"))
+          (daydream .25)
+          (set! (.state rgb-item) 'ran)
+          ;; insert a cup of hot tea in the room
+          (create-gameobj <hot-tea> (gameobj-gm rgb-item) room)
+          (<- room 'tell-room
+              #:text '("The machine pours out a cup of hot tea! "
+                       "Looks like the machine finished!"))))
+      (<- room 'tell-room
+         #:text `("... but " ,(slot-ref rgb-item 'name)
+                  " has already been triggered!"))))
+
+(define (rgb-kettle-reset rgb-item message . rest-args)
+  (define room (gameobj-loc rgb-item))
+  (when (eq? (.state rgb-item) 'ran)
+    (set! (.heated rgb-item) #f)
+    (set! (.filled rgb-item) #f))
+  (apply rgb-item-reset rgb-item message rest-args))
+
+(define-actor <tinfoil-hat> (<gameobj>)
+  ((cmd-wear tinfoil-hat-wear))
+  (contained-commands
+   #:allocation #:each-subclass
+   #:init-thunk (build-commands
+                 ("wear" ((direct-command cmd-wear))))))
+
+(define (tinfoil-hat-wear tinfoil-hat message . _)
+  (<- (message-from message) 'tell
+      #:text '("You put on the tinfoil hat, and, to be perfectly honest with you "
+               "it's a lot harder to take you seriously.")))
+
+
+(define-actor <hot-tea> (<gameobj>)
+  ((cmd-drink hot-tea-cmd-drink)
+   (cmd-sip hot-tea-cmd-sip))
+  (contained-commands
+   #:allocation #:each-subclass
+   #:init-thunk (build-commands
+                 ("drink" ((direct-command cmd-drink)))
+                 ("sip" ((direct-command cmd-sip)))))
+  
+  (sips-left #:init-value 4
+             #:accessor .sips-left)
+  (name #:init-value "a cup of hot tea")
+  (take-me? #:init-value #t)
+  (goes-by #:init-value '("cup of hot tea" "cup of tea" "tea" "cup"))
+  (desc #:init-value "It's a steaming cup of hot tea.  It looks pretty good!"))
+
+(define (hot-tea-cmd-drink hot-tea message . _)
+  (define player (message-from message))
+  (define player-loc (<-wait player 'get-loc))
+  (define player-name (<-wait player 'get-name))
+  (<- player 'tell
+      #:text "You drink a steaming cup of hot tea all at once... hot hot hot!")
+  (<- player-loc 'tell-room
+      #:text `(,player-name
+               " drinks a steaming cup of hot tea all at once.")
+      #:exclude player)
+  (gameobj-self-destruct hot-tea))
+
+(define (hot-tea-cmd-sip hot-tea message . _)
+  (define player (message-from message))
+  (define player-loc (<-wait player 'get-loc))
+  (define player-name (<-wait player 'get-name))
+  (set! (.sips-left hot-tea) (- (.sips-left hot-tea) 1))
+  (<- player 'tell
+      #:text "You take a sip of your steaming hot tea.  How refined!")
+  (<- player-loc 'tell-room
+      #:text `(,player-name
+               " takes a sip of their steaming hot tea.  How refined!")
+      #:exclude player)
+  (when (= (.sips-left hot-tea) 0)
+    (<- player 'tell
+        #:text "You've finished your tea!")
+    (<- player-loc 'tell-room
+        #:text `(,player-name
+                 " finishes their tea!")
+        #:exclude player)
+    (gameobj-self-destruct hot-tea)))
+
+(define-actor <fanny-pack> (<container>)
+  ((cmd-take-from-while-wearing cmd-take-from)
+   (cmd-put-in-while-wearing cmd-put-in))
+  (contained-commands
+   #:allocation #:each-subclass
+   #:init-thunk
+   (build-commands
+    (("l" "look") ((direct-command cmd-look-at)))
+    ("take" ((prep-indir-command cmd-take-from-while-wearing
+                                 '("from" "out of"))))
+    ("put" ((prep-indir-command cmd-put-in-while-wearing
+                                '("in" "inside" "into" "on")))))))
+
 (define playroom
   (lol
    ('playroom
@@ -636,8 +871,7 @@ if this room is intended for children or child-like adults.")
                     ,(if (eq? contents '())
                          " nothing!  It's empty!"
                          `(ul ,(map (lambda (occupant)
-                                      `(li ,(mbody-val
-                                             (<-wait occupant 'get-name))))
+                                      `(li ,(<-wait occupant 'get-name)))
                                     (gameobj-occupants toy-chest))))))))
     #:take-from-me? #t
     #:put-in-me? #t)
@@ -648,7 +882,137 @@ if this room is intended for children or child-like adults.")
     #:name "a rubber duck"
     #:goes-by '("rubber duck" "duck")
     #:take-me? #t
-    #:desc "It's a yellow rubber duck with a bright orange beak.")))
+    #:desc "It's a yellow rubber duck with a bright orange beak.")
+
+   ('playroom:toy-chest:tinfoil-hat
+    <tinfoil-hat> 'playroom:toy-chest
+    #:name "a tinfoil hat"
+    #:goes-by '("tinfoil hat" "hat")
+    #:take-me? #t
+    #:desc "You'd have to be a crazy person to wear this thing!")
+
+   ('playroom:toy-chest:fanny-pack
+    <fanny-pack> 'playroom:toy-chest
+    #:name "a fanny pack"
+    #:goes-by '("fanny pack" "pack")
+    #:take-me? #t
+    #:desc
+    (lambda (toy-chest whos-looking)
+      (let ((contents (gameobj-occupants toy-chest)))
+        `((p "It's a leather fanny pack, so it's both tacky and kinda cool.")
+          (p "Inside you see:"
+             ,(if (eq? contents '())
+                  " nothing!  It's empty!"
+                  `(ul ,(map (lambda (occupant)
+                               `(li ,(<-wait occupant 'get-name)))
+                             (gameobj-occupants toy-chest)))))))))
+
+   ;; Things inside the toy chest
+   ('playroom:toy-chest:fanny-pack:plastic-elephant
+    <gameobj> 'playroom:toy-chest:fanny-pack
+    #:name "a plastic elephant"
+    #:goes-by '("plastic elephant" "elephant")
+    #:take-me? #t
+    #:desc "It's a tiny little plastic elephant.  Small, but heartwarming.")
+
+   ('playroom:rgb-machine
+    <rgb-machine> 'playroom
+    #:name "a Rube Goldberg machine"
+    #:goes-by '("rube goldberg machine" "machine")
+    #:rgb-items '(playroom:rgb-dominoes
+                  playroom:rgb-switch-match
+                  playroom:rgb-candle
+                  playroom:rgb-catapult
+                  playroom:rgb-water-demon
+                  playroom:rgb-quik-heater
+                  playroom:rgb-kettle)
+    #:desc "It's one of those hilarious Rube Goldberg machines.
+What could happen if you started it?")
+
+   ;; Dominoes topple
+   ('playroom:rgb-dominoes
+    <rgb-item> 'playroom
+    #:name "some dominoes"
+    #:goes-by '("dominoes" "some dominoes")
+    #:steps `("The dominoes topple down the line..."
+              1
+              "The last domino lands on a switch!"
+              1.5
+              playroom:rgb-switch-match)
+    #:reset-msg "The dominoes are placed back into position.")
+
+   ;; Which hit the switch and strike a match
+   ('playroom:rgb-switch-match
+    <rgb-item> 'playroom
+    #:name "a switch"
+    #:goes-by '("switch" "match")
+    #:steps `("The switch lights a match!"
+              ,(/ 2 3)
+              "The match lights a candle!"
+              1.5
+              playroom:rgb-candle)
+    #:reset-msg "A fresh match is installed and the switch is reset.")
+   ;; which lights a candle and burns a rope
+   ('playroom:rgb-candle
+    <rgb-item> 'playroom
+    #:name "a candle"
+    #:goes-by '("candle")
+    #:steps `("The candle burns..."
+              (/ 2 3)  ; oops!
+              "The candle is burning away a rope!"
+              2
+              "The rope snaps!"
+              .5
+              playroom:rgb-catapult)
+    #:reset-msg "A fresh candle is installed.")
+   ;; which catapults a rock
+   ('playroom:rgb-catapult
+    <rgb-item> 'playroom
+    #:name "a catapult"
+    #:goes-by '("catapult")
+    #:steps `("The snapped rope unleashes a catapult, which throws a rock!"
+              2
+              "The rock flies through a water demon, startling it!"
+              .5
+              playroom:rgb-water-demon
+              2
+              "The rock whacks into the quik-heater's on button!"
+              .5
+              playroom:rgb-quik-heater)
+    #:reset-msg
+    '("A fresh rope is attached to the catapult, which is pulled taught. "
+      "A fresh rock is placed on the catapult."))
+   ;; which both:
+   ;;   '- panics the water demon
+   ;;      '- which waters the kettle
+   ('playroom:rgb-water-demon
+    <rgb-item> 'playroom
+    #:name "the water demon"
+    #:triggers-as 'water-demon
+    #:goes-by '("water demon" "demon")
+    #:steps `("The water demon panics, and starts leaking water into the kettle below!"
+              3
+              "The kettle is filled!"
+              playroom:rgb-kettle)
+    #:reset-msg '("The water demon is scratched behind the ears and calms down."))
+   ;;   '- bops the quik-heater button
+   ;;      '- which heats the kettle
+   ('playroom:rgb-quik-heater
+    <rgb-item> 'playroom
+    #:name "the quik heater"
+    #:triggers-as 'quik-heater
+    #:goes-by '("quik heater" "heater")
+    #:steps `("The quik-heater heats up the kettle above it!"
+              3
+              "The kettle is heated up!"
+              playroom:rgb-kettle)
+    #:reset-msg '("The quik heater is turned off."))
+   ;; Finally, the kettle
+   ('playroom:rgb-kettle
+    <rgb-kettle> 'playroom
+    #:name "the kettle"
+    #:goes-by '("kettle")
+    #:reset-msg '("The kettle is emptied."))))
 
 
 
@@ -680,7 +1044,7 @@ if this room is intended for children or child-like adults.")
 
 (define* (furniture-cmd-sit actor message #:key direct-obj)
   (define player-name
-    (mbody-val (<-wait (message-from message) 'get-name)))
+    (<-wait (message-from message) 'get-name))
   (<- (message-from message) 'tell
       #:text (format #f "You ~a ~a.\n"
                      (slot-ref actor 'sit-phrase)
@@ -905,7 +1269,7 @@ You can ask me about the following:
 
 (define* (clerk-cmd-dismiss clerk message . _)
   (define player-name
-    (mbody-val (<-wait (message-from message) 'get-name)))
+    (<-wait (message-from message) 'get-name))
   (match (slot-ref clerk 'state)
     ('on-duty
      (<- (gameobj-loc clerk) 'tell-room
@@ -967,7 +1331,7 @@ if you need further help.")
   (match (slot-ref clerk 'state)
     ('slacking
      (tell-room (random-choice clerk-slacking-texts))
-     (8sleep (+ (random 20) 15))
+     (daydream (+ (random 20) 15))
      (loop-if-not-destructed))
     ('on-duty
      (if (> (slot-ref clerk 'patience) 0)
@@ -976,7 +1340,7 @@ if you need further help.")
            (tell-room (random-choice clerk-working-impatience-texts))
            (slot-set! clerk 'patience (- (slot-ref clerk 'patience)
                                          (+ (random 2) 1)))
-           (8sleep (+ (random 60) 40))
+           (daydream (+ (random 60) 40))
            (loop-if-not-destructed))
          ;; Back to slacking
          (begin
@@ -986,7 +1350,7 @@ if you need further help.")
            (tell-room clerk-return-to-slacking-text)
            ;; annnnnd back to slacking
            (slot-set! clerk 'state 'slacking)
-           (8sleep (+ (random 30) 15))
+           (daydream (+ (random 30) 15))
            (loop-if-not-destructed))))))
 
 
@@ -1054,7 +1418,7 @@ the paint, but the wires themselves seem to be unusually sturdy."
          #:accessor .state))
 
 (define (hard-drive-act-get-state hard-drive message)
-  (<-reply message (.state hard-drive)))
+  (.state hard-drive))
 
 (define* (hard-drive-desc hard-drive #:optional whos-looking)
   `((p "The hard drive is labeled \"RL02.5\".  It's a little under a meter tall.")
@@ -1087,7 +1451,7 @@ the paint, but the wires themselves seem to be unusually sturdy."
   (cond
    ((ci-member direct-obj '("button" "load button" "load"))
     (tell-room-excluding-player
-     `(,(mbody-val (<-wait player 'get-name))
+     `(,(<-wait player 'get-name)
        " presses the button on the hard disk."))
     (<- player 'tell
         #:text "You press the button on the hard disk.")
@@ -1097,14 +1461,14 @@ the paint, but the wires themselves seem to be unusually sturdy."
        ;; I have no idea what this drive did when you didn't have a platter
        ;; in it and pressed load, but I know there was a FAULT button.
        (tell-room "You hear some movement inside the hard drive...")
-       (8sleep 1.5)
+       (daydream 1.5)
        (tell-room
         '("... but then the FAULT button blinks a couple times. "
           "What could be missing?")))
       ((with-disc)
        (set! (.state gameobj) 'loading)
        (tell-room "The hard disk begins to spin up!")
-       (8sleep 2)
+       (daydream 2)
        (set! (.state gameobj) 'ready)
        (tell-room "The READY light turns on!"))
       ((loading ready)
@@ -1124,10 +1488,10 @@ the paint, but the wires themselves seem to be unusually sturdy."
     (call/ec
      (lambda (return)
        (for-each (lambda (occupant)
-                   (define goes-by (mbody-val (<-wait occupant 'goes-by)))
+                   (define goes-by (<-wait occupant 'goes-by))
                    (when (ci-member direct-obj goes-by)
                      (return occupant)))
-                 (mbody-val (<-wait player 'get-occupants)))
+                 (<-wait player 'get-occupants))
        ;; nothing found
        #f)))
   (cond
@@ -1135,10 +1499,10 @@ the paint, but the wires themselves seem to be unusually sturdy."
     (<- player 'tell
         #:text `("You don't seem to have any such " ,direct-obj " to put "
                  ,preposition " " ,our-name ".")))
-   ((not (mbody-val (<-wait this-thing 'get-prop 'hd-platter?)))
+   ((not (<-wait this-thing 'get-prop 'hd-platter?))
     (<- player 'tell
         #:text `("It wouldn't make sense to put "
-                 ,(mbody-val (<-wait this-thing 'get-name))
+                 ,(<-wait this-thing 'get-name)
                  " " ,preposition " " ,our-name ".")))
    ((not (eq? (.state gameobj) 'empty))
     (<- player 'tell
@@ -1175,7 +1539,7 @@ the paint, but the wires themselves seem to be unusually sturdy."
                                #: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)))
+    (<-wait (dyn-ref gameobj 'computer-room:hard-drive) 'get-state))
   (define (tell-room text)
     (<-wait (gameobj-loc gameobj) 'tell-room
         #:text text))
@@ -1189,7 +1553,7 @@ the paint, but the wires themselves seem to be unusually sturdy."
   (cond
    ((ci-member direct-obj '("program"))
     (tell-room-excluding-player
-     `(,(mbody-val (<-wait player 'get-name))
+     `(,(<-wait player 'get-name)
        " runs the program loaded on the computer..."))
     (tell-player "You run the program on the computer...")
 
@@ -1206,7 +1570,7 @@ the paint, but the wires themselves seem to be unusually sturdy."
 (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))))
+            (slot-ref panel 'open)))
    (open-up floor-panel-open-up))
   (open #:init-value #f))
 
@@ -1237,8 +1601,8 @@ the paint, but the wires themselves seem to be unusually sturdy."
     #:name "Computer Room"
     #:desc (lambda (gameobj whos-looking)
              (define panel-open
-               (mbody-val (<-wait (dyn-ref gameobj 'computer-room:floor-panel)
-                                  'open?)))
+               (<-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.")
@@ -1258,8 +1622,8 @@ the paint, but the wires themselves seem to be unusually sturdy."
             #:traverse-check
             (lambda (exit room whos-exiting)
               (define panel-open
-                (mbody-val (<-wait (dyn-ref room 'computer-room:floor-panel)
-                                   'open?)))
+                (<-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 "
@@ -1367,8 +1731,22 @@ is a map detailing the layout of the underground structure."))
             #:to 'hive-entrance)
           (make <exit>
             #:name "east"
-            #:to 'federation-station)))
-
+            #:to 'federation-station)
+          (make <exit>
+            #:name "south"
+            #:traverse-check
+            (lambda (exit room whos-exiting)
+              (values #f '("Ooh, if only you could go south and check this out! "
+                           "Unfortunately this whole area is sealed off... the proprietor "
+                           "probably never got around to fixing it. "
+                           "Too bad, it would have had monsters to fight and everything!"))))
+          (make <exit>
+            #:name "southwest"
+            #:traverse-check
+            (lambda (exit room whos-exiting)
+              (values #f '("Hm, it's one of those revolving doors that only revolves in "
+                           "one direction, and it isn't this one.  You guess that while "
+                           "this doesn't appear to be an entrance, it probably is an exit."))))))
    ;; map
    ('underground-lab:map
     <readable> 'underground-lab
@@ -1381,7 +1759,7 @@ is a map detailing the layout of the underground structure."))
    ('underground-lab:8sync-sign
     <readable> 'underground-lab
     #:name "a sign labeled \"8sync design goals\""
-    #:goes-by '("sign" "8sync design goals sign" "8sync sign")
+    #:goes-by '("sign" "8sync design goals sign" "8sync goals" "8sync design" "8sync sign")
     #:read-text 8sync-design-goals
     #:desc `((p "The sign says:")
              ,8sync-design-goals))))
@@ -1561,11 +1939,18 @@ as well as an exit leading to the south."))
    ('gift-shop
     <room> #f
     #:name "Museum Gift Shop"
-    #:desc "foo"
+    #:desc '("There are all sorts of scrolls and knicknacks laying around here, "
+             "but they all seem glued in place and instead of a person manning the shop "
+             "there's merely a cardboard cutout of a person with a \"shopkeeper\" nametag. "
+             "You can pretty well bet that someone wanted to finish this room but ran out of "
+             "time.")
     #:exits (list
              (make <exit>
                #:name "northeast"
-               #:to 'underground-lab)
+               #:to 'underground-lab
+               #:traverse-check
+               (lambda (exit room whos-exiting)
+                 (values #t '("The revolving door spins as you walk through it.  Whee!"))))
              (make <exit>
                #:name "north"
                #:to 'async-museum)))))