X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=085822681aede781b2ae326cd68d622f56029bd7;hp=8f3e580974cccf1d2fb34e08f0625fe702aa5e30;hb=30b63e1ad9cab75cf45509e7e58dc713ddc82a21;hpb=8df43947a29393266da4df9e43f7656e56558fd6 diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index 8f3e580..0858226 100644 --- a/worlds/bricabrac.scm +++ b/worlds/bricabrac.scm @@ -19,9 +19,8 @@ ;;; Hotel Bricabrac (use-modules (mudsync) - (mudsync parser) - (8sync actors) - (8sync agenda) + (mudsync container) + (8sync) (oop goops) (ice-9 control) (ice-9 format) @@ -46,19 +45,13 @@ ;;; Some simple object types. ;;; ========================= -(define readable-commands - (list - (direct-command "read" 'cmd-read))) - -(define readable-commands* - (append readable-commands - thing-commands)) - -(define-class () +(define-class () (read-text #:init-value "All it says is: \"Blah blah blah.\"" #:init-keyword #:read-text) (commands - #:init-value readable-commands*) + #: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)))) @@ -68,6 +61,31 @@ #:text (string-append (slot-ref actor 'read-text) "\n"))) +;; 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* (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 ;;; ----- @@ -80,11 +98,6 @@ (<- (message-from message) 'tell #:text text-to-send)) -(define chat-commands - (list - (direct-command "chat" 'cmd-chat) - (direct-command "talk" 'cmd-chat))) - (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 @@ -105,7 +118,9 @@ or 'skribe'? Now *that's* composition!")) (catchphrases #:init-value '("Blarga blarga blarga!") #:init-keyword #:catchphrases) (commands - #:init-value chat-commands) + #:allocation #:each-subclass + #:init-thunk (build-commands + (("chat" "talk") ((direct-command cmd-chat))))) (actions #:allocation #:each-subclass #:init-thunk (build-actions @@ -113,10 +128,10 @@ or 'skribe'? Now *that's* composition!")) (define-class () (commands - #:init-value - (list - (prep-direct-command "sign" 'cmd-sign-form - '("as")))) + #: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)))) @@ -150,18 +165,13 @@ Alphanumerics, _ and - only, 2-15 characters, starts with an alphabetic character.\n"))) -(define summoning-bell-commands - (list - (direct-command "ring" 'cmd-ring))) -(define summoning-bell-commands* - (append summoning-bell-commands - thing-commands*)) - -(define-class () +(define-class () (summons #:init-keyword #:summons) (commands - #:init-value summoning-bell-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)))) @@ -205,9 +215,16 @@ character.\n"))) "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 @@ -223,10 +240,10 @@ character.\n"))) #:exits (list (make #:name "north" - #:to 'room:grand-hallway))) + #:to 'grand-hallway))) ;; NPC: hotel owner - ('npc:lobby:hotel-owner - 'room:lobby + ('lobby:hotel-owner + 'lobby #:name "a frumpy fellow" #:desc '((p " Whoever this is, they looks totally exhausted. They're @@ -242,8 +259,8 @@ though the conversation may be a bit one sided.")) "hotel proprietor" "proprietor") #:catchphrases hotel-owner-grumps) ;; 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 @@ -256,18 +273,30 @@ Classy!" "hotel bricabrac sign" "lobby sign")) - ('thing:lobby:bell - 'room:lobby + ('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 'npc:break-room:desk-clerk) + #: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.") ;; Object: curio cabinets - ('thing:lobby: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" "cabinet of curiosities") @@ -283,47 +312,42 @@ Ooh, ~a!" (random-choice "the pickled circuitboard of EVLIS" "a scroll of teletype paper holding the software Four Freedoms" "a telephone shaped like an orange cartoon cat"))))) - ('thing:lobby:sign-in-form - 'room: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.") - ('thing:lobby:porcelain-doll - 'room:lobby - #:generally-visible #f + ('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")) - ('thing:lobby:1950s-robots - 'room:lobby - #:generally-visible #f + ('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")) - ('thing:lobby:tea-set - 'room:lobby - #:generally-visible #f + ('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")) - ('thing:lobby:mustard-pot - 'room:lobby - #:generally-visible #f + ('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")) - ('thing:lobby:head-of-elvis - 'room:lobby - #:generally-visible #f + ('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 @@ -335,9 +359,9 @@ not Elvis.") everything you read.")) #:goes-by '("pickled head of elvis" "pickled head of Elvis" "elvis" "Elvis" "head" "pickled head")) - ('thing:lobby:circuitboard-of-evlis - 'room:lobby - #:generally-visible #f + ('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 @@ -349,9 +373,9 @@ Too bad...")) #:goes-by '("pickled circuitboard of evlis" "pickled circuitboard of Evlis" "pickled circuitboard of EVLIS" "evlis" "Evlis" "EVLIS" "circuitboard" "pickled circuitboard")) - ('thing:lobby:teletype-scroll - 'room:lobby - #:generally-visible #f + ('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:") @@ -370,9 +394,9 @@ English language surrounding the word 'free' have lead to a lot of terminology d "teletype paper" "scroll" "four freedoms" "scroll of teletype paper holding the software Four Freedoms" "scroll of teletype paper holding the software four freedoms")) - ('thing:lobby:orange-cat-phone - 'room:lobby - #:generally-visible #f + ('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 @@ -389,35 +413,141 @@ this general shape in the 1990s." ;;; 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...\"")))) + +;;; 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)) + (define grand-hallway (lol - ('room:grand-hallway + ('grand-hallway #f #:name "Grand Hallway" - #:desc " A majestic red carpet runs down the center of the room. + #: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. - In the center is a large statue of a bearded man. You wonder what -that's all about? - To the south is the lobby. A door to the east is labeled \"smoking -room\", while a door to the west is labeled \"playroom\"." +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 "south" - #:to 'room:lobby) + #:to 'lobby) (make #:name "west" - #:to 'room:playroom) + #:to 'playroom) (make #:name "east" - #:to 'room:smoking-parlor))) - ('thing:ignucius-statue - 'room:grand-hallway - #:name "a statue" - #:desc " The statue is of a serious-looking bearded man with long, flowing hair. - It has a large physical halo. Removing it is tempting, but it looks pretty -well fastened." - #:goes-by '("statue" "st ignucius" "st. ignucius")))) + #:to 'smoking-parlor))) + ('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 @@ -425,26 +555,56 @@ well fastened." (define playroom (lol - ('room:playroom + ('playroom #f #:name "The Playroom" - #:desc " There are toys scattered everywhere here. It's really unclear -if this room is intended for children or child-like adults." + #: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 'room:grand-hallway))) - ('thing:playroom:cubey - 'room:playroom - #:name "cubey" - #:takeable #t + #: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!") - ('thing:cuddles-plushie - 'room:playroom - #:name "a cuddles plushie" + ('playroom:cuddles-plushie + 'playroom + #:name "a Cuddles plushie" #:goes-by '("plushie" "cuddles plushie" "cuddles") - #:takeable #t - #:desc " A warm and fuzzy cuddles plushie! It's a cuddlefish!"))) + #: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."))) @@ -467,9 +627,9 @@ if this room is intended for children or child-like adults." (sit-name #:init-keyword #:sit-name) (commands - #:init-value - (list - (direct-command "sit" 'cmd-sit-furniture))) + #: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)))) @@ -491,7 +651,7 @@ if this room is intended for children or child-like adults." (define smoking-parlor (lol - ('room:smoking-parlor + ('smoking-parlor #f #:name "Smoking Parlor" #:desc @@ -503,20 +663,20 @@ a nondescript steel door to the south, leading apparently outside.")) #:exits (list (make #:name "west" - #:to 'room:grand-hallway) + #:to 'grand-hallway) (make #:name "south" - #:to 'room:break-room))) - ('thing:smoking-parlor:chair - 'room:smoking-parlor + #: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") - ('thing:smoking-parlor:sofa - 'room:smoking-parlor + ('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" @@ -524,8 +684,8 @@ a nondescript steel door to the south, leading apparently outside.")) #:sit-phrase "sprawl out on" #:sit-phrase-third-person "sprawls out on into" #:sit-name "the plush leather couch") - ('thing:smoking-parlor:bar-stool - 'room:smoking-parlor + ('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." @@ -533,17 +693,17 @@ seat in the room, though." #:sit-phrase "hop on" #:sit-phrase-third-person "hops onto" #:sit-name "the bar stool") - ('npc:ford-prefect - 'room:smoking-parlor + ('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) - ('thing:smoking-parlor:no-smoking-sign - 'room:smoking-parlor - #:generally-visible #f + ('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." @@ -557,24 +717,20 @@ It has some bits of bubble gum stuck to it... yuck." ;;; Breakroom ;;; --------- -(define clerk-commands - (list - (direct-command "talk" 'cmd-chat) - (direct-command "chat" 'cmd-chat) - (direct-command "ask" 'cmd-ask-incomplete) - (prep-direct-command "ask" 'cmd-ask-about) - (direct-command "dismiss" 'cmd-dismiss))) -(define clerk-commands* - (append clerk-commands thing-commands*)) - -(define-class () +(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 #:init-value clerk-commands*) + (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 @@ -652,7 +808,7 @@ with tuition at where it is...")) #:allow-other-keys) (match (slot-ref clerk 'state) ('on-duty - (match (assoc (pk 'indir indir-obj) clerk-help-topics) + (match (assoc indir-obj clerk-help-topics) ((_ . info) (<- (message-from message) 'tell #:text @@ -678,7 +834,7 @@ so there's no need to ring the bell.\n")) #: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 'room:lobby)) + (gameobj-set-loc! clerk (dyn-ref clerk 'lobby)) (slot-set! clerk 'patience 8) (slot-set! clerk 'state 'on-duty) (<- (gameobj-loc clerk) 'tell-room @@ -703,7 +859,7 @@ You can ask me about the following: The clerk leaves the room in a hurry.\n" player-name) #:exclude (actor-id clerk)) - (gameobj-set-loc! clerk (dyn-ref clerk 'room:break-room)) + (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 @@ -771,7 +927,7 @@ if you need further help.") (begin (tell-room clerk-slack-excuse-text) ;; back bto the break room - (gameobj-set-loc! clerk (pk 'break-room (dyn-ref clerk 'room: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) @@ -781,7 +937,7 @@ if you need further help.") (define break-room (lol - ('room:break-room + ('break-room #f #:name "Employee Break Room" #:desc " This is less a room and more of an outdoor wire cage. You get @@ -793,20 +949,28 @@ the scenery tapers off nothingness. But that can't be right, can it?" #:exits (list (make #:name "north" - #:to 'room:smoking-parlor)) - ) - ('npc:break-room:desk-clerk - 'room:break-room + #: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 looks like she'd much rather be somewhere else." +hotel insignia. She appears to be rather exhausted." #:goes-by '("hotel desk clerk" "clerk" "desk clerk")) - ('thing:break-room:void - 'room:break-room - #:generally-visible #f + ('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")))) + #: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")))) @@ -817,15 +981,149 @@ hotel insignia. She looks like she'd much rather be somewhere else." ;;; 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) + (<- (gameobj-loc gameobj) 'tell-room + #:text text)) + (define (tell-room-excluding-player text) + (<- (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.")))))) + +(define computer-room + (lol + ('computer-room + #f + #:name "Computer Room" + #:desc '((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. It is closed, but it has +hinges which suggest it could be opened.")) + #:exits + (list (make + #:name "east" + #:to 'playroom))) + ('computer-room:hard-drive + 'computer-room + #:name "a hard drive" + #:desc (wrap-apply hard-drive-desc) + #:goes-by '("hard drive" "drive" "hard disk")))) + + ;;; Game ;;; ---- (define (game-spec) (append lobby grand-hallway smoking-parlor - playroom break-room)) + playroom break-room computer-room)) ;; TODO: Provide command line args (define (run-game . args) - (run-demo (game-spec) 'room:lobby #:repl-server #t)) + (run-demo (game-spec) 'lobby #:repl-server #t))