X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=04d9240d0fe2433f6ad15d5bf26ef2a93dcdcb25;hp=b816c88a8ed592340b252cf2bb1c53ce9080eb91;hb=f50ae8cc329553073d791470c885ffabb5c35cff;hpb=6212897253ee040f58bf1351dabd1b2a3f3e1b75 diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index b816c88..04d9240 100644 --- a/worlds/bricabrac.scm +++ b/worlds/bricabrac.scm @@ -46,21 +46,15 @@ ;;; 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-value (build-actions + #:init-thunk (build-actions (cmd-read readable-cmd-read)))) (define (readable-cmd-read actor message) @@ -80,11 +74,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,30 +94,21 @@ 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-value + #:init-thunk (build-actions (cmd-chat npc-chat-randomly)))) -(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")) - (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-value (build-actions + #:init-thunk (build-actions (cmd-sign-form sign-cmd-sign-in)))) @@ -160,20 +140,15 @@ 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-value (build-actions + #:init-thunk (build-actions (cmd-ring summoning-bell-cmd-ring)))) (define* (summoning-bell-cmd-ring bell message . _) @@ -279,24 +254,120 @@ wanted to." ('thing:lobby:cabinet 'room:lobby #: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"))))) ('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.") - ;; Object: desk - ;; - Object: bell - ;; - Object: sign in form - ;; - Object: pamphlet - ;; Object: : reprimands that you want to ring the - ;; bell on the desk - ) - ) + + ('thing:lobby:porcelain-doll + 'room: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 + #: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 + #: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 + #: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 + #: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")) + ('thing:lobby:circuitboard-of-evlis + 'room: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")) + ('thing:lobby:teletype-scroll + 'room: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")) + ('thing:lobby:orange-cat-phone + 'room: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")))) @@ -308,13 +379,14 @@ Ooh, ~a!" (random-choice random-bricabrac)))) ('room: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" @@ -325,14 +397,19 @@ room\", while a door to the west is labeled \"playroom\"." (make #:name "east" #:to 'room:smoking-parlor))) - ('thing:ignucius-statue + ('thing:hackthena-statue 'room:grand-hallway #:name "a statue" - #:desc " The statue is of a serious-looking bearded man with long, flowing hair. -The inscription says \"St. Ignucius\". - It has a large physical halo. Removing it is tempting, but it looks pretty -well fastened." - #:goes-by '("statue" "st ignucius" "st. ignucius")))) + #: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")))) ;;; Playroom @@ -350,16 +427,42 @@ if this room is intended for children or child-like adults." #:name "east" #:to 'room:grand-hallway))) ('thing:playroom:cubey - 'room:playroom + 'room:playroom #:name "cubey" - #:takeable #t + #:take-me? #t #:desc " It's a little foam cube with googly eyes on it. So cute!") - ('thing:cuddles-plushie - 'room:playroom + ('thing:playroom:cuddles-plushie + 'room: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!") + + ('thing:playroom:toy-chest + 'room: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? (pk 'contents 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 + ('thing:playroom:toy-chest:rubber-duck + 'thing: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."))) @@ -382,11 +485,11 @@ 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-value (build-actions + #:init-thunk (build-actions (cmd-sit-furniture furniture-cmd-sit)))) (define* (furniture-cmd-sit actor message #:key direct-obj) @@ -422,7 +525,7 @@ a nondescript steel door to the south, leading apparently outside.")) (make #:name "south" #:to 'room:break-room))) - ('thing:smoking-room:chair + ('thing:smoking-parlor:chair 'room:smoking-parlor #:name "a comfy leather chair" #:desc " That leather chair looks really comfy!" @@ -430,7 +533,7 @@ a nondescript steel door to the south, leading apparently outside.")) #:sit-phrase "sink into" #:sit-phrase-third-person "sinks into" #:sit-name "the comfy leather chair") - ('thing:smoking-room:sofa + ('thing:smoking-parlor:sofa 'room:smoking-parlor #:name "a plush leather sofa" #:desc " That leather chair looks really comfy!" @@ -439,7 +542,7 @@ 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-room:bar-stool + ('thing:smoking-parlor:bar-stool 'room:smoking-parlor #:name "a bar stool" #:desc " Conveniently located near the bar! Not the most comfortable @@ -456,8 +559,15 @@ seat in the room, though." "frood" "prefect" "ford") #:catchphrases prefect-quotes) - ;; TODO: Cigar dispenser + ('thing:smoking-parlor:no-smoking-sign + 'room: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")) + ;; TODO: Cigar dispenser )) @@ -465,27 +575,23 @@ seat in the room, though." ;;; 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-value (build-actions + #:init-thunk (build-actions (init clerk-act-init) (cmd-chat clerk-cmd-chat) (cmd-ask-incomplete clerk-cmd-ask-incomplete) @@ -494,7 +600,7 @@ seat in the room, though." (update-loop clerk-act-update-loop) (be-summoned clerk-act-be-summoned)))) -(define (clerk-act-init clerk message) +(define (clerk-act-init clerk message . _) ;; call the gameobj main init method (gameobj-act-init clerk message) ;; start our main loop @@ -630,19 +736,16 @@ The clerk leaves the room in a hurry.\n" "The clerk fumbles around for a cigarette.\n")) (define clerk-working-impatience-texts - '("The clerk struggles to retain an interested and polite smile.\n" - "The clerk checks the time on her phone.\n" - "The clerk taps her foot.\n" - "The clerk takes a deep breath.\n" - "The clerk yawns.\n" - "The clerk drums her nails on the counter.\n" - "The clerk clicks around on the desk computer.\n" - "The clerk thumbs through a printout of some physics paper.\n" - "The clerk mutters that her dissertation isn't going to write itself.\n")) + '("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, claiming she has important things to -attend to.\n") + "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") @@ -667,7 +770,7 @@ attend to.\n") (match (slot-ref clerk 'state) ('slacking (tell-room (random-choice clerk-slacking-texts)) - (8sleep (+ (random 10) 10)) + (8sleep (+ (random 20) 15)) (loop-if-not-destructed)) ('on-duty (if (> (slot-ref clerk 'patience) 0) @@ -676,7 +779,7 @@ attend to.\n") (tell-room (random-choice clerk-working-impatience-texts)) (slot-set! clerk 'patience (- (slot-ref clerk 'patience) (+ (random 2) 1))) - (8sleep (+ (random 25) 20)) + (8sleep (+ (random 60) 40)) (loop-if-not-destructed)) ;; Back to slacking (begin @@ -710,8 +813,23 @@ the scenery tapers off nothingness. But that can't be right, can it?" 'room: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." - #:goes-by '("hotel desk clerk" "clerk" "desk clerk")))) +hotel insignia. She appears to be rather exhausted." + #:goes-by '("hotel desk clerk" "clerk" "desk clerk")) + ('thing:break-room:void + 'room: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")) + ('thing:break-room:fence + 'room: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"))))