Add clerk and bell
authorChristopher Allan Webber <cwebber@dustycloud.org>
Tue, 10 May 2016 01:47:25 +0000 (20:47 -0500)
committerChristopher Allan Webber <cwebber@dustycloud.org>
Tue, 10 May 2016 01:47:25 +0000 (20:47 -0500)
mudsync/command.scm
mudsync/gameobj.scm
mudsync/parser.scm
worlds/bricabrac.scm

index 23e21dac8f85fc75645cc18620e0613dba0818d9..8672d35c70e1222116925d7a06ab5f1e065b92b1 100644 (file)
             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)
                 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)
                 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)
index b686e3cbd74a4d2d41825f0f5f5777290b8357f4..9d4a91380a660c04f0106e8dd557d9f669aa871f 100644 (file)
@@ -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 (<gameobj>
@@ -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
   ;; @@: 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
          (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))
 
index bbbab135b131341a8bb72dd23d4fc517e5ec2178..034b22f3f2f04dc8f5e2bc609658241e5b9fbd43 100644 (file)
@@ -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)
index 6be5b1aab45e05c05dae66478a562fa9cd0c1bc0..b2607be19a23b0fbb009d311a8223a61cd237488 100644 (file)
@@ -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 <summoning-bell> (<thing>)
+  (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
+    <summoning-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
     <gameobj> '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 <exit>
             #:name "west"
-            #:to 'room:grand-hallway)))
+            #:to 'room:grand-hallway)
+          (make <exit>
+            #:name "south"
+            #:to 'room:break-room)))
    ('thing:smoking-room:chair
     <furniture> '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."
 
    ))
 
+\f
+
+;;; 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 <desk-clerk> (<thing>)
+  ;; 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 <your-name>', replacing
+<your-name>, 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
+    <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 <exit>
+            #:name "north"
+            #:to 'room:smoking-parlor))
+    )
+   ('npc:break-room:desk-clerk
+    <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"))))
+
+
 \f
 ;;; 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)