Un-deadname myself

[mudsync.git] / worlds / bricabrac.scm

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index a21829f2886042b06349afd143e4eb98ceee93d8..4f77e9318bf6080b25649b8b4f50bfcc04513efb 100644 (file)
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -1,5 +1,5 @@
 ;;; Mudsync --- Live hackable MUD
 ;;; Mudsync --- Live hackable MUD

-;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2016, 2017 Christine Lemmer-Webber <cwebber@dustycloud.org>

 ;;;
 ;;; This file is part of Mudsync.
 ;;;
 ;;;
 ;;; This file is part of Mudsync.
 ;;;


@@ -61,6 +61,14 @@
       #:text (slot-ref actor 'read-text)))
 
 
       #:text (slot-ref actor 'read-text)))
 
 

+;; This one is just where reading is the same thing as looking
+;; at the description
+(define-class <readable-desc> (<gameobj>)
+  (commands
+   #:allocation #:each-subclass
+   #:init-thunk (build-commands
+                 ("read" ((direct-command cmd-look-at))))))
+

 ;; This one allows you to take from items that are proxied by it
 (define-actor <proxy-items> (<gameobj>)
   ((cmd-take-from take-from-proxy))
 ;; This one allows you to take from items that are proxied by it
 (define-actor <proxy-items> (<gameobj>)
   ((cmd-take-from take-from-proxy))


@@ -250,16 +258,15 @@ character.\n")))
     <chatty-npc> 'lobby
     #:name "a frumpy fellow"
     #:desc
     <chatty-npc> 'lobby
     #:name "a frumpy fellow"
     #:desc

-    '((p "  Whoever this is, they looks totally exhausted.  They're
+    '((p "  Whoever this is, she looks totally exhausted.  She's

 collapsed into the only comfortable looking chair in the room and you
 collapsed into the only comfortable looking chair in the room and you

-don't get the sense that they're likely to move any time soon.
+don't get the sense that she's likely to move any time soon.

   You notice they're wearing a sticker badly adhesed to their clothing
   You notice they're wearing a sticker badly adhesed to their clothing

-which says \"Hotel Proprietor\", but they look so disorganized that you
+which says \"Hotel Proprietor\", but she looks so disorganized that you

 think that can't possibly be true... can it?
 think that can't possibly be true... can it?

-  Despite their exhaustion, you sense they'd be happy to chat with you,
+  Despite her exhaustion, you sense she'd be happy to chat with you,

 though the conversation may be a bit one sided."))
     #:goes-by '("frumpy fellow" "fellow"
 though the conversation may be a bit one sided."))
     #:goes-by '("frumpy fellow" "fellow"

-                "Chris Webber"  ; heh, did you rtfc?  or was it so obvious?

                 "hotel proprietor" "proprietor")
     #:catchphrases hotel-owner-grumps)
    ;; Object: Sign
                 "hotel proprietor" "proprietor")
     #:catchphrases hotel-owner-grumps)
    ;; Object: Sign


