X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=fe158ff352d14f3b88831618adcd584b7ae83278;hb=7eb469aad2ae78746d6b5c9f9b4995d99a40ee48;hp=117e86af3af1d8351cf86fe002961d5adbddddbe;hpb=2d7173d04d4b01f4480ec700c6419407232ef1bb;p=mudsync.git diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index 117e86a..fe158ff 100644 --- a/worlds/bricabrac.scm +++ b/worlds/bricabrac.scm @@ -23,7 +23,9 @@ (8sync systems actors) (8sync agenda) (oop goops) + (ice-9 control) (ice-9 format) + (ice-9 match) (rx irregex)) @@ -47,18 +49,27 @@ (define readable-commands (list (direct-command "read" 'cmd-read))) + +(define readable-commands* + (append readable-commands + thing-commands)) + (define readable-actions (build-actions (cmd-read (wrap-apply readable-cmd-read)))) -(define-class () +(define readable-actions* + (append readable-actions + thing-actions*)) + +(define-class () (read-text #:init-value "All it says is: \"Blah blah blah.\"" #:init-keyword #:read-text) (commands - #:init-value readable-commands) + #:init-value readable-commands*) (message-handler #:init-value - (simple-dispatcher (append gameobj-actions readable-actions)))) + (simple-dispatcher readable-actions*))) (define (readable-cmd-read actor message) (<- actor (message-from message) 'tell @@ -124,7 +135,7 @@ or 'skribe'? Now *that's* composition!")) (commands #:init-value (list - (indir-as-direct-command "sign" 'cmd-sign-form + (prep-direct-command "sign" 'cmd-sign-form '("as")))) (message-handler #:init-value @@ -160,9 +171,49 @@ or 'skribe'? Now *that's* composition!")) #:text (format #f "~a signs the form!\n~a is now known as ~a\n" old-name old-name name))) (<- actor (message-from message) 'tell - "Sorry, that's not a valid name. + #:text "Sorry, that's not a valid name. Alphanumerics, _ and - only, 2-15 characters, starts with an alphabetic -character."))) +character.\n"))) + + +(define summoning-bell-commands + (list + (direct-command "ring" 'cmd-ring))) +(define summoning-bell-commands* + (append summoning-bell-commands + thing-commands*)) + +(define summoning-bell-actions + (build-actions + (cmd-ring (wrap-apply summoning-bell-cmd-ring)))) +(define summoning-bell-actions* + (append summoning-bell-actions + thing-actions*)) + +(define-class () + (summons #:init-keyword #:summons) + + (commands + #:init-value summoning-bell-commands*) + (message-handler + #:init-value + (simple-dispatcher summoning-bell-actions*))) + +(define-mhandler (summoning-bell-cmd-ring bell message) + (define who-rang + (message-ref + (<-wait bell (message-from message) 'get-name) + 'val)) + (<- bell (message-from message) 'tell + #:text "*ring ring!* You ring the bell!\n") + (<- bell (gameobj-loc bell) 'tell-room + #:text + (format #f "*ring ring!* ~a rings the bell!\n" + who-rang) + #:exclude (message-from message)) + + (<- bell (dyn-ref bell (slot-ref bell 'summons)) 'be-summoned + #:who-summoned (message-from message))) (define lobby @@ -219,6 +270,15 @@ Classy!" "hotel bricabrac sign" "lobby sign")) + ('thing:lobby:bell + 'room: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) + ;; Object: curio cabinets ('thing:lobby:cabinet 'room:lobby @@ -257,13 +317,15 @@ 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. All around are various doors, but -they're all boarded up. One to the east goes to the smoking parlor, -though." + 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) + (make + #:name "west" + #:to 'room:playroom) (make #:name "east" #:to 'room:smoking-parlor))) @@ -272,13 +334,38 @@ though." #: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. It doesn't look like it would be hard to remove." + It has a large physical halo. Removing it is tempting, but it looks pretty +well fastened." #:goes-by '("statue" "st ignucius" "st. ignucius")))) ;;; Playroom ;;; -------- +(define playroom + (lol + ('room: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." + #:exits + (list (make + #:name "east" + #:to 'room:grand-hallway))) + ('thing:playroom:cubey + 'room:playroom + #:name "cubey" + #:takeable #t + #:desc " It's a little foam cube with googly eyes on it. So cute!") + ('thing:cuddles-plushie + 'room:playroom + #:name "a cuddles plushie" + #:goes-by '("plushie" "cuddles plushie") + #:takeable #t + #:desc " A warm and fuzzy cuddles plushie! It's a cuddlefish!"))) + + ;;; Writing room ;;; ------------ @@ -336,12 +423,15 @@ The inscription says \"St. Ignucius\". 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. - Nonetheless there are some candy cigarettes and cigars you can pick up -at the bar. (editor's note: or will be soon :])" + 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 'room:grand-hallway))) + #:to 'room:grand-hallway) + (make + #:name "south" + #:to 'room:break-room))) ('thing:smoking-room:chair 'room:smoking-parlor #:name "a comfy leather chair" @@ -354,7 +444,7 @@ at the bar. (editor's note: or will be soon :])" 'room:smoking-parlor #:name "a plush leather sofa" #:desc " That leather chair looks really comfy!" - #:goes-by '("leather sofa" "plush leather sofa" "chair" + #: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" @@ -364,10 +454,243 @@ at the bar. (editor's note: or will be soon :])" #:name "a bar stool" #:desc " Conveniently located near the bar! Not the most comfortable seat in the room, though." - #:goes-by '("stool" "bar stool") + #:goes-by '("stool" "bar stool" "seat") #:sit-phrase "hop on" #:sit-phrase-third-person "hops onto" - #:sit-name "the bar stool"))) + #:sit-name "the bar stool") + + ;; TODO: Cigar dispenser + + )) + + + +;;; 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))) +(define clerk-commands* + (append clerk-commands thing-commands*)) + +(define clerk-actions + (build-actions + (init (wrap-apply clerk-act-init)) + (cmd-chat (wrap-apply clerk-cmd-chat)) + (cmd-ask-incomplete (wrap-apply clerk-cmd-ask-incomplete)) + (cmd-ask-about (wrap-apply clerk-cmd-ask)) + (update-loop (wrap-apply clerk-act-update-loop)) + (be-summoned (wrap-apply clerk-act-be-summoned)))) +(define clerk-actions* (append clerk-actions + thing-actions*)) + +(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*) + (patience #:init-value 0) + (message-handler + #:init-value + (simple-dispatcher clerk-actions*))) + +(define-mhandler (clerk-act-init clerk message) + ;; call the gameobj main init method + (gameobj-act-init clerk message) + ;; start our main loop + (<- clerk (actor-id clerk) 'update-loop)) + +(define clerk-help-topics + '(("changing name" . + "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!") + ("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."))) + + +(define clerk-knows-about + "'changing name', 'common commands', and '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-mhandler (clerk-cmd-chat clerk message) + (match (slot-ref clerk 'state) + ('on-duty + (<- clerk (message-from message) 'tell + #:text clerk-general-helpful-line)) + ('slacking + (<- clerk (message-from message) 'tell + #:text + (string-append + "The clerk says, \"" + (random-choice clerk-slacking-complaints) + "\"\n"))))) + +(define-mhandler (clerk-cmd-ask-incomplete clerk message) + (<- clerk (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-mhandler (clerk-cmd-ask clerk message indir-obj) + (match (slot-ref clerk 'state) + ('on-duty + (match (assoc (pk 'indir indir-obj) clerk-help-topics) + ((_ . info) + (<- clerk (message-from message) 'tell + #:text + (string-append "The clerk clears her throat and says:\n \"" + info + "\"\n"))) + (#f + (<- clerk (message-from message) 'tell + #:text clerk-doesnt-know-text)))) + ('slacking + (<- clerk (message-from message) 'tell + #:text "The clerk says, \"Sorry, I'm on my break.\"\n")))) + +(define-mhandler (clerk-act-be-summoned clerk message who-summoned) + (match (slot-ref clerk 'state) + ('on-duty + (<- clerk 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 + (<- clerk (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 'room:lobby)) + (slot-set! clerk 'patience 8) + (slot-set! clerk 'state 'on-duty) + (<- clerk (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-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 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")) + +(define clerk-slack-excuse-text + "The desk clerk excuses herself, claiming she has important things to +attend to.\n") + +(define clerk-return-to-slacking-text + "The desk clerk enters and slams the door behind her.\n") + +(define-mhandler (clerk-act-update-loop clerk message) + (define (tell-room text) + (<- clerk (gameobj-loc clerk) 'tell-room + #:text text)) + (define (loop return) + (define (stop-if-destructed) + (if (slot-ref clerk 'destructed) + (return #f))) + (match (slot-ref clerk 'state) + ('slacking + (tell-room (random-choice clerk-slacking-texts)) + (8sleep (+ (random 10) 10)) + (stop-if-destructed) + (loop return)) + ('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 25) 20)) + (stop-if-destructed) + (loop return)) + ;; Back to slacking + (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))) + (tell-room clerk-return-to-slacking-text) + ;; annnnnd back to slacking + (slot-set! clerk 'state 'slacking) + (8sleep (+ (random 30) 15)) + (stop-if-destructed) + (loop return)))))) + (call/ec loop)) + +(define break-room + (lol + ('room: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 'room:smoking-parlor)) + ) + ('npc:break-room:desk-clerk + '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")))) + ;;; Ennpie's Sea Lounge @@ -382,7 +705,8 @@ seat in the room, though." ;;; ---- (define game-spec - (append lobby grand-hallway smoking-parlor)) + (append lobby grand-hallway smoking-parlor + playroom break-room)) ;; TODO: Provide command line args (define (run-game . args)