X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=dfd62ebc21ae899ec2e9306ea23993b23c9e8798;hb=0b3115cf3ccd89fbfa65c661b4ac7032b3063ebd;hp=db6d8f30835c987fe3af574132f543cc9c558e42;hpb=4d1280ec16d7645817bf741cde658e358de66327;p=mudsync.git diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index db6d8f3..dfd62eb 100644 --- a/worlds/bricabrac.scm +++ b/worlds/bricabrac.scm @@ -1,5 +1,5 @@ ;;; Mudsync --- Live hackable MUD -;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2016, 2017 Christine Lemmer-Webber ;;; ;;; This file is part of Mudsync. ;;; @@ -19,10 +19,13 @@ ;;; Hotel Bricabrac (use-modules (mudsync) - (8sync systems actors) - (8sync agenda) + (mudsync container) + (8sync) (oop goops) - (ice-9 format)) + (ice-9 control) + (ice-9 format) + (ice-9 match) + (rx irregex)) @@ -42,46 +45,67 @@ ;;; Some simple object types. ;;; ========================= -(define readable-commands - (list - (direct-command "read" 'cmd-read))) -(define readable-actions - (build-actions - (cmd-read (wrap-apply readable-cmd-read)))) - (define-class () (read-text #:init-value "All it says is: \"Blah blah blah.\"" #:init-keyword #:read-text) (commands - #:init-value readable-commands) - (message-handler - #:init-value - (simple-dispatcher (append gameobj-actions readable-actions)))) + #:allocation #:each-subclass + #:init-thunk (build-commands + ("read" ((direct-command cmd-read))))) + (actions #:allocation #:each-subclass + #:init-thunk (build-actions + (cmd-read readable-cmd-read)))) + +(define (readable-cmd-read actor message . _) + (<- (message-from message) 'tell + #:text (slot-ref actor 'read-text))) + + +;; This one is just where reading is the same thing as looking +;; at the description +(define-class () + (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 () + ((cmd-take-from take-from-proxy)) + (proxy-items #:init-keyword #:proxy-items)) -(define (readable-cmd-read actor message) - (<- actor (message-from message) 'tell - #:text (string-append (slot-ref actor 'read-text) "\n"))) +(define* (take-from-proxy gameobj message + #:key direct-obj indir-obj preposition + (player (message-from message))) + (call/ec + (lambda (escape) + (for-each + (lambda (obj-sym) + (define obj-id (dyn-ref gameobj obj-sym)) + (define goes-by + (mbody-val (<-wait obj-id 'goes-by))) + (when (ci-member direct-obj goes-by) + (<- obj-id 'cmd-take #:direct-obj direct-obj #:player player) + (escape #f))) + (slot-ref gameobj 'proxy-items)) + + (<- player 'tell + #:text `("You don't see any such " ,direct-obj " to take " + ,preposition " " ,(slot-ref gameobj 'name) "."))))) ;;; Lobby ;;; ----- -(define-mhandler (npc-chat-randomly actor message) +(define (npc-chat-randomly actor message . _) + (define catchphrase + (random-choice (slot-ref actor 'catchphrases))) (define text-to-send - (format #f "~a says: \"~a\"\n" - (slot-ref actor 'name) - (random-choice (slot-ref actor 'catchphrases)))) - (<- actor (message-from message) 'tell + ((slot-ref actor 'chat-format) actor catchphrase)) + (<- (message-from message) 'tell #:text text-to-send)) -(define chat-commands - (list - (direct-command "chat" 'cmd-chat))) -(define chat-actions - (build-actions - (cmd-chat (wrap-apply npc-chat-randomly)))) - (define hotel-owner-grumps '("Eight sinks! Eight sinks! And I couldn't unwind them..." "Don't mind the mess. I built this place on a dare, you @@ -101,59 +125,153 @@ or 'skribe'? Now *that's* composition!")) (define-class () (catchphrases #:init-value '("Blarga blarga blarga!") #:init-keyword #:catchphrases) + (chat-format #:init-value (lambda (npc catchphrase) + `(,(slot-ref npc 'name) " says: \"" + ,catchphrase "\"")) + #:init-keyword #:chat-format) (commands - #:init-value chat-commands) - (message-handler - #:init-value - (simple-dispatcher (append gameobj-actions chat-actions)))) - -(define random-bricabrac - '("a creepy porcelain doll" - "assorted 1950s robots" - "an exquisite tea set" - "an antique mustard pot" - "the pickled head of Elvis" - "the pickled circuitboard of EVLIS" - "a scroll of teletype paper holding the software Four Freedoms" - "a telephone shaped like an orange cartoon cat")) + #:allocation #:each-subclass + #:init-thunk (build-commands + (("chat" "talk") ((direct-command cmd-chat))))) + (actions #:allocation #:each-subclass + #:init-thunk + (build-actions + (cmd-chat npc-chat-randomly)))) + +(define-class () + (commands + #:allocation #:each-subclass + #:init-thunk (build-commands + ("sign" ((prep-direct-command cmd-sign-form '("as")))))) + + (actions #:allocation #:each-subclass + #:init-thunk (build-actions + (cmd-sign-form sign-cmd-sign-in)))) + + +(define name-sre + (sre->irregex '(: alpha (** 1 14 (or alphanum "-" "_"))))) + +(define forbidden-words + (append article preposition + '("and" "or" "but" "admin"))) + +(define (valid-name? name) + (and (irregex-match name-sre name) + (not (member name forbidden-words)))) + +(define* (sign-cmd-sign-in actor message + #:key direct-obj indir-obj preposition) + (define old-name + (mbody-val (<-wait (message-from message) 'get-name))) + (define name indir-obj) + (if (valid-name? indir-obj) + (begin + (<-wait (message-from message) 'set-name! name) + (<- (slot-ref actor 'loc) 'tell-room + #:text (format #f "~a signs the form!\n~a is now known as ~a\n" + old-name old-name name))) + (<- (message-from message) 'tell + #:text "Sorry, that's not a valid name. +Alphanumerics, _ and - only, 2-15 characters, starts with an alphabetic +character.\n"))) + + +(define-class () + (summons #:init-keyword #:summons) + + (commands + #:allocation #:each-subclass + #:init-thunk (build-commands + ("ring" ((direct-command cmd-ring))))) + (actions #:allocation #:each-subclass + #:init-thunk (build-actions + (cmd-ring summoning-bell-cmd-ring)))) + +(define* (summoning-bell-cmd-ring bell message . _) + ;; Call back to actor who invoked this message handler + ;; and find out their name. We'll call *their* get-name message + ;; handler... meanwhile, this procedure suspends until we get + ;; their response. + (define who-rang + (mbody-val (<-wait (message-from message) 'get-name))) + + ;; Now we'll invoke the "tell" message handler on the player + ;; who rang us, displaying this text on their screen. + ;; This one just uses <- instead of <-wait, since we don't + ;; care when it's delivered; we're not following up on it. + (<- (message-from message) 'tell + #:text "*ring ring!* You ring the bell!\n") + ;; We also want everyone else in the room to "hear" the bell, + ;; but they get a different message since they aren't the ones + ;; ringing it. Notice here's where we make use of the invoker's + ;; name as extracted and assigned to the who-rang variable. + ;; Notice how we send this message to our "location", which + ;; forwards it to the rest of the occupants in the room. + (<- (gameobj-loc bell) 'tell-room + #:text + (format #f "*ring ring!* ~a rings the bell!\n" + who-rang) + #:exclude (message-from message)) + ;; Now we perform the primary task of the bell, which is to summon + ;; the "clerk" character to the room. (This is configurable, + ;; so we dynamically look up their address.) + (<- (dyn-ref bell (slot-ref bell 'summons)) 'be-summoned + #:who-summoned (message-from message))) + + +(define prefect-quotes + '("I'm a frood who really knows where my towel is!" + "On no account allow a Vogon to read poetry at you." + "Time is an illusion, lunchtime doubly so!" + "How can you have money if none of you produces anything?" + "On no account allow Arthur to request tea on this ship.")) + +(define-class () + (take-me? #:init-value + (lambda _ + (values #f #:why-not + `("Hm, well... the cabinet is locked and the properitor " + "is right over there."))))) (define lobby (lol - ('room:lobby + ('lobby #f #:name "Hotel Lobby" #:desc - " You're in some sort of hotel lobby. You see a large sign hanging -over the desk that says \"Hotel Bricabrac\". On the desk is a bell -that says \"ring for service\". Terrible music plays from a speaker -somewhere overhead. - The room is lined with various curio cabinets, filled with all sorts -of kitschy junk. It looks like whoever decorated this place had great -ambitions, but actually assembled it all in a hurry and used whatever -kind of objects they found lying around.") + '((p "You're in some sort of hotel lobby. You see a large sign hanging " + "over the desk that says \"Hotel Bricabrac\". On the desk is a bell " + "that says \"'ring bell' for service\". Terrible music plays from a speaker " + "somewhere overhead. " + "The room is lined with various curio cabinets, filled with all sorts " + "of kitschy junk. It looks like whoever decorated this place had great " + "ambitions, but actually assembled it all in a hurry and used whatever " + "kind of objects they found lying around.") + (p "There's a door to the north leading to some kind of hallway.")) + #:exits + (list (make + #:name "north" + #:to 'grand-hallway))) ;; NPC: hotel owner - ('npc:hotel-owner - 'room:lobby - #:name "a frumpy fellow" - #:desc " Whoever this is, they looks totally exhausted. They're + ('lobby:hotel-owner + 'lobby + #:name "a languid lady" + #:desc + '((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? + 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) - ;; NPC: desk clerk (comes when you ring the s) - ;; impatient teenager, only stays around for a few minutes - ;; complaining, then leaves. - ;; Object: Sign - ('thing:lobby-sign - 'room:lobby + ('lobby:sign + 'lobby #:name "the Hotel Bricabrac sign" #:desc " It strikes you that there's something funny going on with this sign. Sure enough, if you look at it hard enough, you can tell that someone @@ -166,30 +284,761 @@ Classy!" "hotel bricabrac sign" "lobby sign")) + ('lobby:bell + 'lobby + #:name "a shiny brass bell" + #:goes-by '("shiny brass bell" "shiny bell" "brass bell" "bell") + #:desc " A shiny brass bell. Inscribed on its wooden base is the text +\"ring me for service\". You probably could \"ring the bell\" if you +wanted to." + #:summons 'break-room:desk-clerk) + + ('lobby:sign-in-form + 'lobby + #:name "sign-in form" + #:goes-by '("sign-in form" "form" "signin form") + #:desc '("It looks like you could sign this form and set your name like so: " + (i "sign form as "))) + ;; Object: curio cabinets - ('thing:cabinet - 'room:lobby + ;; TODO: respond to attempts to open the curio cabinet + ('lobby:cabinet + 'lobby + #:proxy-items '(lobby:porcelain-doll + lobby:1950s-robots + lobby:tea-set lobby:mustard-pot + lobby:head-of-elvis lobby:circuitboard-of-evlis + lobby:teletype-scroll lobby:orange-cat-phone) #:name "a curio cabinet" - #:goes-by '("curio cabinet" "cabinet" "bricabrac cabinet") + #:goes-by '("curio cabinet" "cabinet" "bricabrac cabinet" + "cabinet of curiosities") #:desc (lambda _ (format #f " The curio cabinet is full of all sorts of oddities! Something catches your eye! -Ooh, ~a!" (random-choice random-bricabrac)))) +Ooh, ~a!" (random-choice + '("a creepy porcelain doll" + "assorted 1950s robots" + "an exquisite tea set" + "an antique mustard pot" + "the pickled head of Elvis" + "the pickled circuitboard of EVLIS" + "a scroll of teletype paper holding the software Four Freedoms" + "a telephone shaped like an orange cartoon cat"))))) + + ('lobby:porcelain-doll + 'lobby + #:invisible? #t + #:name "a creepy porcelain doll" + #:desc "It strikes you that while the doll is technically well crafted, +it's also the stuff of nightmares." + #:goes-by '("porcelain doll" "doll")) + ('lobby:1950s-robots + 'lobby + #:invisible? #t + #:name "a set of 1950s robots" + #:desc "There's a whole set of these 1950s style robots. +They seem to be stamped out of tin, and have various decorations of levers +and buttons and springs. Some of them have wind-up knobs on them." + #:goes-by '("robot" "robots" "1950s robot" "1950s robots")) + ('lobby:tea-set + 'lobby + #:invisible? #t + #:name "a tea set" + #:desc "A complete tea set. Some of the cups are chipped. +You can imagine yourself joining a tea party using this set, around a +nice table with some doilies, drinking some Earl Grey tea, hot. Mmmm." + #:goes-by '("tea set" "tea")) + ('lobby:cups + 'lobby + #:invisible? #t + #:name "cups from the tea set" + #:desc "They're chipped." + #:goes-by '("cups")) + ('lobby:mustard-pot + 'lobby + #:invisible? #t + #:name "a mustard pot" + #:desc '((p "It's a mustard pot. I mean, it's kind of cool, it has a +nice design, and it's an antique, but you can't imagine putting something +like this in a museum.") + (p "Ha... imagine that... a mustard museum.")) + #:goes-by '("mustard pot" "antique mustard pot" "mustard")) + ('lobby:head-of-elvis + 'lobby + #:invisible? #t + #:name "the pickled head of Elvis" + #:desc '((p "It's a jar full of some briny-looking liquid and... +a free floating head. The head looks an awful lot like Elvis, and +definitely not the younger Elvis. The hair even somehow maintains +that signature swoop while suspended in liquid. But of course it's +not Elvis.") + (p "Oh, wait, it has a label at the bottom which says: +\"This is really the head of Elvis\". Well... maybe don't believe +everything you read.")) + #:goes-by '("pickled head of elvis" "pickled head of Elvis" + "elvis" "Elvis" "head" "pickled head")) + ('lobby:circuitboard-of-evlis + 'lobby + #:invisible? #t + #:name "the pickled circuitboard of Evlis" + #:desc '((p "It's a circuitboard from a Lisp Machine called EVLIS. +This is quite the find, and you bet just about anyone interested in +preserving computer history would love to get their hands on this.") + (p "Unfortunately, whatever moron did acquire this has +no idea what it means to preserve computers, so here it is floating +in some kind of briny liquid. It appears to be heavily corroded. +Too bad...")) + #:goes-by '("pickled circuitboard of evlis" "pickled circuitboard of Evlis" + "pickled circuitboard of EVLIS" + "evlis" "Evlis" "EVLIS" "circuitboard" "pickled circuitboard")) + ('lobby:teletype-scroll + 'lobby + #:invisible? #t + #:name "a scroll of teletype" + #:desc '((p "This is a scroll of teletype paper. It's a bit old +and yellowed but the type is very legible. It says:") + (br) + (i + (p (strong "== The four essential freedoms ==")) + (p "A program is free software if the program's users have +the four essential freedoms: ") + (ul (li "The freedom to run the program as you wish, for any purpose (freedom 0).") + (li "The freedom to study how the program works, and change it so it does your computing as you wish (freedom 1). Access to the source code is a precondition for this.") + (li "The freedom to redistribute copies so you can help your neighbor (freedom 2).") + (li "The freedom to distribute copies of your modified versions to others (freedom 3). By doing this you can give the whole community a chance to benefit from your changes. Access to the source code is a precondition for this."))) + (p "You get this feeling that ambiguities in the +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" + "scroll of teletype paper holding the software Four Freedoms" + "scroll of teletype paper holding the software four freedoms")) + ('lobby:orange-cat-phone + 'lobby + #:invisible? #t + #:name "a telephone shaped like an orange cartoon cat" + #:desc "It's made out of a cheap plastic, and it's very orange. +It resembles a striped tabby, and it's eyes hold the emotion of +a being both sleepy and smarmy. +You suspect that someone, somewhere made a ton of cash on items holding +this general shape in the 1990s." + #: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")) + ('lobby:monster-stuffie + '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")))) + + + +;;; Grand hallway +;;; ------------- + +(define-actor () + ((cmd-take disc-shield-take))) + +(define* (disc-shield-take gameobj message + #:key direct-obj + (player (message-from message))) + (create-gameobj (gameobj-gm gameobj) + player) ;; set loc to player to put in player's inventory + (<- player 'tell + #:text '((p "As you attempt to pull the shield / disk platter +from the statue a shining outline appears around it... and a +completely separate, glowing copy of the disc materializes into your +hands!"))) + (<- (gameobj-loc gameobj) 'tell-room + #:text `(,(mbody-val (<-wait player 'get-name)) + " pulls on the shield of the statue, and a glowing " + "copy of it materializes into their hands!") + #:exclude player) + (<- (gameobj-loc gameobj) 'tell-room + #:text + '(p "You hear a voice whisper: " + (i "\"Share the software... and you'll be free...\"")))) - ;; Object: desk - ;; - Object: bell - ;; - Object: sign in form - ;; - Object: pamphlet - ;; Object: : reprimands that you want to ring the - ;; bell on the desk - ) - ) +;;; This is the disc that gets put in the player's inventory +(define-actor () + ((cmd-drop glowing-disc-drop-cmd)) + (initial-props + #:allocation #:each-subclass + #:init-thunk (build-props + '((hd-platter? . #t)))) + (name #:allocation #:each-subclass + #:init-value "a glowing disc") + (desc #:allocation #:each-subclass + #:init-value "A brightly glowing disc. It's shaped like a hard +drive platter, not unlike the one from the statue it came from. It's +labeled \"RL02.5\".") + (goes-by #:init-value '("glowing disc" "glowing platter" + "glowing disc platter" "glowing disk platter" + "platter" "disc" "disk" "glowing shield"))) +(define* (glowing-disc-drop-cmd gameobj message + #:key direct-obj + (player (message-from message))) + (<- player 'tell + #:text "You drop the glowing disc, and it shatters into a million pieces!") + (<- (mbody-val (<-wait player 'get-loc)) 'tell-room + #:text `(,(mbody-val (<-wait player 'get-name)) + " drops a glowing disc, and it shatters into a million pieces!") + #:exclude player) + (gameobj-self-destruct gameobj)) + + +;;; Grand hallway + +(define lobby-map-text + "\ + + .----+++++----. + | : : | + + : north : + + | : hall : | + + : : + + |_ : _____ : _| + | : : | + .----------.----------. : & : .----------.----------. + | computer | |& :YOU ARE: &| smoking | *UNDER* | + | room + playroom + : HERE : + parlor | *CONS- | + | > | |& : : &| | TRUCTION*| + '----------'----------'-++-------++-'-------+--'----------' + | '-----' | | | + : LOBBY : '---' + '. .' + '---------'") + +(define grand-hallway + + (lol + ('grand-hallway + #f + #:name "Grand Hallway" + #:desc '((p " A majestic red carpet runs down the center of the room. +Busts of serious looking people line the walls, but there's no +clear indication that they have any logical relation to this place.") + (p "In the center is a large statue of a woman in a warrior's +pose, but something is strange about her weapon and shield. You wonder what +that's all about?") + (p "To the south is the lobby. A door to the east is labeled \"smoking +room\", while a door to the west is labeled \"playroom\".")) + #:exits + (list (make + #:name "north" + #:to 'north-hall) + (make + #:name "south" + #:to 'lobby) + (make + #:name "west" + #:to 'playroom) + (make + #:name "east" + #:to 'smoking-parlor))) + ('grand-hallway:map + 'grand-hallway + #:name "the hotel map" + #:desc '("This appears to be a map of the hotel. " + "Like the hotel itself, it seems to be " + "incomplete." + "You could read it if you want to.") + #:read-text `(pre ,lobby-map-text) + #:goes-by '("map" "hotel map")) + ('grand-hallway:carpet + 'grand-hallway + #:name "the Grand Hallway carpet" + #:desc "It's very red, except in the places where it's very worn." + #:invisible? #t + #:goes-by '("red carpet" "carpet")) + ('grand-hallway:busts + 'grand-hallway + #:name "the busts of serious people" + #:desc "There are about 6 of them in total. They look distinguished +but there's no indication of who they are." + #:invisible? #t + #:goes-by '("busts" "bust" "busts of serious people" "bust of serious person")) + ('grand-hallway:hackthena-statue + 'grand-hallway + #:name "the statue of Hackthena" + #:desc '((p "The base of the statue says \"Hackthena, guardian of the hacker +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 +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. +You'd better take a closer look to be sure.")) + #:goes-by '("hackthena statue" "hackthena" "statue" "statue of hackthena") + #:proxy-items '(grand-hallway:keyboard + grand-hallway:disc-platter + grand-hallway:hackthena-horns)) + ('grand-hallway:keyboard + 'grand-hallway + #:name "a Knight Keyboard" + #:desc "Whoa, this isn't just any old keyboard, this is a Knight Keyboard! +Any space cadet can see that with that kind of layout a hack-and-slayer could +thrash out some serious key-chords like there's no tomorrow. You guess +Hackthena must be an emacs user." + #:invisible? #t + #:take-me? (lambda _ + (values #f + #:why-not + `("Are you kidding? Do you know how hard it is to find " + "a Knight Keyboard? There's no way she's going " + "to give that up."))) + #:goes-by '("knight keyboard" "keyboard")) + ('grand-hallway:hackthena-horns + 'grand-hallway + #:name "Hackthena's horns" + #:desc "They're not unlike a Gnu's horns." + #:invisible? #t + #:take-me? (lambda _ + (values #f + #:why-not + `("Are you seriously considering desecrating a statue?"))) + #:goes-by '("hackthena's horns" "horns" "horns of hacktena")) + ('grand-hallway:disc-platter + 'grand-hallway + #:name "Hackthena's shield" + #:desc "No wonder the \"shield\" looks unusual... it seems to be a hard disk +platter! It has \"RL02.5\" written on it. It looks kind of loose." + #:invisible? #t + #:goes-by '("hackthena's shield" "shield" "platter" "hard disk platter")))) ;;; Playroom ;;; -------- +(define-actor () + ((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 () + ((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 () + ((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 (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 () + ((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 () + ((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 () + ((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 + #f + #:name "The Playroom" + #:desc '(p (" There are toys scattered everywhere here. It's really unclear +if this room is intended for children or child-like adults.") + (" There are doors to both the east and the west.")) + #:exits + (list (make + #:name "east" + #:to 'grand-hallway) + (make + #:name "west" + #:to 'computer-room))) + ('playroom:cubey + 'playroom + #:name "Cubey" + #:take-me? #t + #:desc " It's a little foam cube with googly eyes on it. So cute!") + ('playroom:cuddles-plushie + 'playroom + #:name "a Cuddles plushie" + #:goes-by '("plushie" "cuddles plushie" "cuddles") + #:take-me? #t + #:desc " A warm and fuzzy cuddles plushie! It's a cuddlefish!") + + ('playroom:toy-chest + 'playroom + #:name "a toy chest" + #:goes-by '("toy chest" "chest") + #:desc (lambda (toy-chest whos-looking) + (let ((contents (gameobj-occupants toy-chest))) + `((p "A brightly painted wooden chest. The word \"TOYS\" is " + "engraved on it.") + (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)))))))) + #:take-from-me? #t + #:put-in-me? #t) + + ;; Things inside the toy chest + ('playroom:toy-chest:rubber-duck + 'playroom:toy-chest + #:name "a rubber duck" + #:goes-by '("rubber duck" "duck") + #:take-me? #t + #:desc "It's a yellow rubber duck with a bright orange beak.") + + ('playroom:toy-chest: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 + '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 + '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 + '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 + '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 + '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 + '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 + '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 + '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 + '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 + 'playroom + #:name "the kettle" + #:goes-by '("kettle") + #:reset-msg '("The kettle is emptied.")))) + + ;;; Writing room ;;; ------------ @@ -204,6 +1053,368 @@ Ooh, ~a!" (random-choice random-bricabrac)))) ;;; Smoking parlor ;;; -------------- +(define-class () + (sit-phrase #:init-keyword #:sit-phrase) + (sit-phrase-third-person #:init-keyword #:sit-phrase-third-person) + (sit-name #:init-keyword #:sit-name) + + (commands + #:allocation #:each-subclass + #:init-thunk (build-commands + ("sit" ((direct-command cmd-sit-furniture))))) + (actions #:allocation #:each-subclass + #:init-thunk (build-actions + (cmd-sit-furniture furniture-cmd-sit)))) + +(define* (furniture-cmd-sit actor message #:key direct-obj) + (define player-name + (mbody-val (<-wait (message-from message) 'get-name))) + (<- (message-from message) 'tell + #:text (format #f "You ~a ~a.\n" + (slot-ref actor 'sit-phrase) + (slot-ref actor 'sit-name))) + (<- (slot-ref actor 'loc) 'tell-room + #:text (format #f "~a ~a on ~a.\n" + player-name + (slot-ref actor 'sit-phrase-third-person) + (slot-ref actor 'sit-name)) + #:exclude (message-from message))) + + +(define smoking-parlor + (lol + ('smoking-parlor + #f + #:name "Smoking Parlor" + #:desc + '((p "This room looks quite posh. There are huge comfy seats you can sit in +if you like. Strangely, you see a large sign saying \"No Smoking\". The owners must +have installed this place and then changed their mind later.") + (p "There's a door to the west leading back to the grand hallway, and +a nondescript steel door to the south, leading apparently outside.")) + #:exits + (list (make + #:name "west" + #:to 'grand-hallway) + (make + #:name "south" + #:to 'break-room))) + ('smoking-parlor:chair + 'smoking-parlor + #:name "a comfy leather chair" + #:desc " That leather chair looks really comfy!" + #:goes-by '("leather chair" "comfy leather chair" "chair") + #:sit-phrase "sink into" + #:sit-phrase-third-person "sinks into" + #:sit-name "the comfy leather chair") + ('smoking-parlor:sofa + 'smoking-parlor + #:name "a plush leather sofa" + #:desc " That leather chair looks really comfy!" + #:goes-by '("leather sofa" "plush leather sofa" "sofa" + "leather couch" "plush leather couch" "couch") + #:sit-phrase "sprawl out on" + #:sit-phrase-third-person "sprawls out on into" + #:sit-name "the plush leather couch") + ('smoking-parlor:bar-stool + 'smoking-parlor + #:name "a bar stool" + #:desc " Conveniently located near the bar! Not the most comfortable +seat in the room, though." + #:goes-by '("stool" "bar stool" "seat") + #:sit-phrase "hop on" + #:sit-phrase-third-person "hops onto" + #:sit-name "the bar stool") + ('ford-prefect + 'smoking-parlor + #:name "Ford Prefect" + #:desc "Just some guy, you know?" + #:goes-by '("Ford Prefect" "ford prefect" + "frood" "prefect" "ford") + #:catchphrases prefect-quotes) + + ('smoking-parlor:no-smoking-sign + 'smoking-parlor + #:invisible? #t + #:name "No Smoking Sign" + #:desc "This sign says \"No Smoking\" in big, red letters. +It has some bits of bubble gum stuck to it... yuck." + #:goes-by '("no smoking sign" "sign") + #:read-text "It says \"No Smoking\", just like you'd expect from +a No Smoking sign.") + ;; TODO: Cigar dispenser + )) + + + +;;; Breakroom +;;; --------- + +(define-class () + ;; The desk clerk has three states: + ;; - on-duty: Arrived, and waiting for instructions (and losing patience + ;; gradually) + ;; - slacking: In the break room, probably smoking a cigarette + ;; or checking text messages + (state #:init-value 'slacking) + (commands #:allocation #:each-subclass + #:init-thunk + (build-commands + (("talk" "chat") ((direct-command cmd-chat))) + ("ask" ((direct-command cmd-ask-incomplete) + (prep-direct-command cmd-ask-about))) + ("dismiss" ((direct-command cmd-dismiss))))) + (patience #:init-value 0) + (actions #:allocation #:each-subclass + #:init-thunk (build-actions + (init clerk-act-init) + (cmd-chat clerk-cmd-chat) + (cmd-ask-incomplete clerk-cmd-ask-incomplete) + (cmd-ask-about clerk-cmd-ask) + (cmd-dismiss clerk-cmd-dismiss) + (update-loop clerk-act-update-loop) + (be-summoned clerk-act-be-summoned)))) + +(define (clerk-act-init clerk message . _) + ;; call the gameobj main init method + (gameobj-act-init clerk message) + ;; start our main loop + (<- (actor-id clerk) 'update-loop)) + +(define changing-name-text "Changing your name is easy! +We have a clipboard here at the desk +where you can make yourself known to other participants in the hotel +if you sign it. Try 'sign form as ', replacing +, obviously!") + +(define phd-text + "Ah... when I'm not here, I've got a PHD to finish.") + +(define clerk-help-topics + `(("changing name" . ,changing-name-text) + ("sign-in form" . ,changing-name-text) + ("form" . ,changing-name-text) + ("common commands" . + "Here are some useful commands you might like to try: chat, +go, take, drop, say...") + ("hotel" . + "We hope you enjoy your stay at Hotel Bricabrac. As you may see, +our hotel emphasizes interesting experiences over rest and lodging. +The origins of the hotel are... unclear... and it has recently come +under new... 'management'. But at Hotel Bricabrac we believe these +aspects make the hotel into a fun and unique experience! Please, +feel free to walk around and explore.") + ("physics paper" . ,phd-text) + ("paper" . ,phd-text) + ("proprietor" . "Oh, he's that frumpy looking fellow sitting over there."))) + + +(define clerk-knows-about + "'ask clerk about changing name', 'ask clerk about common commands', and 'ask clerk about the hotel'") + +(define clerk-general-helpful-line + (string-append + "The clerk says, \"If you need help with anything, feel free to ask me about it. +For example, 'ask clerk about changing name'. You can ask me about the following: +" clerk-knows-about ".\"\n")) + +(define clerk-slacking-complaints + '("The pay here is absolutely lousy." + "The owner here has no idea what they're doing." + "Some times you just gotta step away, you know?" + "You as exhausted as I am?" + "Yeah well, this is just temporary. I'm studying to be a high +energy particle physicist. But ya gotta pay the bills, especially +with tuition at where it is...")) + +(define* (clerk-cmd-chat clerk message #:key direct-obj) + (match (slot-ref clerk 'state) + ('on-duty + (<- (message-from message) 'tell + #:text clerk-general-helpful-line)) + ('slacking + (<- (message-from message) 'tell + #:text + (string-append + "The clerk says, \"" + (random-choice clerk-slacking-complaints) + "\"\n"))))) + +(define (clerk-cmd-ask-incomplete clerk message . _) + (<- (message-from message) 'tell + #:text "The clerk says, \"Ask about what?\"\n")) + +(define clerk-doesnt-know-text + "The clerk apologizes and says she doesn't know about that topic.\n") + +(define* (clerk-cmd-ask clerk message #:key indir-obj + #:allow-other-keys) + (match (slot-ref clerk 'state) + ('on-duty + (match (assoc indir-obj clerk-help-topics) + ((_ . info) + (<- (message-from message) 'tell + #:text + (string-append "The clerk clears her throat and says:\n \"" + info + "\"\n"))) + (#f + (<- (message-from message) 'tell + #:text clerk-doesnt-know-text)))) + ('slacking + (<- (message-from message) 'tell + #:text "The clerk says, \"Sorry, I'm on my break.\"\n")))) + +(define* (clerk-act-be-summoned clerk message #:key who-summoned) + (match (slot-ref clerk 'state) + ('on-duty + (<- who-summoned 'tell + #:text + "The clerk tells you as politely as she can that she's already here, +so there's no need to ring the bell.\n")) + ('slacking + (<- (gameobj-loc clerk) 'tell-room + #:text + "The clerk's ears perk up, she stamps out a cigarette, and she +runs out of the room!\n") + (gameobj-set-loc! clerk (dyn-ref clerk 'lobby)) + (slot-set! clerk 'patience 8) + (slot-set! clerk 'state 'on-duty) + (<- (gameobj-loc clerk) 'tell-room + #:text + (string-append + " Suddenly, a uniformed woman rushes into the room! She's wearing a +badge that says \"Desk Clerk\". + \"Hello, yes,\" she says between breaths, \"welcome to Hotel Bricabrac! +We look forward to your stay. If you'd like help getting acclimated, +feel free to ask me. For example, 'ask clerk about changing name'. +You can ask me about the following: +" clerk-knows-about ".\"\n"))))) + +(define* (clerk-cmd-dismiss clerk message . _) + (define player-name + (mbody-val (<-wait (message-from message) 'get-name))) + (match (slot-ref clerk 'state) + ('on-duty + (<- (gameobj-loc clerk) 'tell-room + #:text + (format #f "\"Thanks ~a!\" says the clerk. \"I have somewhere I need to be.\" +The clerk leaves the room in a hurry.\n" + player-name) + #:exclude (actor-id clerk)) + (gameobj-set-loc! clerk (dyn-ref clerk 'break-room)) + (slot-set! clerk 'state 'slacking) + (<- (gameobj-loc clerk) 'tell-room + #:text clerk-return-to-slacking-text + #:exclude (actor-id clerk))) + ('slacking + (<- (message-from message) 'tell + #:text "The clerk sternly asks you to not be so dismissive.\n")))) + +(define clerk-slacking-texts + '("The clerk takes a long drag on her cigarette.\n" + "The clerk scrolls through text messages on her phone.\n" + "The clerk coughs a few times.\n" + "The clerk checks her watch and justifies a few more minutes outside.\n" + "The clerk fumbles around for a lighter.\n" + "The clerk sighs deeply and exhaustedly.\n" + "The clerk fumbles around for a cigarette.\n")) + +(define clerk-working-impatience-texts + '("The clerk hums something, but you're not sure what it is." + "The clerk attempts to change the overhead music, but the dial seems broken." + "The clerk clicks around on the desk computer." + "The clerk scribbles an equation on a memo pad, then crosses it out." + "The clerk mutters something about the proprietor having no idea how to run a hotel." + "The clerk thumbs through a printout of some physics paper.")) + +(define clerk-slack-excuse-text + "The desk clerk excuses herself, but says you are welcome to ring the bell +if you need further help.") + +(define clerk-return-to-slacking-text + "The desk clerk enters and slams the door behind her.\n") + + +(define (clerk-act-update-loop clerk message) + (define (tell-room text) + (<- (gameobj-loc clerk) 'tell-room + #:text text + #:exclude (actor-id clerk))) + (define (loop-if-not-destructed) + (if (not (slot-ref clerk 'destructed)) + ;; This iterates by "recursing" on itself by calling itself + ;; (as the message handler) again. It used to be that we had to do + ;; this, because there was a bug where a loop which yielded like this + ;; would keep growing the stack due to some parameter goofiness. + ;; That's no longer true, but there's an added advantage to this + ;; route: it's much more live hackable. If we change the definition + ;; of this method, the character will act differently on the next + ;; "tick" of the loop. + (<- (actor-id clerk) 'update-loop))) + (match (slot-ref clerk 'state) + ('slacking + (tell-room (random-choice clerk-slacking-texts)) + (8sleep (+ (random 20) 15)) + (loop-if-not-destructed)) + ('on-duty + (if (> (slot-ref clerk 'patience) 0) + ;; Keep working but lose patience gradually + (begin + (tell-room (random-choice clerk-working-impatience-texts)) + (slot-set! clerk 'patience (- (slot-ref clerk 'patience) + (+ (random 2) 1))) + (8sleep (+ (random 60) 40)) + (loop-if-not-destructed)) + ;; Back to slacking + (begin + (tell-room clerk-slack-excuse-text) + ;; back bto the break room + (gameobj-set-loc! clerk (dyn-ref clerk 'break-room)) + (tell-room clerk-return-to-slacking-text) + ;; annnnnd back to slacking + (slot-set! clerk 'state 'slacking) + (8sleep (+ (random 30) 15)) + (loop-if-not-destructed)))))) + + +(define break-room + (lol + ('break-room + #f + #:name "Employee Break Room" + #:desc " This is less a room and more of an outdoor wire cage. You get +a bit of a view of the brick exterior of the building, and a crisp wind blows, +whistling, through the openings of the fenced area. Partly smoked cigarettes +and various other debris cover the floor. + Through the wires you can see... well... hm. It looks oddly like +the scenery tapers off nothingness. But that can't be right, can it?" + #:exits + (list (make + #:name "north" + #:to 'smoking-parlor))) + ('break-room:desk-clerk + 'break-room + #:name "the hotel desk clerk" + #:desc " The hotel clerk is wearing a neatly pressed uniform bearing the +hotel insignia. She appears to be rather exhausted." + #:goes-by '("hotel desk clerk" "clerk" "desk clerk")) + ('break-room:void + 'break-room + #:invisible? #t + #:name "The Void" + #:desc "As you stare into the void, the void stares back into you." + #:goes-by '("void" "abyss" "nothingness" "scenery")) + ('break-room:fence + 'break-room + #:invisible? #t + #:name "break room cage" + #:desc "It's a mostly-cubical wire mesh surrounding the break area. +You can see through the gaps, but they're too small to put more than a +couple of fingers through. There appears to be some wear and tear to +the paint, but the wires themselves seem to be unusually sturdy." + #:goes-by '("fence" "cage" "wire cage")))) + ;;; Ennpie's Sea Lounge @@ -213,13 +1424,922 @@ Ooh, ~a!" (random-choice random-bricabrac)))) ;;; Computer room ;;; ------------- +;; Our computer and hard drive are based off the PDP-11 and the RL01 / +;; RL02 disk drives. However we increment both by .5 (a true heresy) +;; to distinguish both from the real thing. + +(define-actor () + ((cmd-put-in hard-drive-insert) + (cmd-push-button hard-drive-push-button) + (get-state hard-drive-act-get-state)) + (commands #:allocation #:each-subclass + #:init-thunk (build-commands + ("insert" ((prep-indir-command cmd-put-in + '("in" "inside" "into")))) + (("press" "push") ((prep-indir-command cmd-push-button))))) + ;; the state moves from: empty -> with-disc -> loading -> ready + (state #:init-value 'empty + #:accessor .state)) + +(define (hard-drive-act-get-state hard-drive message) + (<-reply message (.state hard-drive))) + +(define* (hard-drive-desc hard-drive #:optional whos-looking) + `((p "The hard drive is labeled \"RL02.5\". It's a little under a meter tall.") + (p "There is a slot where a disk platter could be inserted, " + ,(if (eq? (.state hard-drive) 'empty) + "which is currently empty" + "which contains a glowing platter") + ". There is a LOAD button " + ,(if (member (.state hard-drive) '(empty with-disc)) + "which is glowing" + "which is pressed in and unlit") + ". There is a READY indicator " + ,(if (eq? (.state hard-drive) 'ready) + "which is glowing." + "which is unlit.") + ,(if (member (.state hard-drive) '(loading ready)) + " The machine emits a gentle whirring noise." + "")))) + +(define* (hard-drive-push-button gameobj message + #:key direct-obj indir-obj preposition + (player (message-from message))) + (define (tell-room text) + (<-wait (gameobj-loc gameobj) 'tell-room + #:text text)) + (define (tell-room-excluding-player text) + (<-wait (gameobj-loc gameobj) 'tell-room + #:text text + #:exclude player)) + (cond + ((ci-member direct-obj '("button" "load button" "load")) + (tell-room-excluding-player + `(,(mbody-val (<-wait player 'get-name)) + " presses the button on the hard disk.")) + (<- player 'tell + #:text "You press the button on the hard disk.") + + (case (.state gameobj) + ((empty) + ;; I have no idea what this drive did when you didn't have a platter + ;; in it and pressed load, but I know there was a FAULT button. + (tell-room "You hear some movement inside the hard drive...") + (8sleep 1.5) + (tell-room + '("... but then the FAULT button blinks a couple times. " + "What could be missing?"))) + ((with-disc) + (set! (.state gameobj) 'loading) + (tell-room "The hard disk begins to spin up!") + (8sleep 2) + (set! (.state gameobj) 'ready) + (tell-room "The READY light turns on!")) + ((loading ready) + (<- player 'tell + #:text '("Pressing the button does nothing right now, " + "but it does feel satisfying."))))) + (else + (<- player 'tell + #:text '("How could you think of pressing anything else " + "but that tantalizing button right in front of you?"))))) + +(define* (hard-drive-insert gameobj message + #:key direct-obj indir-obj preposition + (player (message-from message))) + (define our-name (slot-ref gameobj 'name)) + (define this-thing + (call/ec + (lambda (return) + (for-each (lambda (occupant) + (define goes-by (mbody-val (<-wait occupant 'goes-by))) + (when (ci-member direct-obj goes-by) + (return occupant))) + (mbody-val (<-wait player 'get-occupants))) + ;; nothing found + #f))) + (cond + ((not this-thing) + (<- player 'tell + #:text `("You don't seem to have any such " ,direct-obj " to put " + ,preposition " " ,our-name "."))) + ((not (mbody-val (<-wait this-thing 'get-prop 'hd-platter?))) + (<- player 'tell + #:text `("It wouldn't make sense to put " + ,(mbody-val (<-wait this-thing 'get-name)) + " " ,preposition " " ,our-name "."))) + ((not (eq? (.state gameobj) 'empty)) + (<- player 'tell + #:text "The disk drive already has a platter in it.")) + (else + (set! (.state gameobj) 'with-disc) + (<- player 'tell + #:text '((p "You insert the glowing disc into the drive.") + (p "The LOAD button begins to glow.")))))) + +;; The computar +(define-actor () + ((cmd-run-program computer-run-program) + (cmd-run-what (lambda (gameobj message . _) + (<- (message-from message) 'tell + #:text '("The computer is already running, and a program appears " + "ready to run." + "you mean to \"run the program on the computer\"")))) + (cmd-help-run-not-press + (lambda (gameobj message . _) + (<- (message-from message) 'tell + #:text '("You don't need to press / push / flip anything. " + "You could " (i "run program on computer") + " already if you wanted to."))))) + (commands #:allocation #:each-subclass + #:init-thunk (build-commands + ("run" ((prep-indir-command cmd-run-program + '("on")) + (direct-command cmd-run-what))) + (("press" "push" "flip") + ((prep-indir-command cmd-help-run-not-press)))))) + +(define* (computer-run-program gameobj message + #:key direct-obj indir-obj preposition + (player (message-from message))) + (define (hd-state) + (mbody-val (<-wait (dyn-ref gameobj 'computer-room:hard-drive) 'get-state))) + (define (tell-room text) + (<-wait (gameobj-loc gameobj) 'tell-room + #:text text)) + (define (tell-room-excluding-player text) + (<-wait (gameobj-loc gameobj) 'tell-room + #:text text + #:exclude player)) + (define (tell-player text) + (<-wait player 'tell + #:text text)) + (cond + ((ci-member direct-obj '("program")) + (tell-room-excluding-player + `(,(mbody-val (<-wait player 'get-name)) + " runs the program loaded on the computer...")) + (tell-player "You run the program on the computer...") + + (cond + ((not (eq? (hd-state) 'ready)) + (tell-room '("... but it errors out. " + "It seems to be complaining about a " (b "DISK ERROR!") + ". It looks like it is missing some essential software."))) + (else + (<- (dyn-ref gameobj 'computer-room:floor-panel) 'open-up)))))) + + +;; floor panel +(define-actor () + ;; TODO: Add "open" verb, since obviously people will try that + ((open? (lambda (panel message) + (<-reply message (slot-ref panel 'open)))) + (open-up floor-panel-open-up)) + (open #:init-value #f)) + +(define (floor-panel-open-up panel message) + (if (slot-ref panel 'open) + (<- (gameobj-loc panel) 'tell-room + #:text '("You hear some gears grind around the hinges of the " + "floor panel, but it appears to already be open.")) + (begin + (slot-set! panel 'open #t) + (<- (gameobj-loc panel) 'tell-room + #:text '("You hear some gears grind, as the metal panel on " + "the ground opens and reveals a stairwell going down!"))))) + +(define* (floor-panel-desc panel #:optional whos-looking) + `("It's a large metal panel on the floor in the middle of the room. " + ,(if (slot-ref panel 'open) + '("It's currently wide open, revealing a spiraling staircase " + "which descends into darkness.") + '("It's currently closed shut, but there are clearly hinges, and " + "it seems like there is a mechanism which probably opens it via " + "some automation. What could be down there?")))) + +(define computer-room + (lol + ('computer-room + #f + #:name "Computer Room" + #:desc (lambda (gameobj whos-looking) + (define panel-open + (mbody-val (<-wait (dyn-ref gameobj 'computer-room:floor-panel) + 'open?))) + `((p "A sizable computer cabinet covers a good portion of the left + wall. It emits a pleasant hum which covers the room like a warm blanket. + Connected to a computer is a large hard drive.") + (p "On the floor is a large steel panel. " + ,(if panel-open + '("It is wide open, exposing a spiral staircase " + "which descends into darkness.") + '("It is closed, but it has hinges which " + "suggest it could be opened."))))) + #:exits + (list (make + #:name "east" + #:to 'playroom) + (make + #:name "down" + #:to 'underground-lab + #:traverse-check + (lambda (exit room whos-exiting) + (define panel-open + (mbody-val (<-wait (dyn-ref room 'computer-room:floor-panel) + 'open?))) + (if panel-open + (values #t "You descend the spiral staircase.") + (values #f '("You'd love to go down, but the only way " + "through is through that metal panel, " + "which seems closed."))))))) + ('computer-room:hard-drive + 'computer-room + #:name "the hard drive" + #:desc (wrap-apply hard-drive-desc) + #:goes-by '("hard drive" "drive" "hard disk")) + ('computer-room:computer + 'computer-room + #:name "the computer" + #:desc '((p "It's a coat closet sized computer labeled \"PDP-11.5\". ") + (p "The computer is itself turned on, and it looks like it is " + "all set up for you to run a program on it.")) + #:goes-by '("computer")) + ('computer-room:floor-panel + 'computer-room + #:name "a floor panel" + #:desc (wrap-apply floor-panel-desc) + #:invisible? #t + #:goes-by '("floor panel" "panel")))) + + +;;; * UNDERGROUND SECTION OF THE GAME! * + + +;;; The lab + +(define underground-map-text + "\ + _______ | + .-' @ '-. \\ ????? + .' '. .\\ + | [8sync Hive] |======' '-_____ + ', M ,' + '. @ .' + \\ @ / + '-__+__-' + '. @ .' + .--------------. \\ / + | [Guile Async | .-------+------. + | Museum] | | [Lab] #!#| .-------------. + | @| | MM | |[Federation | + | & ^ +##+@ || < +##| Station]| + | | | @ | | | + | & # | |*You-Are-Here*| '-------------' + | # ^ | #+-------+------' + '-------+------' # # + # # # + # # .-----------. + .-+----. # |# F | + |@?+%? +#### | ^ f## | + '------' | f f %| + |F [Mudsync | + | $ Swamp] | + '-----------'") + +(define 8sync-design-goals + '(ul (li (b "Actor based, shared nothing environment: ") + "Shared resources are hard to control and result in fighting +deadlocks, etc. Escape the drudgery: only one actor controls a resource, +and they only receive one message at a time (though they can \"juggle\" +messages).") + (li (b "Live hackable: ") + "It's hard to plan out a concurrent system; the right structure +is often found by evolving the system while it runs. Make it easy to +build, shape, and change a running system, as well as observe and correct +errors.") + (li (b "No callback hell: ") + "Just because you're calling out to some other asynchronous +code doesn't mean you should need to chop up your program into a bunch of bits. +Clever use of delimited continuations makes it easy."))) + +(define underground-lab + (lol + ('underground-lab + #f + #:name "Underground laboratory" + #:desc '((p "This appears to be some sort of underground laboratory." + "There is a spiral staircase here leading upwards, where " + "it seems much brighter.") + (p "There are a number of doors leading in different directions: +north, south, east, and west, as well as a revolving door to the southwest. +It looks like it could be easy to get lost, but luckily there +is a map detailing the layout of the underground structure.")) + #:exits + (list (make + #:name "up" + #:to 'computer-room + #:traverse-check + (lambda (exit room whos-exiting) + (values #t "You climb the spiral staircase."))) + (make + #:name "west" + #:to 'async-museum + #:traverse-check + (lambda (exit room whos-exiting) + (values #t '("You head west through a fancy-looking entrance. " + "A security guard steps aside for you to pass through, " + "into the room, then stands in front of the door.")))) + (make + #:name "north" + #:to 'hive-entrance) + (make + #:name "east" + #:to 'federation-station) + (make + #: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 + #: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 + 'underground-lab + #:name "the underground map" + #:desc '("This appears to be a map of the surrounding area. " + "You could read it if you want to.") + #:read-text `(pre ,underground-map-text) + #:goes-by '("map" "underground map" "lab map")) + + ('underground-lab:8sync-sign + 'underground-lab + #:name "a sign labeled \"8sync design goals\"" + #: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)))) + + +;;; guile async museum + +(define async-museum + (list + (list + 'async-museum + #f + #:name "Guile Asynchronous Museum" + #:desc '((p "You're in the Guile Asynchronous Museum. There is a list of exhibits +on the wall near the entrance. Scattered around the room are the exhibits +themselves, but it's difficult to pick them out. Maybe you should read the list +to orient yourself.") + (p "There is a door to the east, watched by a security guard, +as well as an exit leading to the south.")) + #:exits (list + (make + #:name "south" + #:to 'gift-shop) + (make + #:name "east" + #:to 'underground-lab + #:traverse-check + (lambda (exit room whos-exiting) + (values #f '("The security guard stops you and tells you " + "that the only exit is through the gift shop.")))))) + (list + 'async-museum:security-guard + 'async-museum + #:name "a security guard" + #:desc + '(p "The security guard is blocking the eastern entrance, where " + "you came in from.") + #:goes-by '("security guard" "guard" "security") + #:catchphrases '("It's hard standing here all day." + "I just want to go home." + "The exhibits are nice, but I've seen them all before.")) + (let ((placard + `((p "Welcome to our humble museum! The exhibits are listed below. " + (br) + "To look at one, simply type: " (i "look at ")) + (p "Available exhibits:") + (ul ,@(map (lambda (exhibit) + `(li ,exhibit)) + '("2016 Progress" + "8sync and Fibers" + "Suspendable Ports" + "The Actor Model")))))) + (list + 'async-museum:list-of-exhibits + 'async-museum + #:name "list of exhibits" + #:desc + `((p "It's a list of exibits in the room. The placard says:") + ,@placard) + #:goes-by '("list of exhibits" "exhibit list" "list" "exhibits") + #:read-text placard)) + (list + 'async-museum:2016-progress-exhibit + '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 + '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 + '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 + 'async-museum + #:name "Suspendable Ports Exhibit" + #:goes-by '("suspendable ports exhibit" "ports exhibit" + "suspendable exhibit" "suspendable ports" "ports") + #:desc + '((p "Suspendable ports are a new feature in Guile 2.2, and allows code " + "that would normally block on IO to " (i "automatically") " suspend " + "to the scheduler until information is ready to be read/written!") + (p "Yow! You might barely need to change your existing blocking code!") + (p "Fibers, 8sync, and guile-a-sync now support suspendable ports."))) + (list + 'async-museum:actor-model-exhibit + 'async-museum + #:name "Actor Model Exhibit" + #:goes-by '("actor model exhibit" "actor exhibit" + "actor model") + #:desc + '((p "Here are some fact(oids) about the actor model!") + (ul (li "Concieved initially by Carl Hewitt in early 1970s") + (li "\"A society of experts\"") + (li "shared nothing, message passing") + (li "Originally the research goal of Scheme! " + "(message passing / lambda anecdote here)") + (li "Key concepts consistent, but implementation details vary widely") + (li "Almost all distributed systems can be viewed in terms of actor model") + (li "Replaced by vanilla lambdas & generic methods? " + "Maybe not if address space not shared!")))))) + +(define gift-shop + (lol + ('gift-shop + #f + #:name "Museum Gift Shop" + #:desc '("There are all sorts of scrolls and knicknacks laying around here, " + "but they all seem glued in place and instead of a person manning the shop " + "there's merely a cardboard cutout of a person with a \"shopkeeper\" nametag. " + "You can pretty well bet that someone wanted to finish this room but ran out of " + "time.") + #:exits (list + (make + #:name "northeast" + #:to 'underground-lab + #:traverse-check + (lambda (exit room whos-exiting) + (values #t '("The revolving door spins as you walk through it. Whee!")))) + (make + #:name "north" + #:to 'async-museum))))) + + +;;; Hive entrance + +(define actor-descriptions + '("This one is fused to the side of the hive. It isn't receiving any +messages, and it seems to be in hibernation." + "A chat program glows in front of this actor's face. They seem to +be responding to chat messages and forwarding them to some other actors, +and forwarding messages from other actors back to the chat." + "This actor is bossing around other actors, delegating tasks to them +as it receives requests, and providing reports on the worker actors' +progress." + "This actor is trying to write to some device, but the device keeps +alternating between saying \"BUSY\" or \"READY\". Whenever it says +\"BUSY\" the actor falls asleep, and whenever it says \"READY\" it +seems to wake up again and starts writing to the device." + "Whoa, this actor is totally wigging out! It seems to be throwing +some errors. It probably has some important work it should be doing +but you're relieved to see that it isn't grinding the rest of the Hive +to a halt.")) + +(define hive-entrance + (lol + ('hive-entrance + #f + #:name "Entrance to the 8sync Hive" + #:desc + '((p "Towering before you is the great dome-like 8sync Hive, or at least +one of them. You've heard about this... the Hive is itself the actor that all +the other actors attach themselves to. It's shaped like a spherical half-dome. +There are some actors milling about, and some seem fused to the side of the +hive itself, but all of them have an umbellical cord attached to the hive from +which you see flashes of light comunicating what must be some sort of messaging +protocol.") + (p "To the south is a door leading back to the underground lab. +North leads into the Hive itself.")) + #:exits + (list (make + #:name "south" + #:to 'underground-lab) + (make + #:name "north" + #:to 'hive-inside))) + ('hive-entrance:hive + 'hive-entrance + #:name "the Hive" + #:goes-by '("hive") + #:desc + '((p "It's shaped like half a sphere embedded in the ground. +Supposedly, while all actors are autonomous and control their own state, +they communicate through the hive itself, which is a sort of meta-actor. +There are rumors that actors can speak to each other even across totally +different hives. Could that possibly be true?"))) + ('hive-entrance:actor + 'hive-entrance + #:name "some actors" + #:goes-by '("actor" "actors" "some actors") + #:chat-format (lambda (npc catchphrase) + `((p "You pick one actor out of the mix and chat with it. ") + (p "It says: \"" ,catchphrase "\""))) + #:desc + (lambda _ + `((p "There are many actors, but your eyes focus on one in particular.") + (p ,(random-choice actor-descriptions)))) + #:catchphrases + '("Yeah we go through a lot of sleep/awake cycles around here. +If you aren't busy processing a message, what's the point of burning +valuable resources?" + "I know I look like I'm some part of dreary collective, but +really we have a lot of independence. It's a shared nothing environment, +after all. (Well, except for CPU cycles, and memory, and...)" + "Shh! I've got another message coming in and I've GOT to +handle it!" + "I just want to go to 8sleep already." + "What a lousy scheduler we're using! I hope someone upgrades +that thing soon.")))) + +;;; Inside the hive + +(define-actor () + ((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))))) + + +;;; Inside the Hive + +(define hive-inside + (lol + ('hive-inside + #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 + #:name "south" + #:to 'hive-entrance))) + ;; hive actor + ;; TODO: Occasionally "fret" some noises, similar to the Clerk. + ('hive-inside:hive-actor + '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 + '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 + '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 + '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")))) + + +;;; Federation Station +(define federation-station + (lol + ('federation-station + #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 + #:name "west" + #:to 'underground-lab))) + ;; nodes + ('federation-station:nodes + '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 + '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 + 'federation-station + #:name "a conspiracy chart" + #:goes-by '("conspiracy chart" "chart") + #:desc + '((p (i "\"IT'S ALL RELATED!\"") " shouts the over-exuberant conspiracy " + "chart. " + (i "\"ActivityPub? Federation? The actor model? Scheme? Text adventures? " + "MUDS???? What do these have in common? Merely... EVERYTHING!\"")) + (p "There are circles and lines drawn between all the items in red marker, " + "with scrawled notes annotating the theoretical relationships. Is the " + "author of this poster mad, or onto something? Perhaps a bit of both. " + "There's a lot written here, but here are some of the highlights:") + (p + (ul + (li (b "Scheme") " " + (a "http://cs.au.dk/~hosc/local/HOSC-11-4-pp399-404.pdf" + "was originally started ") + " to explore the " (b "actor model") + ". (It became more focused around studying the " (b "lambda calculus") + " very quickly, while also uncovering relationships between the two systems.)") + ;; Subject Predicate Object + (li "The " (a "https://www.w3.org/TR/activitypub/" + (b "ActivityPub")) + " protocol for " (b "federation") + " uses the " (b "ActivityStreams") " format for serialization. " + (b "Text adventures") " and " (b "MUDS") + " follow a similar structure to break down the commands of players.") + (li (b "Federation") " and the " (b "actor model") " both are related to " + "highly concurrent systems and both use message passing to communicate " + "between nodes.") + (li "Zork, the first major text adventure, used the " (b "MUDDLE") " " + "language as the basis for the Zork Interactive Language. MUDDLE " + "is very " (b "Scheme") "-like and in fact was one of Scheme's predecessors. " + "And of course singleplayer text adventures like Zork were the " + "predecessors to MUDs.") + (li "In the 1990s, before the Web became big, " (b "MUDs") + " were an active topic of research, and there was strong interest " + (a "http://www.saraswat.org/desiderata.html" + "in building decentralized MUDs") + " similar to what is being " + "worked on for " (b "federation") ". "))))) + + ;; goblin + + )) + + + +;;; North hall +;;; ========== +(define north-hall + (lol + ('north-hall + #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 + #:name "south" + #:to 'grand-hallway))) + ('north-hall:sign + '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 + '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 + '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 + '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")))) + + ;;; Game ;;; ---- -(define game-spec - (append lobby)) +(define (game-spec) + (append lobby grand-hallway smoking-parlor + playroom break-room computer-room underground-lab + async-museum gift-shop hive-entrance + hive-inside federation-station + north-hall)) +;; TODO: Provide command line args (define (run-game . args) - (run-demo "/tmp/bricabrac-game.db" game-spec 'room:lobby)) + (run-demo (game-spec) 'lobby #:repl-server #t))