X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=3ce948d4b7fe568b097f9e0a3a18d4612eedbdf0;hp=fe158ff352d14f3b88831618adcd584b7ae83278;hb=80b100aa206cc865238f055d8c2b809586566064;hpb=7eb469aad2ae78746d6b5c9f9b4995d99a40ee48

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index fe158ff..3ce948d 100644
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -20,7 +20,7 @@
 
 (use-modules (mudsync)
              (mudsync parser)
-             (8sync systems actors)
+             (8sync actors)
              (8sync agenda)
              (oop goops)
              (ice-9 control)
@@ -54,25 +54,17 @@
   (append readable-commands
           thing-commands))
 
-(define readable-actions
-  (build-actions
-   (cmd-read (wrap-apply readable-cmd-read))))
-
-(define readable-actions*
-  (append readable-actions
-          thing-actions*))
-
 (define-class <readable> (<thing>)
   (read-text #:init-value "All it says is: \"Blah blah blah.\""
              #:init-keyword #:read-text)
   (commands
    #:init-value readable-commands*)
-  (message-handler
-   #:init-value
-   (simple-dispatcher readable-actions*)))
+  (actions #:allocation #:each-subclass
+           #:init-value (build-actions
+                         (cmd-read readable-cmd-read))))
 
 (define (readable-cmd-read actor message)
-  (<- actor (message-from message) 'tell
+  (<- (message-from message) 'tell
       #:text (string-append (slot-ref actor 'read-text) "\n")))
 
 
@@ -80,21 +72,18 @@
 ;;; Lobby
 ;;; -----
 
-(define-mhandler (npc-chat-randomly actor message)
+(define (npc-chat-randomly actor message . _)
   (define text-to-send
     (format #f "~a says: \"~a\"\n"
             (slot-ref actor 'name)
             (random-choice (slot-ref actor 'catchphrases))))
-  (<- actor (message-from message) 'tell
+  (<- (message-from message) 'tell
       #:text text-to-send))
 
 (define chat-commands
   (list
    (direct-command "chat" 'cmd-chat)
    (direct-command "talk" 'cmd-chat)))
-(define chat-actions
-  (build-actions
-   (cmd-chat (wrap-apply npc-chat-randomly))))
 
 (define hotel-owner-grumps
   '("Eight sinks!  Eight sinks!  And I couldn't unwind them..."
@@ -117,9 +106,10 @@ or 'skribe'?  Now *that's* composition!"))
                 #:init-keyword #:catchphrases)
   (commands
    #:init-value chat-commands)
-  (message-handler
-   #:init-value
-   (simple-dispatcher (append gameobj-actions chat-actions))))
+  (actions #:allocation #:each-subclass
+           #:init-value
+           (build-actions
+            (cmd-chat npc-chat-randomly))))
 
 (define random-bricabrac
   '("a creepy porcelain doll"
@@ -136,14 +126,10 @@ or 'skribe'?  Now *that's* composition!"))
    #:init-value
    (list
     (prep-direct-command "sign" 'cmd-sign-form
-                             '("as"))))
-  (message-handler
-   #:init-value
-   (simple-dispatcher
-    (append
-     (build-actions
-      (cmd-sign-form (wrap-apply sign-cmd-sign-in)))
-     gameobj-actions))))
+                         '("as"))))
+  (actions #:allocation #:each-subclass
+           #:init-value (build-actions
+                         (cmd-sign-form sign-cmd-sign-in))))
 
 
 (define name-sre
@@ -157,20 +143,18 @@ or 'skribe'?  Now *that's* composition!"))
   (and (irregex-match name-sre name)
        (not (member name forbidden-words))))
 
-(define-mhandler (sign-cmd-sign-in actor message direct-obj indir-obj)
+(define* (sign-cmd-sign-in actor message
+                           #:key direct-obj indir-obj preposition)
   (define old-name
-    (message-ref
-     (<-wait actor (message-from message) 'get-name)
-     'val))
+    (mbody-val (<-wait (message-from message) 'get-name)))
   (define name indir-obj)
   (if (valid-name? indir-obj)
       (begin
-        (<-wait actor (message-from message) 'set-name!
-                #:val name)
-        (<- actor (slot-ref actor 'loc) 'tell-room
+        (<-wait (message-from message) 'set-name! name)
+        (<- (slot-ref actor 'loc) 'tell-room
             #: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
+      (<- (message-from message) 'tell
           #:text "Sorry, that's not a valid name.
 Alphanumerics, _ and - only, 2-15 characters, starts with an alphabetic
 character.\n")))
@@ -183,39 +167,54 @@ character.\n")))
   (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)
+  (actions #:allocation #:each-subclass
+           #:init-value (build-actions
+                         (cmd-ring summoning-bell-cmd-ring))))
+
+(define* (summoning-bell-cmd-ring bell message . _)
+  ;; Call back to actor who invoked this message handler
+  ;; and find out their name.  We'll call *their* get-name message
+  ;; handler... meanwhile, this procedure suspends until we get
+  ;; their response.
   (define who-rang
-    (message-ref
-     (<-wait bell (message-from message) 'get-name)
-     'val))
-  (<- bell (message-from message) 'tell
+    (mbody-val (<-wait (message-from message) 'get-name)))
+
+  ;; Now we'll invoke the "tell" message handler on the player
+  ;; who rang us, displaying this text on their screen.
+  ;; This one just uses <- instead of <-wait, since we don't
+  ;; care when it's delivered; we're not following up on it.
+  (<- (message-from message) 'tell
       #:text "*ring ring!*  You ring the bell!\n")
-  (<- bell (gameobj-loc bell) 'tell-room
+  ;; We also want everyone else in the room to "hear" the bell,
+  ;; but they get a different message since they aren't the ones
+  ;; ringing it.  Notice here's where we make use of the invoker's
+  ;; name as extracted and assigned to the who-rang variable.
+  ;; Notice how we send this message to our "location", which
+  ;; forwards it to the rest of the occupants in the room.
+  (<- (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
+  ;; Now we perform the primary task of the bell, which is to summon
+  ;; the "clerk" character to the room.  (This is configurable,
+  ;; so we dynamically look up their address.)
+  (<- (dyn-ref bell (slot-ref bell 'summons)) 'be-summoned
       #:who-summoned (message-from message)))
 
 
+(define prefect-quotes
+  '("I'm a frood who really knows where my towel is!"
+    "On no account allow a Vogon to read poetry at you."
+    "Time is an illusion, lunchtime doubly so!"
+    "How can you have money if none of you produces anything?"
+    "On no account allow Arthur to request tea on this ship."))
+
 (define lobby
   (lol
    ('room:lobby
@@ -224,7 +223,7 @@ character.\n")))
     #:desc
     "  You're in some sort of hotel lobby.  You see a large sign hanging
 over the desk that says \"Hotel Bricabrac\".  On the desk is a bell
-that says \"ring for service\".  Terrible music plays from a speaker
+that says \"'ring bell' for service\".  Terrible music plays from a speaker
 somewhere overhead.
   The room is lined with various curio cabinets, filled with all sorts
 of kitschy junk.  It looks like whoever decorated this place had great
@@ -251,10 +250,6 @@ though the conversation may be a bit one sided."
                 "Chris Webber"  ; heh, did you rtfc?  or was it so obvious?
                 "hotel proprietor" "proprietor")
     #:catchphrases hotel-owner-grumps)
-   ;; NPC: desk clerk (comes when you ring the s)
-   ;;   impatient teenager, only stays around for a few minutes
-   ;;   complaining, then leaves.
-   
    ;; Object: Sign
    ('thing:lobby:sign
     <readable> 'room:lobby
@@ -361,7 +356,7 @@ if this room is intended for children or child-like adults."
    ('thing:cuddles-plushie
     <thing> 'room:playroom
     #:name "a cuddles plushie"
-    #:goes-by '("plushie" "cuddles plushie")
+    #:goes-by '("plushie" "cuddles plushie" "cuddles")
     #:takeable #t
     #:desc "  A warm and fuzzy cuddles plushie!  It's a cuddlefish!")))
 
@@ -389,24 +384,18 @@ if this room is intended for children or child-like adults."
    #:init-value
    (list
     (direct-command "sit" 'cmd-sit-furniture)))
-  (message-handler
-   #:init-value
-   (simple-dispatcher
-    (append
-     (build-actions
-      (cmd-sit-furniture (wrap-apply furniture-cmd-sit)))
-     gameobj-actions))))
+  (actions #:allocation #:each-subclass
+           #:init-value (build-actions
+                         (cmd-sit-furniture furniture-cmd-sit))))
 
-(define-mhandler (furniture-cmd-sit actor message direct-obj)
+(define* (furniture-cmd-sit actor message #:key direct-obj)
   (define player-name
-    (message-ref
-     (<-wait actor (message-from message) 'get-name)
-     'val))
-  (<- actor (message-from message) 'tell
+    (mbody-val (<-wait (message-from message) 'get-name)))
+  (<- (message-from message) 'tell
       #:text (format #f "You ~a ~a.\n"
                      (slot-ref actor 'sit-phrase)
                      (slot-ref actor 'sit-name)))
-  (<- actor (slot-ref actor 'loc) 'tell-room
+  (<- (slot-ref actor 'loc) 'tell-room
       #:text (format #f "~a ~a on ~a.\n"
                      player-name
                      (slot-ref actor 'sit-phrase-third-person)
@@ -458,6 +447,13 @@ seat in the room, though."
     #:sit-phrase "hop on"
     #:sit-phrase-third-person "hops onto"
     #:sit-name "the bar stool")
+   ('npc:ford-prefect
+    <chatty-npc> 'room:smoking-parlor
+    #:name "Ford Prefect"
+    #:desc "Just some guy, you know?"
+    #:goes-by '("Ford Prefect" "ford prefect"
+                "frood" "prefect" "ford")
+    #:catchphrases prefect-quotes)
 
    ;; TODO: Cigar dispenser
 
@@ -473,21 +469,11 @@ seat in the room, though."
    (direct-command "talk" 'cmd-chat)
    (direct-command "chat" 'cmd-chat)
    (direct-command "ask" 'cmd-ask-incomplete)
-   (prep-direct-command "ask" 'cmd-ask-about)))
+   (prep-direct-command "ask" 'cmd-ask-about)
+   (direct-command "dismiss" 'cmd-dismiss)))
 (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
@@ -497,15 +483,21 @@ seat in the room, though."
   (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)
+  (actions #:allocation #:each-subclass
+           #:init-value (build-actions
+                         (init clerk-act-init)
+                         (cmd-chat clerk-cmd-chat)
+                         (cmd-ask-incomplete clerk-cmd-ask-incomplete)
+                         (cmd-ask-about clerk-cmd-ask)
+                         (cmd-dismiss clerk-cmd-dismiss)
+                         (update-loop clerk-act-update-loop)
+                         (be-summoned clerk-act-be-summoned))))
+
+(define (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))
+  (<- (actor-id clerk) 'update-loop))
 
 (define clerk-help-topics
   '(("changing name" .
@@ -526,7 +518,7 @@ feel free to walk around and explore.")))
 
 
 (define clerk-knows-about
-  "'changing name', 'common commands', and 'about the hotel'")
+  "'ask clerk about changing name', 'ask clerk about common commands', and 'ask clerk about the hotel'")
 
 (define clerk-general-helpful-line
   (string-append
@@ -543,59 +535,60 @@ For example, 'ask clerk about changing name'. You can ask me about the following
 energy particle physicist.  But ya gotta pay the bills, especially
 with tuition at where it is..."))
 
-(define-mhandler (clerk-cmd-chat clerk message)
+(define* (clerk-cmd-chat clerk message #:key direct-obj)
   (match (slot-ref clerk 'state)
     ('on-duty
-     (<- clerk (message-from message) 'tell
+     (<- (message-from message) 'tell
          #:text clerk-general-helpful-line))
     ('slacking
-     (<- clerk (message-from message) 'tell
+     (<- (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
+(define (clerk-cmd-ask-incomplete clerk message . _)
+  (<- (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)
+(define* (clerk-cmd-ask clerk message #:key indir-obj
+                        #:allow-other-keys)
   (match (slot-ref clerk 'state)
     ('on-duty
      (match (assoc (pk 'indir indir-obj) clerk-help-topics)
        ((_ . info)
-           (<- clerk (message-from message) 'tell
+           (<- (message-from message) 'tell
                #:text
                (string-append "The clerk clears her throat and says:\n  \""
                               info
                               "\"\n")))
        (#f
-        (<- clerk (message-from message) 'tell
+        (<- (message-from message) 'tell
             #:text clerk-doesnt-know-text))))
     ('slacking
-     (<- clerk (message-from message) 'tell
+     (<- (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)
+(define* (clerk-act-be-summoned clerk message #:key who-summoned)
   (match (slot-ref clerk 'state)
     ('on-duty
-     (<- clerk who-summoned 'tell
+     (<- 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
+     (<- (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
+     (<- (gameobj-loc clerk) 'tell-room
          #:text
          (string-append
           "  Suddenly, a uniformed woman rushes into the room!  She's wearing a
@@ -606,6 +599,26 @@ 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-cmd-dismiss clerk message . _)
+  (define player-name
+    (mbody-val (<-wait (message-from message) 'get-name)))
+  (match (slot-ref clerk 'state)
+    ('on-duty
+     (<- (gameobj-loc clerk) 'tell-room
+         #:text
+         (format #f "\"Thanks ~a!\" says the clerk. \"I have somewhere I need to be.\"
+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))
+     (slot-set! clerk 'state 'slacking)
+     (<- (gameobj-loc clerk) 'tell-room
+         #:text clerk-return-to-slacking-text
+         #:exclude (actor-id clerk)))
+    ('slacking
+     (<- (message-from message) 'tell
+         #:text "The clerk sternly asks you to not be so dismissive.\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"
@@ -622,7 +635,9 @@ You can ask me about the following:
     "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 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"))
 
 (define clerk-slack-excuse-text
   "The desk clerk excuses herself, claiming she has important things to
@@ -631,42 +646,48 @@ 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 (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))
+    (<- (gameobj-loc clerk) 'tell-room
+        #:text text
+        #:exclude (actor-id clerk)))
+  (define (loop-if-not-destructed)
+    (if (not (slot-ref clerk 'destructed))
+        ;; This iterates by "recursing" on itself by calling itself
+        ;; (as the message handler) again.  It used to be that we had to do
+        ;; this, because there was a bug where a loop which yielded like this
+        ;; would keep growing the stack due to some parameter goofiness.
+        ;; That's no longer true, but there's an added advantage to this
+        ;; route: it's much more live hackable.  If we change the definition
+        ;; of this method, the character will act differently on the next
+        ;; "tick" of the loop.
+        (<- (actor-id clerk) 'update-loop)))
+  (match (slot-ref clerk 'state)
+    ('slacking
+     (tell-room (random-choice clerk-slacking-texts))
+     (8sleep (+ (random 10) 10))
+     (loop-if-not-destructed))
+    ('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))
+           (loop-if-not-destructed))
+         ;; 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))
+           (loop-if-not-destructed))))))
+
 
 (define break-room
   (lol