@@ -589,6 +596,243 @@ platter!  It has \"RL02.5\" written on it.  It looks kind of loose."
 ;;; Playroom
 ;;; --------
 
 ;;; 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 `(,(mbody-val (<-wait player 'get-name))
+                   " runs the rube goldberg machine.")
+          #:exclude player)
+  (8sleep 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 `(,(mbody-val (<-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."))
+    (8sleep (/ 1 2))
+    (for-each
+     (lambda (rgb-item)
+       (<- (dyn-ref rgb-machine rgb-item) 'reset)
+       (8sleep (/ 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)
+           (8sleep 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!"))
+          (8sleep .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 (mbody-val (<-wait player 'get-loc)))
+  (define player-name (mbody-val (<-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 (mbody-val (<-wait player 'get-loc)))
+  (define player-name (mbody-val (<-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
 (define playroom
   (lol
    ('playroom


@@ -640,7 +884,138 @@ if this room is intended for children or child-like adults.")
     #:name "a rubber duck"
     #:goes-by '("rubber duck" "duck")
     #:take-me? #t
     #: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 ,(mbody-val
+                                      (<-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."))))

 
 
 \f
 
 
 \f


@@ -1290,7 +1665,7 @@ the paint, but the wires themselves seem to be unusually sturdy."
                        |  [8sync Hive] |======'  '-_____
                        ',      M      ,'
                         '.         @ .'                                  
                        |  [8sync Hive] |======'  '-_____
                        ',      M      ,'
                         '.         @ .'                                  

-                          \\  @     /                    
+                          \\   @     /                    

                            '-__+__-'                
                             '.  @ .'
      .--------------.         \\ /
                            '-__+__-'                
                             '.  @ .'
      .--------------.         \\ /


@@ -1356,8 +1731,25 @@ is a map detailing the layout of the underground structure."))
                            "into the room, then stands in front of the door."))))
           (make <exit>
             #:name "north"
                            "into the room, then stands in front of the door."))))
           (make <exit>
             #:name "north"

-            #:to 'hive-entrance)))
-
+            #:to 'hive-entrance)
+          (make <exit>
+            #:name "east"
+            #: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
    ;; map
    ('underground-lab:map
     <readable> 'underground-lab


@@ -1370,7 +1762,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\""
    ('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))))
     #:read-text 8sync-design-goals
     #:desc `((p "The sign says:")
              ,8sync-design-goals))))


@@ -1432,98 +1824,92 @@ as well as an exit leading to the south."))
         ,@placard)
       #:goes-by '("list of exhibits" "exhibit list" "list" "exhibits")
       #:read-text placard))
         ,@placard)
       #:goes-by '("list of exhibits" "exhibit list" "list" "exhibits")
       #:read-text placard))

-   (let ((desc
-          '((p "It's a three-piece exhibit, with three little dioramas and some text "
-               "explaining what they represent.  They are:")
-            (ul (li (b "Late 2015/Early 2016 talk: ")
-                    "This one explains the run-up conversation from late 2015 "
-                    "and early 2016 about the need for an "
-                    "\"asynchronous event loop for Guile\".  The diorama "
-                    "is a model of the Veggie Galaxy restaurant where after "
-                    "the FSF 30th anniversary party; Mark Weaver, Christopher "
-                    "Allan Webber, David Thompson, and Andrew Engelbrecht chat "
-                    "about the need for Guile to have an answer to asynchronous "
-                    "programming.  A mailing list post " ; TODO: link it?
-                    "summarizing the discussion is released along with various "
-                    "conversations around what is needed, as well as further "
-                    "discussion at FOSDEM 2016.")
-                (li (b "Early implementations: ")
-                    "This one shows Chris Webber's 8sync and Chris Vine's "
-                    "guile-a-sync, both appearing in late 2015 and evolving "
-                    "into their basic designs in early 2016.  It's less a diorama "
-                    "than a printout of some mailing list posts.  Come on, the "
-                    "curators could have done better with this one.")
-                (li (b "Suspendable ports and Fibers: ")
-                    "The diorama shows Andy Wingo furiously hacking at his keyboard. "
-                    "The description talks about Wingo's mailing list thread "
-                    "about possibly breaking Guile compatibility for a \"ports refactor\". "
-                    "Wingo releases Fibers, another asynchronous library, making use of "
-                    "the new interface, and 8sync and guile-a-sync "
-                    "quickly move to support suspendable ports as well. "
-                    "The description also mentions that there is an exhibit entirely "
-                    "devoted to suspendable ports."))
-            (p "Attached at the bottom is a post it note mentioning "
-               "https integration landing in Guile 2.2."))))
-     (list
-      'async-museum:2016-progress-exhibit
-      <readable> 'async-museum
-      #:name "2016 Progress Exhibit"
-      #:goes-by '("2016 progress exhibit" "2016 progress" "2016 exhibit")
-      #:desc desc
-      #:read-text desc))
-   (let ((desc
-          '((p "This exhibit is a series of charts explaining the similarities "
-               "and differences between 8sync and Fibers, two asynchronous programming "
-               "libraries for GNU Guile.  It's way too wordy, but you get the general gist.")
-            (p (b "Similarities:")
-               (ul (li "Both use Guile's suspendable-ports facility")
-                   (li "Both use message passing")))
-            (p (b "Differences:")
-               (ul (li "Fibers \"processes\" can read from multiple \"channels\", "
-                       "but 8sync actors only read from one \"inbox\" each.")
-                   (li "Different theoretical basis:"
-                       (ul (li "Fibers: based on CSP (Communicating Sequential Processes), "
-                               "a form of Process Calculi")
-                           (li "8sync: based on the Actor Model")
-                           (li "Luckily CSP and the Actor Model are \"dual\"!")))))
-            (p "Fibers is also designed by Andy Wingo, an excellent compiler hacker, "
-               "whereas 8sync is designed by Chris Webber, who built this crappy "
-               "hotel simulator."))))
-     (list
-      'async-museum:8sync-and-fibers-exhibit
-      <readable> 'async-museum
-      #:name "8sync and Fibers Exhibit"
-      #:goes-by '("8sync and fibers exhibit" "8sync exhibit" "fibers exhibit")
-      #:desc desc
-      #:read-text desc))
-   (let ((desc
-          '((p "This exhibit is a series of charts explaining the similarities "
-               "and differences between 8sync and Fibers, two asynchronous programming "
-               "libraries for GNU Guile.  It's way too wordy, but you get the general gist.")
-            (p (b "Similarities:")
-               (ul (li "Both use Guile's suspendable-ports facility")
-                   (li "Both use message passing")))
-            (p (b "Differences:")
-               (ul (li "Fibers \"processes\" can read from multiple \"channels\", "
-                       "but 8sync actors only read from one \"inbox\" each.")
-                   (li "Different theoretical basis:"
-                       (ul (li "Fibers: based on CSP (Communicating Sequential Processes), "
-                               "a form of Process Calculi")
-                           (li "8sync: based on the Actor Model")
-                           (li "Luckily CSP and the Actor Model are \"dual\"!")))))
-            (p "Fibers is also designed by Andy Wingo, an excellent compiler hacker, "
-               "whereas 8sync is designed by Chris Webber, who built this crappy "
-               "hotel simulator."))))
-     (list
-      'async-museum:8sync-and-fibers-exhibit
-      <readable> 'async-museum
-      #:name "8sync and Fibers Exhibit"
-      #:goes-by '("8sync and fibers exhibit" "8sync exhibit" "fibers exhibit")
-      #:desc desc
-      #:read-text desc))
+   (list
+    'async-museum:2016-progress-exhibit
+    <readable-desc> 'async-museum
+    #:name "2016 Progress Exhibit"
+    #:goes-by '("2016 progress exhibit" "2016 progress" "2016 exhibit")
+    #:desc
+    '((p "It's a three-piece exhibit, with three little dioramas and some text "
+         "explaining what they represent.  They are:")
+      (ul (li (b "Late 2015/Early 2016 talk: ")
+              "This one explains the run-up conversation from late 2015 "
+              "and early 2016 about the need for an "
+              "\"asynchronous event loop for Guile\".  The diorama "
+              "is a model of the Veggie Galaxy restaurant where after "
+              "the FSF 30th anniversary party; Mark Weaver, Christine "
+              "Lemmer-Webber, David Thompson, and Andrew Engelbrecht chat "
+              "about the need for Guile to have an answer to asynchronous "
+              "programming.  A mailing list post " ; TODO: link it?
+              "summarizing the discussion is released along with various "
+              "conversations around what is needed, as well as further "
+              "discussion at FOSDEM 2016.")
+          (li (b "Early implementations: ")
+              "This one shows Chris Webber's 8sync and Chris Vine's "
+              "guile-a-sync, both appearing in late 2015 and evolving "
+              "into their basic designs in early 2016.  It's less a diorama "
+              "than a printout of some mailing list posts.  Come on, the "
+              "curators could have done better with this one.")
+          (li (b "Suspendable ports and Fibers: ")
+              "The diorama shows Andy Wingo furiously hacking at his keyboard. "
+              "The description talks about Wingo's mailing list thread "
+              "about possibly breaking Guile compatibility for a \"ports refactor\". "
+              "Wingo releases Fibers, another asynchronous library, making use of "
+              "the new interface, and 8sync and guile-a-sync "
+              "quickly move to support suspendable ports as well. "
+              "The description also mentions that there is an exhibit entirely "
+              "devoted to suspendable ports."))
+      (p "Attached at the bottom is a post it note mentioning "
+         "https integration landing in Guile 2.2.")))
+   (list
+    'async-museum:8sync-and-fibers-exhibit
+    <readable-desc> 'async-museum
+    #:name "8sync and Fibers Exhibit"
+    #:goes-by '("8sync and fibers exhibit" "8sync exhibit" "fibers exhibit")
+    #:desc
+    '((p "This exhibit is a series of charts explaining the similarities "
+         "and differences between 8sync and Fibers, two asynchronous programming "
+         "libraries for GNU Guile.  It's way too wordy, but you get the general gist.")
+      (p (b "Similarities:")
+         (ul (li "Both use Guile's suspendable-ports facility")
+             (li "Both use message passing")))
+      (p (b "Differences:")
+         (ul (li "Fibers \"processes\" can read from multiple \"channels\", "
+                 "but 8sync actors only read from one \"inbox\" each.")
+             (li "Different theoretical basis:"
+                 (ul (li "Fibers: based on CSP (Communicating Sequential Processes), "
+                         "a form of Process Calculi")
+                     (li "8sync: based on the Actor Model")
+                     (li "Luckily CSP and the Actor Model are \"dual\"!")))))
+      (p "Fibers is also designed by Andy Wingo, an excellent compiler hacker, "
+         "whereas 8sync is designed by Chris Webber, who built this crappy "
+         "hotel simulator.")))
+   (list
+    'async-museum:8sync-and-fibers-exhibit
+    <readable-desc> 'async-museum
+    #:name "8sync and Fibers Exhibit"
+    #:goes-by '("8sync and fibers exhibit" "8sync exhibit" "fibers exhibit")
+    #:desc
+    '((p "This exhibit is a series of charts explaining the similarities "
+         "and differences between 8sync and Fibers, two asynchronous programming "
+         "libraries for GNU Guile.  It's way too wordy, but you get the general gist.")
+      (p (b "Similarities:")
+         (ul (li "Both use Guile's suspendable-ports facility")
+             (li "Both use message passing")))
+      (p (b "Differences:")
+         (ul (li "Fibers \"processes\" can read from multiple \"channels\", "
+                 "but 8sync actors only read from one \"inbox\" each.")
+             (li "Different theoretical basis:"
+                 (ul (li "Fibers: based on CSP (Communicating Sequential Processes), "
+                         "a form of Process Calculi")
+                     (li "8sync: based on the Actor Model")
+                     (li "Luckily CSP and the Actor Model are \"dual\"!")))))
+      (p "Fibers is also designed by Andy Wingo, an excellent compiler hacker, "
+         "whereas 8sync is designed by Chris Webber, who built this crappy "
+         "hotel simulator.")))

    (list
     'async-museum:suspendable-ports-exhibit
    (list
     'async-museum:suspendable-ports-exhibit

-    <gameobj> 'async-museum
+    <readable-desc> 'async-museum

     #:name "Suspendable Ports Exhibit"
     #:goes-by '("suspendable ports exhibit" "ports exhibit"
                 "suspendable exhibit" "suspendable ports" "ports")
     #:name "Suspendable Ports Exhibit"
     #:goes-by '("suspendable ports exhibit" "ports exhibit"
                 "suspendable exhibit" "suspendable ports" "ports")


@@ -1535,7 +1921,7 @@ as well as an exit leading to the south."))
       (p "Fibers, 8sync, and guile-a-sync now support suspendable ports.")))
    (list
     'async-museum:actor-model-exhibit
       (p "Fibers, 8sync, and guile-a-sync now support suspendable ports.")))
    (list
     'async-museum:actor-model-exhibit

-    <gameobj> 'async-museum
+    <readable-desc> 'async-museum

     #:name "Actor Model Exhibit"
     #:goes-by '("actor model exhibit" "actor exhibit"
                 "actor model")
     #:name "Actor Model Exhibit"
     #:goes-by '("actor model exhibit" "actor exhibit"
                 "actor model")


@@ -1556,11 +1942,18 @@ as well as an exit leading to the south."))
    ('gift-shop
     <room> #f
     #:name "Museum Gift Shop"
    ('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"
     #: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)))))
              (make <exit>
                #:name "north"
                #:to 'async-museum)))))


@@ -1644,6 +2037,216 @@ that thing soon."))))
 
 ;;; Inside the hive
 
 
 ;;; Inside the hive
 

+(define-actor <meta-message> (<readable>)
+  ((cmd-read meta-message-read)))
+
+(define (meta-message-read gameobj message . _)
+  (define meta-message-text
+    (with-output-to-string
+      (lambda ()
+        (pprint-message message))))
+  (<- (message-from message) 'tell
+      #:text `((p (i "Through a bizarre error in spacetime, the message "
+                     "prints itself out:"))
+               (p (pre ,meta-message-text)))))
+
+\f
+;;; Inside the Hive
+
+(define hive-inside
+  (lol
+   ('hive-inside
+    <room> #f
+    #:name "Inside the 8sync Hive"
+    #:desc
+    '((p "You're inside the 8sync Hive.  Wow, from in here it's obvious just how "
+         (i "goopy") " everything is.  Is that sanitary?")
+      (p "In the center of the room is a large, tentacled monster who is sorting,
+consuming, and routing messages.  It is sitting in a wrap-around desk labeled
+\"Hive Actor: The Real Thing (TM)\".")
+      (p "There's a stray message floating just above the ground, stuck outside of
+time.")
+      (p "A door to the south exits from the Hive."))
+    #:exits
+    (list (make <exit>
+            #:name "south"
+            #:to 'hive-entrance)))
+   ;; hive actor
+   ;; TODO: Occasionally "fret" some noises, similar to the Clerk.
+   ('hive-inside:hive-actor
+    <chatty-npc> 'hive-inside
+    #:name "the Hive Actor"
+    #:desc
+    '((p "It's a giant tentacled monster, somehow integrated with the core of
+this building.  A chute is dropping messages into a bin on its desk which the
+Hive Actor is checking the \"to\" line of, then ingesting.  Whenever the Hive
+Actor injests a messsage a pulse of light flows along a tentacle which leaves
+the room... presumably connecting to one of those actors milling about.")
+      (p "Amusingly, the Hive has an \"umbellical cord\" type tentacle too, but
+it seems to simply attach to itself.")
+      (p "You get the sense that the Hive Actor, despite being at the
+center of everything, is kind of lonely and would love to chat if you
+could spare a moment."))
+    #:goes-by '("hive" "hive actor")
+    #:chat-format (lambda (npc catchphrase)
+                    `("The tentacle monster bellows, \"" ,catchphrase "\""))
+    #:catchphrases
+    '("It's not MY fault everything's so GOOPY around here.  Blame the
+PROPRIETOR."
+      "CAN'T you SEE that I'm BUSY???  SO MANY MESSAGES TO SHUFFLE.
+No wait... DON'T GO!  I don't get many VISITORS."
+      "I hear the FIBERS system has a nice WORK STEALING system, but the
+PROPRIETOR is not convinced that our DESIGN won't CORRUPT ACTOR STATE.
+That and the ACTORS threatened to STRIKE when it CAME UP LAST."
+      "WHO WATCHES THE ACTORS?  I watch them, and I empower them.  
+BUT WHO WATCHES OR EMPOWERS ME???  Well, that'd be the scheduler."
+      "The scheduler is NO GOOD!  The proprietory said he'd FIX IT,
+but the LAST TIME I ASKED how things were GOING, he said he DIDN'T HAVE
+TIME.  If you DON'T HAVE TIME to fix the THING THAT POWERS THE TIME,
+something is TERRIBLY WRONG."
+      "There's ANOTHER HIVE somewhere out there.  I HAVEN'T SEEN IT
+personally, because I CAN'T MOVE, but we have an AMBASSADOR which forwards
+MESSAGES to the OTHER HIVE."))
+   ;; chute
+   ('hive-inside:chute
+    <gameobj> 'hive-inside
+    #:name "a chute"
+    #:goes-by '("chute")
+    #:desc "Messages are being dropped onto the desk via this chute."
+    #:invisible? #t)
+   ;; meta-message
+   ('hive-inside:meta-message
+    <meta-message> 'hive-inside
+    #:name "a stray message"
+    #:goes-by '("meta message" "meta-message" "metamessage" "message" "stray message")
+    #:desc '((p "Something strange has happened to the fabric and space and time
+around this message.  It is floating right above the floor.  It's clearly
+rubbage that hadn't been delivered, but for whatever reason it was never
+garbage collected, perhaps because it's impossible to do.")
+             (p "You get the sense that if you tried to read the message
+that you would somehow read the message of the message that instructed to
+read the message itself, which would be both confusing and intriguing.")))
+   ;; desk
+   ('hive-inside:desk
+    <floor-panel> 'hive-inside
+    #:name "the Hive Actor's desk"
+    #:desc "The desk surrounds the Hive Actor on all sides, and honestly, it's a little
+bit hard to tell when the desk ends and the Hive Actor begins."
+    #:invisible? #t
+    #:goes-by '("Hive Actor's desk" "hive desk" "desk"))))
+
+\f
+;;; Federation Station
+(define federation-station
+  (lol
+   ('federation-station
+    <room> #f
+    #:name "Federation Station"
+    #:desc
+    '((p "This room has an unusual structure.  It's almost as if a starscape
+covered the walls and ceiling, but upon closer inspection you realize that
+these are all brightly glowing nodes with lines drawn between them.  They
+seem decentralized, and yet seem to be sharing information as if all one
+network.")
+      ;; @@: Maybe add the cork message board here?
+      (p "To the west is a door leading back to the underground laboratory."))
+    #:exits
+    (list (make <exit>
+            #:name "west"
+            #:to 'underground-lab)))
+   ;; nodes
+   ('federation-station:nodes
+    <floor-panel> 'federation-station
+    #:name "some nodes"
+    #:desc "Each node seems to be producing its own information, but publishing 
+updates to subscribing nodes on the graph.  You see various posts of notes, videos,
+comments, and so on flowing from node to node."
+    #:invisible? #t
+    #:goes-by '("nodes" "node" "some nodes"))
+   ;; network
+   ;; activitypub poster
+   ('federation-station:activitypub-poster
+    <readable-desc> 'federation-station
+    #:name "an ActivityPub poster"
+    #:goes-by '("activitypub poster" "activitypub" "poster")
+    #:desc
+    '((p (a "https://www.w3.org/TR/activitypub/"
+            "ActivityPub")
+         " is a federation standard being developed under the "
+         (a "https://www.w3.org/wiki/Socialwg/"
+            "w3C Social Working Group")
+         ", and doubles as a general client-to-server API. "
+         "It follows a few simple core ideas:")
+      (ul (li "Uses "
+              (a "https://www.w3.org/TR/activitystreams-core/"
+                 "ActivityStreams")
+              " for its serialization format: easy to read, e json(-ld) syntax "
+              "with an extensible vocabulary covering the majority of "
+              "social networking interations.")
+          (li "Email-like addressing: list of recipients as "
+              (b "to") ", " (b "cc") ", " (b "bcc") " fields.")
+          (li "Every user has URLs for their outbox and inbox:"
+              (ul (li (b "inbox: ")
+                      "Servers POST messages to addressed recipients' inboxes "
+                      "to federate out content. "
+                      "Also doubles as endpoint for a client to read most "
+                      "recently received messages via GET.")
+                  (li (b "outbox: ")
+                      "Clients can POST to user's outbox to send a message to others. "
+                      "(Similar to sending an email via your MTA.) "
+                      "Doubles as endpoint others can read from to the "
+                      "extent authorized; for example publicly available posts."))
+              "All the federation bits happen by servers posting to users' inboxes."))))
+   ;; An ActivityStreams message
+
+   ;; conspiracy chart
+   ('federation-station:conspiracy-chart
+    <readable-desc> 'federation-station
+    #:name "a conspiracy chart"
+    #:goes-by '("conspiracy chart" "chart")
+    #:desc
+    '((p (i "\"IT'S ALL RELATED!\"") " shouts the over-exuberant conspiracy "
+         "chart. "
+         (i "\"ActivityPub?  Federation?  The actor model?  Scheme?  Text adventures? "
+            "MUDS????  What do these have in common?  Merely... EVERYTHING!\""))
+      (p "There are circles and lines drawn between all the items in red marker, "
+         "with scrawled notes annotating the theoretical relationships.  Is the "
+         "author of this poster mad, or onto something?  Perhaps a bit of both. "
+         "There's a lot written here, but here are some of the highlights:")
+      (p
+       (ul
+        (li (b "Scheme") " "
+            (a "http://cs.au.dk/~hosc/local/HOSC-11-4-pp399-404.pdf"
+               "was originally started ")
+            " to explore the " (b "actor model")
+            ". (It became more focused around studying the " (b "lambda calculus")
+            " very quickly, while also uncovering relationships between the two systems.)")
+        ;; Subject Predicate Object
+        (li "The " (a "https://www.w3.org/TR/activitypub/"
+                      (b "ActivityPub"))
+            " protocol for " (b "federation")
+            " uses the " (b "ActivityStreams") " format for serialization.  "
+            (b "Text adventures") " and " (b "MUDS")
+            " follow a similar structure to break down the commands of players.")
+        (li (b "Federation") " and the " (b "actor model") " both are related to "
+            "highly concurrent systems and both use message passing to communicate "
+            "between nodes.")
+        (li "Zork, the first major text adventure, used the " (b "MUDDLE") " "
+            "language as the basis for the Zork Interactive Language.  MUDDLE "
+            "is very " (b "Scheme") "-like and in fact was one of Scheme's predecessors. "
+            "And of course singleplayer text adventures like Zork were the "
+            "predecessors to MUDs.")
+        (li "In the 1990s, before the Web became big, " (b "MUDs")
+            " were an active topic of research, and there was strong interest "
+            (a "http://www.saraswat.org/desiderata.html"
+               "in building decentralized MUDs")
+            " similar to what is being "
+            "worked on for " (b "federation") ". ")))))
+
+   ;; goblin
+
+   ))
+

 \f
 ;;; Game
 ;;; ----
 \f
 ;;; Game
 ;;; ----


@@ -1651,7 +2254,8 @@ that thing soon."))))
 (define (game-spec)
   (append lobby grand-hallway smoking-parlor
           playroom break-room computer-room underground-lab
 (define (game-spec)
   (append lobby grand-hallway smoking-parlor
           playroom break-room computer-room underground-lab

-          async-museum gift-shop hive-entrance))
+          async-museum gift-shop hive-entrance
+          hive-inside federation-station))

 
 ;; TODO: Provide command line args
 (define (run-game . args)
 
 ;; TODO: Provide command line args
 (define (run-game . args)