X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=a3ebc65908212063e2d60b9a21d8f7afe30d60c6;hp=2ebced12060491561486f37fce574bb60caa452e;hb=ca990b14f563fc450548954184ff6fc0e4792739;hpb=e585ab65215e84cb5fa12fd84ffeee0421e56d07

diff --git a/mudsync/room.scm b/mudsync/room.scm
index 2ebced1..a3ebc65 100644
--- a/mudsync/room.scm
+++ b/mudsync/room.scm
@@ -24,11 +24,7 @@
   #:use-module (oop goops)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 control)
-  #:export (<room>
-            room-actions
-            room-actions*
-
-            <exit>))
+  #:export (<room> <exit>))
 
 
 ;;; Exits
@@ -72,26 +68,6 @@
    (greedy-command "say" 'cmd-say)
    (greedy-command "emote" 'cmd-emote)))
 
-(define room-actions
-  (build-actions
-   (cmd-go (wrap-apply room-cmd-go))
-   (cmd-go-where (wrap-apply room-cmd-go-where))
-   (announce-entrance (wrap-apply room-announce-entrance))
-   (look-room (wrap-apply room-look-room))
-   (tell-room (wrap-apply room-act-tell-room))
-   ;; in this case the command is the same version as the normal
-   ;; look-room version
-   (cmd-look-room (wrap-apply room-look-room))
-   (cmd-look-at (wrap-apply room-look-at))
-   (cmd-say (wrap-apply room-cmd-say))
-   (cmd-emote (wrap-apply room-cmd-emote))))
-
-(define room-actions*
-  (append room-actions gameobj-actions))
-
-(define room-action-dispatch
-  (simple-dispatcher room-actions*))
-
 ;; TODO: Subclass from container?
 (define-class <room> (<gameobj>)
   ;; A list of <exit>
@@ -102,10 +78,20 @@
   (container-commands
    #:init-value (wrap %room-contain-commands))
 
-  (message-handler
-   #:allocation #:each-subclass
-   ;; @@: Can remove this indirection once things settle
-   #:init-value (wrap-apply room-action-dispatch)))
+  (actions #:allocation #:each-subclass
+           #:init-value
+           (mhandlers
+            (cmd-go room-cmd-go)
+            (cmd-go-where room-cmd-go-where)
+            (announce-entrance room-announce-entrance)
+            (look-room room-look-room)
+            (tell-room room-act-tell-room)
+            ;; in this case the command is the same version as the normal
+            ;; look-room version
+            (cmd-look-room room-look-room)
+            (cmd-look-at room-look-at)
+            (cmd-say room-cmd-say)
+            (cmd-emote room-cmd-emote))))
 
 (define* (room-cmd-go room message #:key direct-obj)
   (define exit