X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=ba0b75fe008bb90e208299ff3aafd23a02414575;hp=84836fa7690ab0c19d81eeca9105f70ed3b1716d;hb=ed1ef3172af4c2621e2b746824b7defa6f0dcedd;hpb=e585ab65215e84cb5fa12fd84ffeee0421e56d07

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index 84836fa..ba0b75f 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")))
 
 
@@ -85,16 +77,13 @@
     (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
@@ -160,15 +146,15 @@ or 'skribe'?  Now *that's* composition!"))
 (define* (sign-cmd-sign-in actor message
                            #:key direct-obj indir-obj preposition)
   (define old-name
-    (msg-val (<-wait actor (message-from message) 'get-name)))
+    (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! 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")))
@@ -181,21 +167,14 @@ 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*)))
+  (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
@@ -203,13 +182,13 @@ character.\n")))
   ;; handler... meanwhile, this procedure suspends until we get
   ;; their response.
   (define who-rang
-    (msg-val (<-wait bell (message-from message) 'get-name)))
+    (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.
-  (<- bell (message-from message) 'tell
+  (<- (message-from message) 'tell
       #:text "*ring ring!*  You ring the bell!\n")
   ;; We also want everyone else in the room to "hear" the bell,
   ;; but they get a different message since they aren't the ones
@@ -217,7 +196,7 @@ character.\n")))
   ;; 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.
-  (<- bell (gameobj-loc bell) 'tell-room
+  (<- (gameobj-loc bell) 'tell-room
       #:text
       (format #f "*ring ring!*  ~a rings the bell!\n"
               who-rang)
@@ -225,7 +204,7 @@ character.\n")))
   ;; 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.)
-  (<- bell (dyn-ref bell (slot-ref bell 'summons)) 'be-summoned
+  (<- (dyn-ref bell (slot-ref bell 'summons)) 'be-summoned
       #:who-summoned (message-from message)))
 
 
@@ -405,22 +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* (furniture-cmd-sit actor message #:key direct-obj)
   (define player-name
-    (msg-val (<-wait actor (message-from message) 'get-name)))
-  (<- 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)
@@ -499,18 +474,6 @@ seat in the room, though."
 (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))
-   (cmd-dismiss (wrap-apply clerk-cmd-dismiss))
-   (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
@@ -520,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*)))
+  (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" .
@@ -569,10 +538,10 @@ with tuition at where it is..."))
 (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, \""
@@ -580,45 +549,46 @@ with tuition at where it is..."))
           "\"\n")))))
 
 (define (clerk-cmd-ask-incomplete clerk message)
-  (<- clerk (message-from message) 'tell
+  (<- (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 (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* (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
@@ -631,10 +601,10 @@ You can ask me about the following:
 
 (define* (clerk-cmd-dismiss clerk message . _)
   (define player-name
-    (msg-val (<-wait clerk (message-from message) 'get-name)))
+    (mbody-val (<-wait (message-from message) 'get-name)))
   (match (slot-ref clerk 'state)
     ('on-duty
-     (<- clerk (gameobj-loc clerk) 'tell-room
+     (<- (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"
@@ -642,11 +612,11 @@ The clerk leaves the room in a hurry.\n"
          #:exclude (actor-id clerk))
      (gameobj-set-loc! clerk (dyn-ref clerk 'room:break-room))
      (slot-set! clerk 'state 'slacking)
-     (<- clerk (gameobj-loc clerk) 'tell-room
+     (<- (gameobj-loc clerk) 'tell-room
          #:text clerk-return-to-slacking-text
          #:exclude (actor-id clerk)))
     ('slacking
-     (<- clerk (message-from message) 'tell
+     (<- (message-from message) 'tell
          #:text "The clerk sternly asks you to not be so dismissive.\n"))))
 
 (define clerk-slacking-texts
@@ -677,7 +647,7 @@ attend to.\n")
 
 (define (clerk-act-update-loop clerk message)
   (define (tell-room text)
-    (<- clerk (gameobj-loc clerk) 'tell-room
+    (<- (gameobj-loc clerk) 'tell-room
         #:text text
         #:exclude (actor-id clerk)))
   (define (loop-if-not-destructed)
@@ -690,7 +660,7 @@ attend to.\n")
         ;; 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.
-        (<- clerk (actor-id clerk) 'update-loop)))
+        (<- (actor-id clerk) 'update-loop)))
   (match (slot-ref clerk 'state)
     ('slacking
      (tell-room (random-choice clerk-slacking-texts))