;;; 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.
;;;
#: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))
;; NPC: hotel owner
('lobby:hotel-owner
<chatty-npc> 'lobby
- #:name "a frumpy fellow"
+ #:name "a languid lady"
#: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
-don't get the sense that they're likely to move any time soon.
- You notice they're wearing a sticker badly adhesed to their clothing
-which says \"Hotel Proprietor\", but they look so disorganized that you
-think that can't possibly be true... can it?
- Despite their exhaustion, you sense they'd be happy to chat with you,
-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?
+don't get the sense that she's likely to move any time soon.
+ Attached to her frumpy dress is a barely secured pin which says
+\"Hotel Proprietor\", but she looks so disorganized that you think
+that can't possibly be true... can it?")
+ (p "Despite her exhaustion, you sense she'd be happy to chat
+with you, though the conversation may be a bit one sided."))
+
+ #:goes-by '("languid lady" "lady"
"hotel proprietor" "proprietor")
#:catchphrases hotel-owner-grumps)
;; Object: Sign
English language surrounding the word 'free' have lead to a lot of terminology debates."))
#:goes-by '("scroll of teletype" "scroll of teletype paper" "teletype scroll"
"teletype paper" "scroll" "four freedoms"
+ "paper"
"scroll of teletype paper holding the software Four Freedoms"
"scroll of teletype paper holding the software four freedoms"))
('lobby:orange-cat-phone
#:goes-by '("orange cartoon cat phone" "orange cartoon cat telephone"
"orange cat phone" "orange cat telephone"
"cartoon cat phone" "cartoon cat"
- "cat phone" "cat telephone" "phone" "telephone"))))
+ "cat phone" "cat telephone" "phone" "telephone"))
+ ('lobby:monster-stuffie
+ <gameobj> 'lobby
+ #:name "an off-brand monster stuffie"
+ #:desc "It's an off brand monster stuffed animal that looks, well kinda
+like a popular character you've seen in a video game, but there's been a very
+thin attempt to make it look like something different... mostly by changing
+the shape of the ears. It's cute though!"
+ #:take-me? #t
+ #:goes-by '("monster stuffie" "monster" "stuffed animal" "stuffed monster"
+ "off-brand monster stuffie" "stuffie" "monster stuffie"))))
\f
#:allocation #:each-subclass
#:init-thunk (build-props
'((hd-platter? . #t))))
+ (take-me? #:allocation #:each-subclass
+ #:init-value #t)
(name #:allocation #:each-subclass
#:init-value "a glowing disc")
(desc #:allocation #:each-subclass
(define lobby-map-text
"\
+
+ .----+++++----.
+ | : : |
+ + : north : +
+ | : hall : |
+ + : : +
+ |_ : _____ : _|
| : : |
.----------.----------. : & : .----------.----------.
| computer | |& :YOU ARE: &| smoking | *UNDER* |
'---------'")
(define grand-hallway
+
(lol
('grand-hallway
<room> #f
room\", while a door to the west is labeled \"playroom\"."))
#:exits
(list (make <exit>
+ #:name "north"
+ #:to 'north-hall)
+ (make <exit>
#:name "south"
#:to 'lobby)
(make <exit>
spirit\". You've heard of Hackthena... not a goddess, but spiritual protector of
all good hacks, and legendary hacker herself.")
(p "Hackthena holds the form of a human woman. She wears flowing
-robes, has a pear of curly bovine-esque horns protruding from the sides of her
+robes, has a pair of curly bovine-esque horns protruding from the sides of her
head, wears a pair of horn-rimmed glasses, and appears posed as if for battle.
But instead of a weapon, she seems to hold some sort of keyboard. And her
shield... well it's round like a shield, but something seems off about it.
;;; 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
#: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..."
+ .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
<furniture> 'smoking-parlor
#:name "a comfy leather chair"
#:desc " That leather chair looks really comfy!"
- #:goes-by '("leather chair" "comfy leather chair" "chair")
+ #:goes-by '("leather chair" "comfy leather chair" "chair" "comfy chair")
#:sit-phrase "sink into"
#:sit-phrase-third-person "sinks into"
#:sit-name "the comfy leather chair")
| [8sync Hive] |======' '-_____
', M ,'
'. @ .'
- \\ @ /
+ \\ @ /
'-__+__-'
'. @ .'
.--------------. \\ /
"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
('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))))
,@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
- <gameobj> 'async-museum
+ <readable-desc> 'async-museum
#:name "Suspendable Ports Exhibit"
#:goes-by '("suspendable ports exhibit" "ports exhibit"
"suspendable exhibit" "suspendable ports" "ports")
(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")
('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. "
+ "It looks like there's an exit to the northeast, should you choose that you "
+ "want to get out of here.")
#: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)))))
"What a lousy scheduler we're using! I hope someone upgrades
that thing soon."))))
-;;;
+;;; 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 "https://en.wikipedia.org/wiki/History_of_the_Scheme_programming_language"
+ "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
+;;; North hall
+;;; ==========
+(define north-hall
+ (lol
+ ('north-hall
+ <room> #f
+ #:name "North Hall"
+ #:desc
+ '((p "This hallway is lined by doors to the west and the east, presumably
+to various lodgings. Something tells you you're not able to enter those right
+now, however. Lining the walls are some large mirrors surrounded by bouquets
+of flowers.")
+ (p "The red carpet continues all the way from Grand Hallway in the south
+but stops short of some large wooden doors to the north. The doors look
+formidable but unlocked. Some natural light peeking through windows to the
+north seem to hint that this may be the exit to the outdoors. There's
+also a large sign near the doors on a wooden easel."))
+ #:exits
+ (list (make <exit>
+ #:name "north"
+ #:to 'courtyard)
+ (make <exit>
+ #:name "south"
+ #:to 'grand-hallway)))
+ ('north-hall:sign
+ <readable> 'north-hall
+ #:name "an easel with a sign"
+ #:desc " The easel is finely cut wood, well polished, but plain. The sign
+is a strong contrast, with a cream colored backing and hand written letters, written
+with care and style. You could probably read it."
+ #:read-text "The sign announces a wedding taking place... why, today! And on
+the hotel grounds to the north! It sounds very exciting."
+ #:goes-by '("sign"
+ "easel with a sign"
+ "easel"))
+ ('north-hall:mirrors
+ <gameobj> 'north-hall
+ #:name "a row of mirrors"
+ #:desc "You see yourself for who you really are."
+ #:invisible? #t
+ #:goes-by '("mirror" "mirrors" "row of mirrors"))
+ ('north-hall:windows
+ <gameobj> 'north-hall
+ #:name "windows"
+ #:desc "You peer out a window, but the light appears distorted, as if you were
+really peering between two worlds hastily joined together."
+ #:invisible? #t
+ #:goes-by '("window" "windows"))
+ ('north-hall:doors
+ <gameobj> 'north-hall
+ #:name "doors"
+ #:desc '((p "Along the east and west walls are doors, but they are all shut,
+and firmly so.
+Presumably people are staying in them, but it also feels as if how residence
+would work in a building as hastily put together as this was barely conceived.")
+ (p "To the north is a large set of wooden doors, oaken and beautiful.
+Although towering, they seem passable."))
+ #:invisible? #f
+ #:goes-by '("door" "doors" "room doors" "large doors"))))
+
+
+;;; ============
+;;; WEDDING TIME
+;;; ============
+
+(define wedding-map-text
+ "\
+ Banquet
+ &Stairs
+ (========)
+ .----.\\======/=.----.
+ Fairy - : \\====/ : -
+ Go ./ : )==( : \\. Orchestra
+ Round / (&&&) : (/==\\) : & & & \\
+ / : : \\
+ .--------..--------..--------.
+ | _ _ .' '. ,,, ;
+Photo | | | |_| : Dance : .|_|. | Cake
+ | '-' : Floor : |___| |
+ ',-------.\\ ;.--------,'
+ ; .. '.......' ;
+ \\ ||)) .-=-. ^ */
+ \\.||(( ^ // \\\\^ * ^'./
+ Play '. ^ ;; ;;^ ^.,'
+ Ground +----||-----||----+ Flowers
+ | .---. |
+ | |_ _| [F] |
+ | | |
+ | Entrance |
+ '-----------------'")
+
+
+(define-class <semi-edible-chatty-npc> (<chatty-npc>)
+ (commands
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ (("eat") ((direct-command cmd-eat)))))
+ (eat-catchphrase
+ #:init-keyword #:eat-catchphrase
+ #:accessor .eat-catchphrase
+ #:init-value "Should you really eat this?")
+ (actions #:allocation #:each-subclass
+ #:init-thunk
+ (build-actions
+ (cmd-eat cmd-eat-semi-edible-chatty-npc))))
+
+(define* (cmd-eat-semi-edible-chatty-npc actor message #:key direct-obj)
+ (<- (message-from message) 'tell
+ #:text (.eat-catchphrase actor)))
+
+(define-class <dancers> (<chatty-npc>)
+ (commands
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ (("dance") ((direct-command cmd-dance)))))
+ (actions #:allocation #:each-subclass
+ #:init-thunk
+ (build-actions
+ (cmd-dance cmd-dance-dancers))))
+
+(define* (cmd-dance-dancers actor message #:key direct-obj)
+ (define player (message-from message))
+ (define player-loc (mbody-val (<-wait player 'get-loc)))
+ (define player-name (mbody-val (<-wait player 'get-name)))
+ (<- (message-from message) 'tell
+ #:text '((p "You join in dancing with the dancers. You spin and
+get woozy... you feel wonderful... like you could dance forever...")
+ (p "You step out just in time, lest you be caught in
+the dancing for eternity!")))
+ (<- player-loc 'tell-room
+ #:text `((p ,player-name " begins dancing with the fairies and
+spins around and around... as if they might dance forever!")
+ (p "But " ,player-name " steps back just in time!
+Their eyes are cloudy and woozy, but they look happy..."))
+ #:exclude player))
+
+(define-class <swing> (<gameobj>)
+ (commands
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ (("sit" "swing") ((direct-command cmd-swing)))))
+ (actions #:allocation #:each-subclass
+ #:init-thunk
+ (build-actions
+ (cmd-swing cmd-swing-on-swing))))
+
+(define* (cmd-swing-on-swing actor message #:key direct-obj)
+ (define player (message-from message))
+ (define player-loc (mbody-val (<-wait player 'get-loc)))
+ (define player-name (mbody-val (<-wait player 'get-name)))
+ (<- (message-from message) 'tell
+ #:text '((p "You swing on the swing and feel younger again
+as you rock to the motion, as if your movements resemble your
+traversal through the flow of time itself. You feel happy.")))
+ (<- player-loc 'tell-room
+ #:text `((p ,player-name " looks very happy as they swing
+on the swing."))
+ #:exclude player))
+
+(define-class <fairy-go-round> (<gameobj>)
+ (commands
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ (("ride" "sit") ((direct-command cmd-ride)))))
+ (actions #:allocation #:each-subclass
+ #:init-thunk
+ (build-actions
+ (cmd-ride cmd-ride-on-fairy-go-round))))
+
+(define* (cmd-ride-on-fairy-go-round actor message #:key direct-obj)
+ (define player (message-from message))
+ (define player-loc (mbody-val (<-wait player 'get-loc)))
+ (define player-name (mbody-val (<-wait player 'get-name)))
+ (<- (message-from message) 'tell
+ #:text '((p "You ride on the fairy go round. Your vision blurs
+and refocuses into places everywhere in this realm and every other.
+You feel a part of everywhere at once for a moment, and then, you
+step off.")))
+ (<- player-loc 'tell-room
+ #:text `((p ,player-name " rides on the fairy go round and seems
+to be everywhere and nowhere at once for a moment before stepping off."))
+ #:exclude player))
+
+(define-actor <cake> (<semi-edible-chatty-npc>)
+ ((cmd-take cake-cmd-take)))
+
+(define-actor <slice-of-cake> (<gameobj>)
+ ((cmd-nibble slice-of-cake-cmd-nibble)
+ (cmd-eat slice-of-cake-cmd-eat))
+ (contained-commands
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ ("nibble" ((direct-command cmd-nibble)))
+ ("eat" ((direct-command cmd-eat)))))
+
+ (bites-left #:init-value 4
+ #:accessor .bites-left)
+ (name #:init-value "a slice of cake")
+ (take-me? #:init-value #t)
+ (goes-by #:init-value '("slice of cake" "slice" "slice of wedding cake"
+ "piece of cake" "piece of wedding cake"))
+ (desc #:init-value "It's a slice of wedding cake! You could nibble on it
+or just plain eat it!"))
+
+(define (slice-of-cake-cmd-eat slice-of-cake 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 wolf down your piece of wedding cake all at once like some
+kind of hungry animal! You're making a huge mess!")
+ (<- player-loc 'tell-room
+ #:text `(,player-name
+ " wolfs down a piece of wedding cake all at once!
+They're making a huge mess!")
+ #:exclude player)
+ (gameobj-self-destruct slice-of-cake))
+
+(define (slice-of-cake-cmd-nibble slice-of-cake 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! (.bites-left slice-of-cake) (- (.bites-left slice-of-cake) 1))
+ (<- player 'tell
+ #:text "You take a nibble of your piece of wedding cake.
+How dignified!")
+ (<- player-loc 'tell-room
+ #:text `(,player-name
+ " takes a nibble of their piece of wedding cake.
+How dignified!")
+ #:exclude player)
+ (when (= (.bites-left slice-of-cake) 0)
+ (<- player 'tell
+ #:text "You've finished your slice of wedding cake!")
+ (<- player-loc 'tell-room
+ #:text `(,player-name
+ " finishes their slice of wedding cake!")
+ #:exclude player)
+ (gameobj-self-destruct slice-of-cake)))
+
+(define* (cake-cmd-take gameobj message
+ #:key direct-obj
+ (player (message-from message)))
+ (create-gameobj <slice-of-cake> (gameobj-gm gameobj)
+ player) ;; set loc to player to put in player's inventory
+ (<- player 'tell
+ #:text '((p "You slice off a piece of the tiered wedding cake.
+The cake fills itself back in as if by magic! Oh no, it's not alive, is it?")
+ (p "You take the slice of wedding cake with you.")))
+ (<- (gameobj-loc gameobj) 'tell-room
+ #:text `(,(mbody-val (<-wait player 'get-name))
+ " slices off a piece of the cake and the cake fills itself
+back in! How strange!")
+ #:exclude player))
+
+(define-class <flowers> (<gameobj>)
+ (commands
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ (("smell" "sniff") ((direct-command cmd-smell)))))
+ (actions #:allocation #:each-subclass
+ #:init-thunk
+ (build-actions
+ (cmd-smell flowers-cmd-smell))))
+
+(define* (flowers-cmd-smell actor message #:key direct-obj)
+ (define player (message-from message))
+ (define player-loc (mbody-val (<-wait player 'get-loc)))
+ (define player-name (mbody-val (<-wait player 'get-name)))
+ (<- (message-from message) 'tell
+ #:text '((p "You smell the flower and... whoa. Wait. What kind
+of flower is this?")
+ (p "You teeter as the room spins and then politely
+re-orients itself.")))
+ (<- player-loc 'tell-room
+ #:text `((p ,player-name " smells the flower and teeters around
+a bit."))
+ #:exclude player))
+
+(define-actor <frog> (<chatty-npc>)
+ ;; TODO: Add "open" verb, since obviously people will try that
+ ((cmd-kiss frog-cmd-kiss))
+ (commands
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ (("kiss") ((direct-command cmd-kiss))))))
+
+(define* (frog-cmd-kiss actor message #:key direct-obj)
+ (define player (message-from message))
+ (define player-loc (mbody-val (<-wait player 'get-loc)))
+ (define player-name (mbody-val (<-wait player 'get-name)))
+ (<- (message-from message) 'tell
+ #:text '((p "You kiss the frog. She blushes and you get a distinctly "
+ "princess'y vibe off of her!")))
+ (<- player-loc 'tell-room
+ #:text `((p ,player-name " kisses the frog! The frog blushes!"))
+ #:exclude player))
+
+
+(define wedding
+ (lol
+ ;; Courtyard
+ ;; ---------
+ ('courtyard
+ <room> #f
+ #:name "The Courtyard"
+ #:desc
+ '((p "Standing in the courtyard you feel... different. As if the courtyard itself
+was the space between worlds, cobbled together hastily by some distant being.")
+ (p "To the south are some large doors which serve as the back entrance to
+the hotel. To the north is a forest, from which festive noises emerge."))
+ #:exits
+ (list (make <exit>
+ #:name "south"
+ #:to 'north-hall)
+ (make <exit>
+ #:name "north"
+ #:to 'forest-clearing)))
+ ('forest-clearing
+ <room> #f
+ #:name "A Clearing in the Forest"
+ #:desc
+ '((p "During an aimless ramble through the forest you became
+disoriented and lost your way. It has been some time since you’ve seen
+any of the familiar landmarks that would help you orient yourself. As
+you continue on, the feel of the forest seems to shift. As the trees
+grow thicker the light dims. Eerie laughter echoes through the boughs
+overhead and you shiver.")
+ (p "A warm light to the north beckons you towards it.
+South leads back to the Hotel's main grounds."))
+ #:exits
+ (list (make <exit>
+ #:name "north"
+ #:to 'wedding-entrance)
+ (make <exit>
+ #:name "south"
+ #:to 'courtyard)))
+ ('wedding-entrance
+ <room> #f
+ #:name "Entrance to the Wedding"
+ #:desc
+ '((p "As you approach you realize that the light is not an exit from the
+forest or a clearing, rather thousands of minuscule lights twined
+through the boughs of the trees. What you see before you is some sort
+of living structure composed of a thicket of trees intertwined with
+bramble. To the left of the entrance is a sign, to the right is a frog
+sitting atop a hostess podium.")
+ (p "To the north the limbs of two trees intertwine, making an entrance.
+To the south is the forest."))
+ #:exits
+ (list (make <exit>
+ #:name "south"
+ #:to 'forest-clearing)
+ (make <exit>
+ #:name "north"
+ #:to 'vaulted-tunnel)))
+
+ ;; map
+ ('wedding-entrance:map
+ <readable> 'wedding-entrance
+ #:name "wedding map"
+ #:desc '("This appears to be a map of the wedding grounds. "
+ "You could read it if you want to.")
+ #:read-text `(pre ,wedding-map-text)
+ #:goes-by '("map" "wedding map"))
+ ('wedding-entrance:frog
+ <frog> 'wedding-entrance
+ #:name "a frog"
+ #:desc "The frog is sitting on top of the hostess podium and doing
+her best to look dignified. Actually, to be honest, she's doing a pretty
+good job looking dignified. My gosh! What a dignified frog!"
+ #:goes-by '("frog")
+ #:catchphrases
+ '("Oh yes, oh yes! Welcome to the wedding! *Ribbit!*"
+ "Enjoy your stay!"
+ "Welcome, welcome! *Ribbit!*"
+ "*Ribbit!* We've been waiting for you, come in come in!"
+ "We're so happy you're here!"
+ "Hoo, this wedding took a lot of work to plan but it was WORTH IT!"
+ "A kiss? Well... I wouldn't object to it..."))
+ ('wedding-entrance:podium
+ <gameobj> 'wedding-entrance
+ #:name "a hostess podium"
+ #:desc "It's very well constructed. A frog is sitting on it, so you
+guess that makes the frog the hostess."
+ #:goes-by '("podium" "hostess podium"))
+ ('wedding-entrance:lights
+ <gameobj> 'wedding-entrance
+ #:name "fairy lights and trees"
+ #:invisible? #t
+ #:desc '((p "The lights are intertwined in the tree boughs and beautiful.
+You look closely and realize that the only way they could work is if they
+were threaded into the tree boughs as the trees grew!")
+ (p "To the north, some of the tree boughs grow together into
+an entrance."))
+ #:goes-by '("lights" "fairy lights"
+ "trees" "tree" "light" "fairy light"
+ "bough" "boughs"))
+ ('vaulted-tunnel
+ <room> #f
+ #:name "A Vaulted Tunnel of Trees"
+ #:desc
+ '((p "You step into the entrance to see two rows of trees with intersecting
+branches, forming a vaulted tunnel. The fairy lights cast a soft glow on the space.
+On each tree trunk is a portrait and the eerie laughter you heard outside echoes
+louder as you pass each portrait.")
+ (p "The tunnel enters from the south and exits from the north, with light
+glowing each way."))
+ #:exits
+ (list (make <exit>
+ #:name "south"
+ #:to 'wedding-entrance)
+ (make <exit>
+ #:name "north"
+ #:to 'dance-floor)))
+ ('vaulted-tunnel:portrait
+ <gameobj> 'vaulted-tunnel
+ #:name "hanging portraits"
+ #:desc
+ "Each portrait shows a hazy image of a fairy in various modes of dress from
+Victorian to today's current fashions. The style and format of the photographs
+all look the same."
+ #:goes-by
+ '("hanging portrait" "hanging portraits" "portrait" "portraits"))
+ ('vaulted-tunnel:trees
+ <gameobj> 'vaulted-tunnel
+ #:name "trees"
+ #:invisible? #t
+ #:desc
+ "The trees are arched above you, vaulted and beautiful. A gentle light
+streams through them and is accented by the fairy lights which are everywhere,
+lovely, and glowing themselves."
+ #:goes-by
+ '("trees" "fairy lights" "lights" "tree" "light" "vaulted trees"
+ "tunnel" "vaulted tunnel"))
+ ('dance-floor
+ <room> #f
+ #:name "The Ballroom Dance Flooor"
+ #:desc
+ '((p "You emerge into a clearing with six trees encircling a magical ballroom.
+At the center is a dance floor where fairies are dancing in rows of
+concentric circles. The lights that appear in unstructured smatterings
+throughout the mystical space have formed themselves into an elaborate
+chandelier above the dancers.")
+ (p "There are green tables and blue tables surrounding the dancers.
+Various creatures are sitting at them, sitting champagne, and laughing.")
+ (p "To the south the trees intertwine forming an entrance.
+The ballroom extends in every other cardinal direction."))
+ #:exits
+ (list (make <exit>
+ #:name "north"
+ #:to 'banquet)
+ (make <exit>
+ #:name "northeast"
+ #:to 'orchestra)
+ (make <exit>
+ #:name "east"
+ #:to 'cake-wing)
+ (make <exit>
+ #:name "southeast"
+ #:to 'flower-field)
+ (make <exit>
+ #:name "south"
+ #:to 'vaulted-tunnel)
+ (make <exit>
+ #:name "southwest"
+ #:to 'playground)
+ (make <exit>
+ #:name "west"
+ #:to 'photo-booth-wing)
+ (make <exit>
+ #:name "northwest"
+ #:to 'fairy-go-round)))
+ ('dance-floor:dancers
+ <dancers> 'dance-floor
+ #:name "some dancers"
+ #:desc
+ '((p "They dance at a frantic pace, moving too quickly to get any idea of how many of them there are what they look like.")
+ (p "You could dance with one of them, should you so dare.
+But remember what your parents warned you about dancing fairires..."))
+ #:chat-format (lambda _ "You try talking to the dancers. They
+laugh and tell you that you should join in the dance with them! Do you
+dare to do it? You've vaguely heard about people being lost in time...")
+ #:catchphrases
+ '("Dance with us! Dance!"
+ "You should be dancing!"
+ "There is nothing but the dance, the dance!")
+ #:goes-by
+ '("some dancers" "dancer" "dancers" "fairy" "fairies"))
+ ('dance-floor:green-table
+ <furniture> 'dance-floor
+ #:name "a green table"
+ #:desc "Each table is draped with layers of gossamer cloth in shades of green. The places are set with translucent china with cups the shape of tulips. The rose gold tableware is decorated with a delicate vine pattern snaking up the handles. In the center of the table is an elaborate arrangement of mauve roses and white lilies."
+ #:goes-by '("green table" "table")
+ #:sit-phrase "pull up a chair at"
+ #:sit-phrase-third-person "pulls up a chair at"
+ #:sit-name "a green table")
+ ('dance-floor:blue-table
+ <furniture> 'dance-floor
+ #:name "a blue table"
+ #:desc "Each table is draped with layers of gossamer cloth in shades of blue. The places are set with translucent china with cups the shape of lotus blossoms. The silver tableware is decorated with a delicate vine pattern snaking up the handles. In the center of the table is an elaborate arrangement of delphiniums and irises."
+ #:goes-by '("blue table")
+ #:sit-phrase "pull up a chair at"
+ #:sit-phrase-third-person "pulls up a chair at"
+ #:sit-name "a blue table")
+ ('dance-floor:chandelier
+ <gameobj> 'dance-floor
+ #:name "a chandelier"
+ #:desc
+ "The chandelier is beautiful with many lovely gems hanging from it.
+Light bounces through it and seems to dance through the room just as much
+as the fairies below it."
+ #:goes-by
+ '("chandelier"))
+ ('banquet
+ <room> #f
+ #:name "A Lovely Banquet"
+ #:desc
+ '((p "A large banquet table fills this space.
+Out of the corner of your eye you see a brownie tidying up the
+table while eating brownies.")
+ (p "An ornate set of stairs goes up and into the distance.
+The ballroom extends to the west, south, and east."))
+ #:exits
+ (list (make <exit>
+ #:name "south"
+ #:to 'dance-floor)
+ (make <exit>
+ #:name "west"
+ #:to 'fairy-go-round)
+ (make <exit>
+ #:name "east"
+ #:to 'orchestra)
+ (make <exit>
+ #:name "southeast"
+ #:to 'cake-wing)
+ (make <exit>
+ #:name "southwest"
+ #:to 'photo-booth-wing)
+ (make <exit>
+ #:name "up"
+ #:to 'the-stairs)))
+ ('banquet:brownie
+ <semi-edible-chatty-npc> 'banquet
+ #:chat-format (lambda _ "The brownie disappears when you try to
+talk to her! But she reappears once you stop talking.")
+ #:eat-catchphrase "The brownie shrieks with surprise as you try
+to eat her! She swats you away!"
+ #:name "a brownie"
+ #:desc "The brownie disappears out of sight when you try to
+look directly at her! However if you look just off to the side you
+can see her positively devouring that plate of brownies."
+ #:take-me? (lambda _
+ (values #f
+ #:why-not
+ `("The brownie swats your hand away when you try to take her!")))
+ #:goes-by '("brownie"))
+ ('banquet:brownies
+ <semi-edible-chatty-npc> 'banquet
+ #:chat-format (lambda _ "You try to chat with the brownies but
+they are inanimate! The brownie looks at you strangely from the corner
+of her eye. She's clearly judging you.")
+ #:eat-catchphrase "You reach forward to eat one of the brownies,
+but the brownie snarls at you and you think better of it. Best to leave them
+to her."
+ #:name "brownies"
+ #:desc "It's a plate of brownies. They look delicious and you desperately
+wish to eat one."
+ #:take-me? (lambda _
+ (values #f
+ #:why-not
+ `("The brownie swats your hand away when you try to take
+one of the brownies! She leans over the plate of brownies protectively!")))
+ #:goes-by '("brownies" "plate of brownies"))
+ ('banquet:stairs
+ <gameobj> 'banquet
+ #:name "the stairs"
+ #:invisible? #t
+ #:desc "From here it's clearly a nice set of stairs.
+But you get the impression that to really see the stairs, you
+should go upward and get a view from on the stairs themselves."
+ #:goes-by '("stairs" "stairwell" "stairwell entrance"))
+ ('banquet:banquet-table
+ <gameobj> 'banquet
+ #:name "a banquet table"
+ #:desc "The long rectangular table is draped with layers of gossamer
+cloth in shades of blue and green. It is laden with an assortment of
+exotic dishes in bowls and platters in the shapes of various flowers."
+ #:goes-by '("banquet table" "table"))
+ ('orchestra
+ <room> #f
+ #:name "The Orchestra"
+ #:desc
+ '((p "An orchestra of fairies plays the high-tempo ethereal music
+for the frenzied dancers. In the back is a harpsichord, accompanied
+by various fiddles, a cello, a harp, and a flute.")
+ (p "The ballroom extends to the west and south."))
+ #:exits
+ (list (make <exit>
+ #:name "west"
+ #:to 'banquet)
+ (make <exit>
+ #:name "southwest"
+ #:to 'dance-floor)
+ (make <exit>
+ #:name "south"
+ #:to 'cake-wing)))
+ ('orchestra:orchestra
+ <chatty-npc> 'orchestra
+ #:name "the orchestra"
+ #:chat-format (lambda _
+ '((p "You're being very rude. They're trying to
+concentrate.")))
+ #:desc
+ '((p "The orchestra members are playing their songs. The music
+and their instruments seem as much a part of them as their bodies."))
+ #:goes-by
+ '("orchestra" "fairies"))
+ ('orchestra:instruments
+ <chatty-npc> 'orchestra
+ #:name "instruments"
+ #:desc
+ '((p "Each instrument seems beautifully made, the best of its kind.
+But you sense that only the most skilled players could play them."))
+ #:take-me?
+ (lambda _
+ (values #f
+ #:why-not
+ `((p "No way. Are you kidding me? They're playing those
+instruments right now! Rude."))))
+ #:goes-by
+ '("instrument" "instruments"
+ "hapsichord" "hapsichords"
+ "harp" "harps"
+ "flute" "flutes"
+ "fiddle" "fiddles"
+ "cello" "cellos"))
+ ('cake-wing
+ <room> #f
+ #:name "The Cake Wing"
+ #:desc
+ '((p "A large tree stump sits in the middle of the space with a
+massive tiered cake atop it.")
+ (p "The ballroom extends to the north, west, and south."))
+ #:exits
+ (list (make <exit>
+ #:name "north"
+ #:to 'orchestra)
+ (make <exit>
+ #:name "west"
+ #:to 'dance-floor)
+ (make <exit>
+ #:name "northwest"
+ #:to 'banquet)
+ (make <exit>
+ #:name "south"
+ #:to 'flower-field)))
+ ;; TODO: You should be able to take a slice of cake
+ ('cake-wing:cake
+ <cake> 'cake-wing
+ #:name "the wedding cake"
+ #:chat-format (lambda _ '((p "Okay the wedding cake seems kinda
+alive, but it doesn't seem "
+ (i "that")
+ " alive.")))
+ #:desc "The lowest tier is a dark green with a fondant vine
+scrolling around it. The second tier is light blue with delphiniums
+painted onto it and mauve fondant roses lining the transition between
+the tiers. The third tier is sky blue, with clouds painted onto the
+frosting. The cake is topped with figurines of four fairies dancing
+in a circle."
+ #:eat-catchphrase "You think about just eating the cake right here
+and now, but it seems rude."
+ #:goes-by '("wedding cake" "cake" "tiered cake" "tiered wedding cake"))
+ ('cake-wing:stump
+ <gameobj> 'cake-wing
+ #:name "a tree stump"
+ #:invisible? #t
+ #:desc "The cake's sitting on the tree stump. Otherwise else there's
+not too much to say about this thing."
+ #:goes-by '("stump" "tree stump"))
+ ('flower-field
+ <room> #f
+ #:name "Field of Flowers"
+ #:desc
+ '((p "A field of wildflowers stretches out before you, far further
+than the confines of the space you saw from the outside. Groups of fairies
+are frolicking about.")
+ (p "The ballroom extends to the north."))
+ #:exits
+ (list (make <exit>
+ #:name "north"
+ #:to 'cake-wing)
+ (make <exit>
+ #:name "northwest"
+ #:to 'dance-floor)))
+ ('flower-field:fairies
+ <chatty-npc> 'flower-field
+ #:name "group of fairies"
+ #:chat-format (lambda _
+ '((p "You try chatting with these fairies but they seem
+kinda unresponsive. Wait, just what kinds of flowers are these?")))
+ #:desc "There really are just like, a ton of fairies around here aren't
+there? Anyway these ones are really into these flowers, like, *really* into
+them."
+ #:goes-by '("fairies" "some fairies" "group of fairies"))
+ ('flower-field:flowers
+ <flowers> 'flower-field
+ #:name "flowers"
+ #:desc "The flowers are beautiful... they're also fragrant..."
+ #:take-me?
+ (lambda _
+ (values #f
+ #:why-not
+ `((p "That's not a good idea. Just look at how much work went
+into this place. No way... the wedding planner would probably kill you.")
+ (p "I mean, not literally. Okay, maybe literally."))))
+ #:goes-by '("flowers" "flower"))
+ ('playground
+ <room> #f
+ #:name "Playground"
+ #:desc
+ '((p "You come across a playground that echoes with the sounds of children
+playing. Vines hang from the boughs above forming swings of varying
+heights and sizes. Young fairies climb up an obliging maple tree and
+use the helicopter seeds to float back to the ground. An enchanted
+see-saw hovers a foot from the soft grass below.")
+ (p "The ballroom extends to the north."))
+ #:exits
+ (list (make <exit>
+ #:name "north"
+ #:to 'photo-booth-wing)
+ (make <exit>
+ #:name "northeast"
+ #:to 'dance-floor)))
+ ('playground:swing
+ <swing> 'playground
+ #:name "a swing"
+ #:desc "There's an open swing here you could swing on. It sways
+back and forth gently. You feel as if to sit on it would help you
+feel younger again, to experience time itself..."
+ #:goes-by '("swing"))
+ ('playground:children
+ <chatty-npc> 'playground
+ #:name "children"
+ #:chat-format (lambda _
+ '((p "It's hard to have a conversation with the children,
+they're too busy running around! It's clear they're having a good time, though.")))
+ #:desc "The children are laughing and climbing and generally having a
+wonderful time."
+ #:goes-by '("young fairies" "children" "fairy children"))
+ ('playground:seeds
+ <gameobj> 'playground
+ #:name "helicopter seeds"
+ #:invisible? #t
+ #:desc "The helicopter seeds are falling from the sky!
+They're really lovely to look at though."
+ #:take-me?
+ (lambda _
+ (values #f
+ #:why-not
+ `((p "You feel like you'd develop an allergy to these things
+if you tried to hold onto them for too long, so you'd better not.")))
+ #:goes-by '("seeds" "helicopter seeds")))
+ ('photo-booth-wing
+ <room> #f
+ #:name "The Photo Booth Wing"
+ #:desc
+ '((p "There is a photographer with A Victorian bellows camera for guests to
+have their portrait taken. The trunks of the trees lining this section
+are covered in photographs of fairies and historical fairy
+‘hoaxes’.")
+ (p "The ballroom extends to the north, east, and south."))
+ #:exits
+ (list (make <exit>
+ #:name "north"
+ #:to 'fairy-go-round)
+ (make <exit>
+ #:name "northeast"
+ #:to 'banquet)
+ (make <exit>
+ #:name "east"
+ #:to 'dance-floor)
+ (make <exit>
+ #:name "south"
+ #:to 'playground)))
+ ('photo-booth-wing:camera
+ <gameobj> 'photo-booth-wing
+ #:name "an old-fashioned camera"
+ #:desc '((p "This old-fashioned camera has a lens that extends out with an accordion or bellows shaped enclosure. The flash bulb is held separately by the photographer."))
+ #:goes-by '("old-fashioned camera" "camera"))
+ ('photo-booth-wing:photographer
+ <chatty-npc> 'photo-booth-wing
+ #:name "a photographer"
+ #:desc "You suppose there's a person under the drapery of the
+camera somewhere, though all you can see are his legs."
+ #:goes-by '("photographer")
+ #:catchphrases
+ '("Alright, smile for me real big everyone!"
+ "It's real difficult to get fairies to sit still enough to take
+a clear photo of them. That's my specialty... and it's still tough, heh."
+ "Fairy photos just don’t work with modern cameras. You need these old
+bellows-cameras, or maybe an old brownie camera in order to really
+capture fairies!"))
+ ('photo-booth-wing:flash-bulb
+ <gameobj> 'photo-booth-wing
+ #:name "a flash bulb"
+ #:invisible? #t
+ #:desc "The flash bulb is large and appears to have a filament that's
+kind of unusual. It glows even when the camera isn't flashing. Every now
+and then the photographer takes a picture, a loud *kzzzt!* noise fills the room,
+and a magical glow suffuses everything."
+ #:goes-by '("flash bulb" "flash" "bulb"))
+ ('photo-booth-wing:hoaxes
+ <gameobj> 'photo-booth-wing
+ #:name "hoaxes"
+ #:invisible? #t
+ #:desc "Some real good japes, these are."
+ #:goes-by '("hoaxes"))
+ ('photo-booth-wing:photographs
+ <gameobj> 'photo-booth-wing
+ #:name "photographs"
+ #:invisible? #t
+ #:desc "You know, you kind of feel like you recognize the fairy in
+that one from some old Fairy History class you took a long time ago!"
+ #:goes-by '("photograph" "photographs"))
+ ('fairy-go-round
+ <room> #f
+ #:name "Fairy-Go-Round"
+ #:desc
+ '((p "A large carousel fills the space. The seating arrangement alternates
+between vine swings that move up and down and large mums that serve as
+stools.")
+ (p "The ballroom extends to the east and south."))
+ #:exits
+ (list (make <exit>
+ #:name "east"
+ #:to 'banquet)
+ (make <exit>
+ #:name "southeast"
+ #:to 'dance-floor)
+ (make <exit>
+ #:name "south"
+ #:to 'photo-booth-wing)))
+ ('fairy-go-round:fairy-go-round
+ <fairy-go-round> 'fairy-go-round
+ #:name "the fairy-go-round"
+ #:desc '((p "The fairy-go-round is a wonderful work of art. There
+are many kinds of seats on it, and they move up and down as the fairy go round
+spins. You feel a part of it and yet disconnected at once, a yearning to
+ride and participate on this fantastic device. You feel an aura around it
+that makes it seem both present and distant, as it were everywhere and nowhere
+at once.")
+ (p "The vine swings are made of real vines, and the mums are
+made of real... well you aren't really sure what they're made of. Overgrown
+flowers, it seems like."))
+ #:goes-by '("fairy-go-round" "fairy go round"
+ "carousel" "swing" "swings" "stool" "stools"
+ "seat" "seats" "vine swing" "vine swings"
+ "mum" "mums" "flowers" "overgrown flowers"))
+ ('the-stairs
+ <room> #f
+ #:name "Stairwell"
+ #:desc
+ '((p "A grand staircase springs from the ground, the twisting branches and
+vines woven into an ornate pattern up the balustrade. At the foot of
+the stairs is a fairy dreamily looking up at them.")
+ (p "The stairwell's entrance from the ballroom goes down. Looking
+up fills you with a sense of wonder as the stairs open into the canopy above."))
+ #:exits
+ (list (make <exit>
+ #:name "up"
+ #:to 'canopy)
+ (make <exit>
+ #:name "down"
+ #:to 'banquet)))
+ ('the-stairs:fairy
+ <chatty-npc> 'the-stairs
+ #:name "a serene young fairy"
+ #:desc "A serene, young fairy wearing a long gossamer dress.
+She stares upwards at the stairs, in true wonder."
+ #:goes-by '("serene young fairy" "serene fairy" "fairy" "young fairy")
+ #:catchphrases
+ '("The stairs, just look at those stairs!"
+ "I'd like to thank everyone who made this possible... and most
+importantly... I'd like to thank the stairs."
+ "What a beautiful mind... what a beautiful mind must have made
+these stairs."
+ "They go on, and upward, the stairs... they're so... beautiful..."))
+ ('the-stairs:stairs
+ <gameobj> 'the-stairs
+ #:name "the stairs"
+ #:desc "They're some beautiful stairs all right. Whoever made these
+must have been an incredible architect. Entrancing... maybe too entrancing.
+You fear that if you look at them too long, you might risk not being
+able to think of anything else."
+ #:goes-by '("stairs"))
+ ('canopy
+ <room> #f
+ #:name "The Canopy"
+ #:desc
+ '((p "The branches of the trees helpfully form into a relatively smooth and
+sturdy surface to walk around the perimeter of the ballroom from
+above. There are two exhausted looking cats in tophats lounging
+around."))
+ #:exits
+ (list (make <exit>
+ #:name "down"
+ #:to 'the-stairs)))
+ ('canopy:pair-of-cats
+ <chatty-npc> 'canopy
+ #:name "a pair of cats"
+ #:desc
+ '((p "These cats are very well dressed! They're both wearing top
+hats. They are somewhat gender ambiguous but one seems to lean more
+feminine and the other one leans more masculine. They look delighted
+from the festivities but also exhausted, as if the party was for them,
+but also as if they planned the whole thing, or whether they're just
+representationally appearing to fill such roles."))
+ #:catchphrases
+ '("Oh yes... hello! This was a fun time."
+ "It's nice to get away and be here at the same time."
+ "Later maybe we'll have a nice vacation."
+ "Twice is twice as nice, right?")
+ #:goes-by '("cat" "cats" "pair of cats"))
+
+;; ('ballroom
+;; <room> #f
+;; #:name "The Ballroom"
+;; #:exits (list
+;; (make <exit>
+;; )
+;; [north entrance]
+;; [east entrance]
+
+;; [south vaulted-tunnel]
+;; [west entrance])
+;; #:desc ("You emerge into a clearing with six trees encircling a magical ballroom. At the center is a dance floor where " (cast dancers "fairies") " are dancing in rows of concentric circles. The lights that appear in unstructured smatterings throughout the mystical space have formed themselves into an elaborate chandelier above the dancers."))
+
+ ))
+
\f
;;; Game
(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
+ north-hall wedding))
;; TODO: Provide command line args
(define (run-game . args)
projects / mudsync.git / blobdiff