;;; 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.
;;;
;; 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
#: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
(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")
#:to 'hive-entrance)
(make <exit>
#:name "east"
- #:to 'federation-station)))
-
+ #:to 'federation-station)
+ (make <exit>
+ #:name "south"
+ #:traverse-check
+ (lambda (exit room whos-exiting)
+ (values #f '("Ooh, if only you could go south and check this out! "
+ "Unfortunately this whole area is sealed off... the proprietor "
+ "probably never got around to fixing it. "
+ "Too bad, it would have had monsters to fight and everything!"))))
+ (make <exit>
+ #:name "southwest"
+ #:traverse-check
+ (lambda (exit room whos-exiting)
+ (values #f '("Hm, it's one of those revolving doors that only revolves in "
+ "one direction, and it isn't this one. You guess that while "
+ "this doesn't appear to be an entrance, it probably is an exit."))))))
;; map
('underground-lab:map
<readable> 'underground-lab
('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))))
"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 "
+ "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 "
('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)))))
"ActivityPub")
" is a federation standard being developed under the "
(a "https://www.w3.org/wiki/Socialwg/"
- "w3C Social Working Group")
+ "W3C Social Working Group")
", and doubles as a general client-to-server API. "
"It follows a few simple core ideas:")
(ul (li "Uses "
))
+
+\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 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"))
+ ('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"))
+ ('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 "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)))
+ ('banquet
+ <room> #f
+ #:name "A Lovely Banquet"
+ #:desc
+ ;; TODO: The brownie disappears when you look directly at it.
+ '((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)))
+ ('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
+ <gameobj> 'cake-wing
+ #:name "the wedding cake"
+ #: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."
+ #:goes-by '("wedding cake" "cake"))
+ ('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, west, and south."))
+ #:exits
+ (list (make <exit>
+ #:name "north"
+ #:to 'cake-wing)
+ (make <exit>
+ #:name "northwest"
+ #:to 'dance-floor)))
+ ('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)))
+ ('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"))
+ ('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)))
+ ('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 'wedding-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 stairs 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"
+ #:invisible? #t
+ #: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)))
+
+;; ('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
;;; ----
(append lobby grand-hallway smoking-parlor
playroom break-room computer-room underground-lab
async-museum gift-shop hive-entrance
- hive-inside federation-station))
+ hive-inside federation-station
+ north-hall wedding))
;; TODO: Provide command line args
(define (run-game . args)