Update mudsync code to use easier to use action inheritance system

[mudsync.git] / worlds / bricabrac.scm

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index 84836fa7690ab0c19d81eeca9105f70ed3b1716d..e5392aaa428222699a8012e7046e48c76545d20a 100644 (file)
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -54,22 +54,14 @@
   (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 (mhandlers
+                         (cmd-read readable-cmd-read))))
 
 (define (readable-cmd-read actor message)
   (<- actor (message-from message) 'tell
@@ -92,9 +84,6 @@
   (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
+           (mhandlers
+            (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 (mhandlers
+                         (cmd-sign-form sign-cmd-sign-in))))
 
 
 (define name-sre
@@ -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 (mhandlers
+                         (cmd-ring summoning-bell-cmd-ring))))
 
 (define* (summoning-bell-cmd-ring bell message . _)
   ;; Call back to actor who invoked this message handler
@@ -405,13 +384,9 @@ 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 (mhandlers
+                         (cmd-sit-furniture furniture-cmd-sit))))
 
 (define* (furniture-cmd-sit actor message #:key direct-obj)
   (define player-name
@@ -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,9 +483,15 @@ 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 (mhandlers
+                         (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