From: Christopher Allan Webber Date: Tue, 10 May 2016 01:47:25 +0000 (-0500) Subject: Add clerk and bell X-Git-Tag: fosdem-2017~146 X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=commitdiff_plain;h=126d9c593cc4c26082c972741ff69d3b147b7fcd Add clerk and bell --- diff --git a/mudsync/command.scm b/mudsync/command.scm index 23e21da..8672d35 100644 --- a/mudsync/command.scm +++ b/mudsync/command.scm @@ -32,10 +32,10 @@ command-priority direct-command - indir-command - indir-as-direct-command + prep-indir-command + prep-direct-command loose-direct-command - loose-indir-command + loose-prep-command empty-command direct-greedy-command greedy-command @@ -90,7 +90,7 @@ %default-priority)) -(define* (indir-command verbs action #:optional prepositions) +(define* (prep-indir-command verbs action #:optional prepositions) (make-command verbs cmatch-indir-obj (lambda* (goes-by #:key direct-obj indir-obj preposition) @@ -102,7 +102,7 @@ action %high-priority)) -(define* (indir-as-direct-command verbs action #:optional prepositions) +(define* (prep-direct-command verbs action #:optional prepositions) (make-command verbs cmatch-indir-obj (lambda* (goes-by #:key direct-obj indir-obj preposition) @@ -114,7 +114,7 @@ action %high-priority)) -(define* (loose-indir-command verbs action #:optional prepositions) +(define* (loose-prep-command verbs action #:optional prepositions) (make-command verbs cmatch-indir-obj (const #t) diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index b686e3c..9d4a913 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -24,6 +24,7 @@ #:use-module (8sync systems actors) #:use-module (8sync agenda) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (oop goops) #:export ( @@ -31,6 +32,7 @@ gameobj-loc gameobj-gm + gameobj-act-init gameobj-set-loc! gameobj-occupants gameobj-actions @@ -48,7 +50,7 @@ ;;; Actions supported by all gameobj (define gameobj-actions (build-actions - (init (wrap-apply gameobj-init)) + (init (wrap-apply gameobj-act-init)) ;; Commands for co-occupants (get-commands (wrap-apply gameobj-get-commands)) ;; Commands for participants in a room @@ -112,7 +114,11 @@ ;; @@: Would be preferable to be using generic methods for this... ;; Hopefully we can port this to Guile 2.2 soon... (visible-to-player? - #:init-value (wrap-apply gameobj-visible-to-player?))) + #:init-value (wrap-apply gameobj-visible-to-player?)) + + ;; Set this on self-destruct + ;; (checked by some "long running" game routines) + (destructed #:init-value #f)) ;;; gameobj message handlers @@ -149,9 +155,9 @@ (replace-step actor replace-reply)) replace-steps)))) -;; @@: This could be kind of a messy way of doing gameobj-init +;; @@: This could be kind of a messy way of doing gameobj-act-init ;; stuff. If only we had generic methods :( -(define-mhandler (gameobj-init actor message) +(define-mhandler (gameobj-act-init actor message) "Your most basic game object init procedure. Assists in its replacement of occupants if necessary and nothing else." (run-replacement actor message gameobj-replace-steps*)) @@ -315,6 +321,7 @@ By default, this is whether or not the generally-visible flag is set." "General gameobj self destruction routine" ;; Unregister from being in any particular room (gameobj-set-loc! gameobj #f) + (slot-set! gameobj 'destructed #t) ;; Boom! (self-destruct gameobj)) diff --git a/mudsync/parser.scm b/mudsync/parser.scm index bbbab13..034b22f 100644 --- a/mudsync/parser.scm +++ b/mudsync/parser.scm @@ -66,7 +66,7 @@ (define indirect-irx (sre->irregex - `(: (? (: ,preposition (+ space))) ; possibly a preposition (ignored) + `(: (? (: ,preposition (+ space))) ; possibly a preposition (? (: ,article (+ space))) ; possibly an article (ignored) (=> direct-obj (* any)) ; direct object (kept) (+ space) diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index 6be5b1a..b2607be 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)) @@ -133,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 @@ -174,6 +176,45 @@ 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 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)) + + (define lobby (lol ('room:lobby @@ -228,6 +269,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 @@ -365,12 +415,15 @@ if this room is intended for children or child-like adults." 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" @@ -393,7 +446,7 @@ 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") @@ -402,6 +455,235 @@ 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))) +(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) + (match (slot-ref clerk 'state) + ('on-duty + (<- clerk (message-from message) '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 ;;; ------------------- @@ -416,7 +698,7 @@ seat in the room, though." (define game-spec (append lobby grand-hallway smoking-parlor - playroom)) + playroom break-room)) ;; TODO: Provide command line args (define (run-game . args)