Port to the remove-define-mhandler 8sync branch

diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm
index 8bc239bdb9bebedf6eebbe047879f8e495b218ab..0a53389aef6865e24ae7ee5624e281022e03bed5 100644 (file)
--- a/mudsync/game-master.scm
+++ b/mudsync/game-master.scm
@@ -63,12 +63,12 @@
 
 ;;; .. begin world init stuff ..
 
 
 ;;; .. begin world init stuff ..
 

-(define (gm-init-world gm message)
+(define* (gm-init-world gm message #:key game-spec)

   ;; Load database
   ;;  TODO
 
   ;; Init basic rooms / structure
   ;; Load database
   ;;  TODO
 
   ;; Init basic rooms / structure

-  (gm-init-game-spec gm (message-ref message 'game-spec))
+  (gm-init-game-spec gm game-spec)

 
   ;; Restore database-based actors
   ;;  TODO
 
   ;; Restore database-based actors
   ;;  TODO


@@ -131,36 +131,35 @@
 
 ;;; .. end world init stuff ...
 
 
 ;;; .. end world init stuff ...
 

-(define-mhandler (gm-new-client actor message client)
+(define* (gm-new-client actor message #:key client)

   ;; @@: Maybe more indirection than needed for this
   ((gm-new-conn-handler actor) actor client))
 
 
   ;; @@: Maybe more indirection than needed for this
   ((gm-new-conn-handler actor) actor client))
 
 

-(define (gm-handle-client-input actor message)
+(define* (gm-handle-client-input actor message
+                                 #:key client data)

   "Handle input from a client."
   "Handle input from a client."

-  (define client-id (message-ref message 'client))
-  (define input (message-ref message 'data))

   ;; Look up player
   ;; Look up player

-  (define player (hash-ref (gm-client-dir actor) client-id))
+  (define player (hash-ref (gm-client-dir actor) client))

 
   ;; debugging
 
   ;; debugging

-  (format #t "DEBUG: From ~s: ~s\n" client-id input)
+  (format #t "DEBUG: From ~s: ~s\n" client data)

 
   (<- actor player 'handle-input
 
   (<- actor player 'handle-input

-      #:input input))
+      #:input data))

 
 

-(define-mhandler (gm-lookup-special actor message symbol)
+(define* (gm-lookup-special actor message #:key symbol)

   (<-reply actor message
            #:val (hash-ref (slot-ref actor 'special-dir) symbol)))
 
   (<-reply actor message
            #:val (hash-ref (slot-ref actor 'special-dir) symbol)))
 

-(define-mhandler (gm-write-home actor message text)
+(define* (gm-write-home actor message #:key text)

   (define client-id (hash-ref (gm-reverse-client-dir actor)
                               (message-from message)))
   (<- actor (gm-network-manager actor) 'send-to-client
       #:client client-id
       #:data text))
 
   (define client-id (hash-ref (gm-reverse-client-dir actor)
                               (message-from message)))
   (<- actor (gm-network-manager actor) 'send-to-client
       #:client client-id
       #:data text))
 

-(define-mhandler (gm-client-closed gm message client)
+(define* (gm-client-closed gm message #:key client)

   ;; Do we have this client registered to an actor?  Get the id if so.
   (define actor-id (hash-ref (gm-client-dir gm) client))
 
   ;; Do we have this client registered to an actor?  Get the id if so.
   (define actor-id (hash-ref (gm-client-dir gm) client))
 


@@ -173,8 +172,8 @@
     (gm-unregister-client! gm client)))
 
 
     (gm-unregister-client! gm client)))
 
 

-(define-mhandler (gm-inject-special! gm message
-                                     special-symbol gameobj-spec)
+(define* (gm-inject-special! gm message
+                             #:key special-symbol gameobj-spec)

   "Inject, possiibly replacing the original, special symbol
 using the gameobj-spec."
   (define existing-obj
   "Inject, possiibly replacing the original, special symbol
 using the gameobj-spec."
   (define existing-obj

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 334f4397593054d71c744ee062e40c850909be34..8b1040fbcaee86df2aab20369c0ecd6db7486f79 100644 (file)
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -128,11 +128,9 @@
 (define (simple-slot-getter slot)
   (lambda (actor message)
     (<-reply actor message
 (define (simple-slot-getter slot)
   (lambda (actor message)
     (<-reply actor message

-             #:val (slot-ref actor slot))))
+                   #:val (slot-ref actor slot))))

 
 

-(define (gameobj-replace-step-occupants actor replace-reply)
-  (define occupants
-    (message-ref replace-reply 'occupants #f))
+(define (gameobj-replace-step-occupants actor occupants)

   ;; Snarf all the occupants!
   (display "replacing occupant\n")
   (when occupants
   ;; Snarf all the occupants!
   (display "replacing occupant\n")
   (when occupants


@@ -145,22 +143,21 @@
 (define gameobj-replace-steps*
   (list gameobj-replace-step-occupants))
 
 (define gameobj-replace-steps*
   (list gameobj-replace-step-occupants))
 

-(define (run-replacement actor message replace-steps)
-  (define replaces (message-ref message 'replace #f))
+(define (run-replacement actor replaces replace-steps)

   (when replaces
   (when replaces

-    (let ((replace-reply
-           (<-wait actor replaces 'assist-replace)))
+    (msg-receive (_ #:key occupants)
+        (<-wait actor replaces 'assist-replace)

       (for-each
        (lambda (replace-step)
       (for-each
        (lambda (replace-step)

-         (replace-step actor replace-reply))
+         (replace-step actor occupants))

        replace-steps))))
 
 ;; @@: This could be kind of a messy way of doing gameobj-act-init
 ;;   stuff.  If only we had generic methods :(
        replace-steps))))
 
 ;; @@: This could be kind of a messy way of doing gameobj-act-init
 ;;   stuff.  If only we had generic methods :(

-(define-mhandler (gameobj-act-init actor message)
+(define* (gameobj-act-init actor message #:key replace)

   "Your most basic game object init procedure.
 Assists in its replacement of occupants if necessary and nothing else."
   "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*))
+  (run-replacement actor replace gameobj-replace-steps*))

 
 (define (gameobj-goes-by gameobj)
   "Find the name we go by.  Defaults to #:name if nothing else provided."
 
 (define (gameobj-goes-by gameobj)
   "Find the name we go by.  Defaults to #:name if nothing else provided."


@@ -189,7 +186,7 @@ Assists in its replacement of occupants if necessary and nothing else."
              verb))
    commands))
 
              verb))
    commands))
 

-(define-mhandler (gameobj-get-commands actor message verb)
+(define* (gameobj-get-commands actor message #:key verb)

   "Get commands a co-occupant of the room might execute for VERB"
   (define filtered-commands
     (filter-commands (val-or-run (slot-ref actor 'commands))
   "Get commands a co-occupant of the room might execute for VERB"
   (define filtered-commands
     (filter-commands (val-or-run (slot-ref actor 'commands))


@@ -198,14 +195,14 @@ Assists in its replacement of occupants if necessary and nothing else."
            #:commands filtered-commands
            #:goes-by (gameobj-goes-by actor)))
 
            #:commands filtered-commands
            #:goes-by (gameobj-goes-by actor)))
 

-(define-mhandler (gameobj-get-container-commands actor message verb)
+(define* (gameobj-get-container-commands actor message #:key verb)

   "Get commands as the container / room of message's sender"
   (define filtered-commands
     (filter-commands (val-or-run (slot-ref actor 'container-commands))
                      verb))
   (<-reply actor message #:commands filtered-commands))
 
   "Get commands as the container / room of message's sender"
   (define filtered-commands
     (filter-commands (val-or-run (slot-ref actor 'container-commands))
                      verb))
   (<-reply actor message #:commands filtered-commands))
 

-(define-mhandler (gameobj-get-contained-commands actor message verb)
+(define* (gameobj-get-contained-commands actor message #:key verb)

   "Get commands as being contained (eg inventory) of commanding gameobj"
   (define filtered-commands
     (filter-commands (val-or-run (slot-ref actor 'contained-commands))
   "Get commands as being contained (eg inventory) of commanding gameobj"
   (define filtered-commands
     (filter-commands (val-or-run (slot-ref actor 'contained-commands))


@@ -214,12 +211,12 @@ Assists in its replacement of occupants if necessary and nothing else."
            #:commands filtered-commands
            #:goes-by (gameobj-goes-by actor)))
 
            #:commands filtered-commands
            #:goes-by (gameobj-goes-by actor)))
 

-(define-mhandler (gameobj-add-occupant! actor message who)
+(define* (gameobj-add-occupant! actor message #:key who)

   "Add an actor to our list of present occupants"
   (hash-set! (slot-ref actor 'occupants)
              who #t))
 
   "Add an actor to our list of present occupants"
   (hash-set! (slot-ref actor 'occupants)
              who #t))
 

-(define-mhandler (gameobj-remove-occupant! actor message who)
+(define* (gameobj-remove-occupant! actor message #:key who)

   "Remove an occupant from the room."
   (hash-remove! (slot-ref actor 'occupants) who))
 
   "Remove an occupant from the room."
   (hash-remove! (slot-ref actor 'occupants) who))
 


@@ -243,16 +240,15 @@ Assists in its replacement of occupants if necessary and nothing else."
    '()
    (slot-ref gameobj 'occupants)))
 
    '()
    (slot-ref gameobj 'occupants)))
 

-(define-mhandler (gameobj-get-occupants actor message)
+(define* (gameobj-get-occupants actor message #:key exclude)

   "Get all present occupants of the room."
   "Get all present occupants of the room."

-  (define exclude (message-ref message 'exclude #f))

   (define occupants
     (gameobj-occupants actor #:exclude exclude))
 
   (<-reply actor message
            #:occupants occupants))
 
   (define occupants
     (gameobj-occupants actor #:exclude exclude))
 
   (<-reply actor message
            #:occupants occupants))
 

-(define-mhandler (gameobj-act-get-loc actor message)
+(define (gameobj-act-get-loc actor message)

   (<-reply actor message
            #:val (slot-ref actor 'loc)))
 
   (<-reply actor message
            #:val (slot-ref actor 'loc)))
 


@@ -271,7 +267,7 @@ Assists in its replacement of occupants if necessary and nothing else."
         (<-wait gameobj loc 'add-occupant! #:who (actor-id gameobj)))))
 
 ;; @@: Should it really be #:id ?  Maybe #:loc-id or #:loc?
         (<-wait gameobj loc 'add-occupant! #:who (actor-id gameobj)))))
 
 ;; @@: Should it really be #:id ?  Maybe #:loc-id or #:loc?

-(define-mhandler (gameobj-act-set-loc! actor message loc)
+(define* (gameobj-act-set-loc! actor message #:key loc)

   "Action routine to set the location."
   (gameobj-set-loc! actor loc))
 
   "Action routine to set the location."
   (gameobj-set-loc! actor loc))
 


@@ -285,10 +281,10 @@ and whos-asking, and see if we should just return it or run it."
 
 (define gameobj-get-name (simple-slot-getter 'name))
 
 
 (define gameobj-get-name (simple-slot-getter 'name))
 

-(define-mhandler (gameobj-act-set-name! actor message val)
+(define* (gameobj-act-set-name! actor message #:key val)

   (slot-set! actor 'name val))
 
   (slot-set! actor 'name val))
 

-(define-mhandler (gameobj-get-desc actor message whos-looking)
+(define* (gameobj-get-desc actor message #:key whos-looking)

   (define desc-text
     (match (slot-ref actor 'desc)
       ((? procedure? desc-proc)
   (define desc-text
     (match (slot-ref actor 'desc)
       ((? procedure? desc-proc)


@@ -301,7 +297,7 @@ and whos-asking, and see if we should just return it or run it."
 By default, this is whether or not the generally-visible flag is set."
   (slot-ref gameobj 'generally-visible))
 
 By default, this is whether or not the generally-visible flag is set."
   (slot-ref gameobj 'generally-visible))
 

-(define-mhandler (gameobj-visible-name actor message whos-looking)
+(define* (gameobj-visible-name actor message #:key whos-looking)

   ;; Are we visible?
   (define we-are-visible
     ((slot-ref actor 'visible-to-player?) actor whos-looking))
   ;; Are we visible?
   (define we-are-visible
     ((slot-ref actor 'visible-to-player?) actor whos-looking))


@@ -326,7 +322,7 @@ By default, this is whether or not the generally-visible flag is set."
   ;; Boom!
   (self-destruct gameobj))
 
   ;; Boom!
   (self-destruct gameobj))
 

-(define-mhandler (gameobj-act-self-destruct gameobj message)
+(define (gameobj-act-self-destruct gameobj message)

   "Action routine for self destruction"
   (gameobj-self-destruct gameobj))
 
   "Action routine for self destruction"
   (gameobj-self-destruct gameobj))
 


@@ -360,10 +356,10 @@ By default, this is whether or not the generally-visible flag is set."
   (match special-symbol
     ;; if it's a symbol, look it up dynamically
     ((? symbol? _)
   (match special-symbol
     ;; if it's a symbol, look it up dynamically
     ((? symbol? _)

-     (message-ref
-      (<-wait gameobj (slot-ref gameobj 'gm) 'lookup-special
-              #:symbol special-symbol)
-      'val))
+     (msg-receive (_ #:key val)
+         (<-wait gameobj (slot-ref gameobj 'gm) 'lookup-special
+                 #:symbol special-symbol)
+       val))

     ;; if it's false, return nothing
     (#f #f)
     ;; otherwise it's probably an address, return it as-is
     ;; if it's false, return nothing
     (#f #f)
     ;; otherwise it's probably an address, return it as-is

diff --git a/mudsync/networking.scm b/mudsync/networking.scm
index 230008fc76cb5c213e3057f8b6e9e6f2b4c370ae..bb403f8f998fe1755076515114ba74f94590d870 100644 (file)
--- a/mudsync/networking.scm
+++ b/mudsync/networking.scm
@@ -48,11 +48,14 @@
   (message-handler
    #:init-value
    (make-action-dispatch
   (message-handler
    #:init-value
    (make-action-dispatch

-    ((start-listening actor message)
-     (nm-install-socket actor (message-ref message 'server %default-server)
-                        (message-ref message 'port %default-port)))
-    ((send-to-client actor message client data)
-     (nm-send-to-client-id actor client data)))))
+    (start-listening
+     (lambda* (actor message
+                     #:key (server %default-server)
+                     (port %default-port))
+       (nm-install-socket actor server port)))
+    (send-to-client
+     (lambda* (actor message #:key client data)
+       (nm-send-to-client-id actor client data))))))

 
 ;;; TODO: We should provide something like this, but this isn't used currently,
 ;;;    and uses old deprecated code (the 8sync-port-remove stuff).
 
 ;;; TODO: We should provide something like this, but this isn't used currently,
 ;;;    and uses old deprecated code (the 8sync-port-remove stuff).

diff --git a/mudsync/player.scm b/mudsync/player.scm
index a07c141fd080456615777b21ae85407df0acd937..844aaf96f031fbf4112a05b602a3bd5e0f4e5813 100644 (file)
--- a/mudsync/player.scm
+++ b/mudsync/player.scm
@@ -71,12 +71,12 @@
 
 ;;; player message handlers
 
 
 ;;; player message handlers
 

-(define-mhandler (player-init player message)
+(define (player-init player message)

   ;; Look around the room we're in
   (<- player (gameobj-loc player) 'look-room))
 
 
   ;; Look around the room we're in
   (<- player (gameobj-loc player) 'look-room))
 
 

-(define-mhandler (player-handle-input player message input)
+(define* (player-handle-input player message #:key input)

   (define split-input (split-verb-and-rest input))
   (define input-verb (car split-input))
   (define input-rest (cdr split-input))
   (define split-input (split-verb-and-rest input))
   (define input-verb (car split-input))
   (define input-rest (cdr split-input))


@@ -94,11 +94,11 @@
      (<- player (gameobj-gm player) 'write-home
          #:text "Huh?\n"))))
 
      (<- player (gameobj-gm player) 'write-home
          #:text "Huh?\n"))))
 

-(define-mhandler (player-tell player message text)
+(define* (player-tell player message #:key text)

   (<- player (gameobj-gm player) 'write-home
       #:text text))
 
   (<- player (gameobj-gm player) 'write-home
       #:text text))
 

-(define-mhandler (player-disconnect-self-destruct player message)
+(define (player-disconnect-self-destruct player message)

   "Action routine for being told to disconnect and self destruct."
   (define loc (gameobj-loc player))
   (when loc
   "Action routine for being told to disconnect and self destruct."
   (define loc (gameobj-loc player))
   (when loc


@@ -108,13 +108,14 @@
                        (slot-ref player 'name))))
   (gameobj-self-destruct player))
 
                        (slot-ref player 'name))))
   (gameobj-self-destruct player))
 

-(define-mhandler (player-cmd-inventory player message)
+(define (player-cmd-inventory player message)

   "Display the inventory for the player"
   (define inv-names
     (map
      (lambda (inv-item)
   "Display the inventory for the player"
   (define inv-names
     (map
      (lambda (inv-item)

-       (message-ref (<-wait player inv-item 'get-name)
-                    'val))
+       (msg-receive (_ #:key val)
+           (<-wait player inv-item 'get-name)
+         val))

      (gameobj-occupants player)))
   (define text-to-show
     (if (eq? inv-names '())
      (gameobj-occupants player)))
   (define text-to-show
     (if (eq? inv-names '())


@@ -144,19 +145,19 @@
   ;; Ask the room for its commands
   (define room-commands
     ;; TODO: Map room id and sort
   ;; Ask the room for its commands
   (define room-commands
     ;; TODO: Map room id and sort

-    (message-ref
-     (<-wait player player-loc
+    (msg-receive (_ #:key commands)
+        (<-wait player player-loc

              'get-container-commands
              #:verb verb)
              'get-container-commands
              #:verb verb)

-     'commands))
+      commands))

 
   ;; All the co-occupants of the room (not including ourself)
   (define co-occupants
     (remove
      (lambda (x) (equal? x (actor-id player)))
 
   ;; All the co-occupants of the room (not including ourself)
   (define co-occupants
     (remove
      (lambda (x) (equal? x (actor-id player)))

-     (message-ref
-      (<-wait player player-loc 'get-occupants)
-      'occupants)))
+     (msg-receive (_ #:key occupants)
+         (<-wait player player-loc 'get-occupants)
+       occupants)))

 
   ;; @@: There's a race condition here if someone leaves the room
   ;;   during this, heh...
 
   ;; @@: There's a race condition here if someone leaves the room
   ;;   during this, heh...


@@ -167,10 +168,9 @@
   (define co-occupant-commands
     (fold
      (lambda (co-occupant prev)
   (define co-occupant-commands
     (fold
      (lambda (co-occupant prev)

-       (let* ((result (<-wait player co-occupant 'get-commands
-                              #:verb verb))
-              (commands (message-ref result 'commands))
-              (goes-by (message-ref result 'goes-by)))
+       (msg-receive (_ #:key commands goes-by)
+           (<-wait player co-occupant 'get-commands
+                              #:verb verb)

          (append
           (map (lambda (command)
                  (list command goes-by co-occupant))
          (append
           (map (lambda (command)
                  (list command goes-by co-occupant))


@@ -193,11 +193,10 @@
   (define inv-item-commands
     (fold
      (lambda (inv-item prev)
   (define inv-item-commands
     (fold
      (lambda (inv-item prev)

-       (let* ((result (<-wait player inv-item
-                              'get-contained-commands
-                              #:verb verb))
-              (commands (message-ref result 'commands))
-              (goes-by (message-ref result 'goes-by)))
+       (msg-receive (_ #:key commands goes-by)
+           (<-wait player inv-item
+                   'get-contained-commands
+                   #:verb verb)

          (append
           (map (lambda (command)
                  (list command goes-by inv-item))
          (append
           (map (lambda (command)
                  (list command goes-by inv-item))

diff --git a/mudsync/room.scm b/mudsync/room.scm
index c4305233672755dad1f35c50057de342ec40ae33..2c19788034c3485245553e84278ac13490ac7efa 100644 (file)
--- a/mudsync/room.scm
+++ b/mudsync/room.scm
@@ -107,7 +107,7 @@
    ;; @@: Can remove this indirection once things settle
    #:init-value (wrap-apply room-action-dispatch)))
 
    ;; @@: Can remove this indirection once things settle
    #:init-value (wrap-apply room-action-dispatch)))
 

-(define-mhandler (room-cmd-go room message direct-obj)
+(define* (room-cmd-go room message #:key direct-obj)

   (define exit
     (find
      (lambda (exit)
   (define exit
     (find
      (lambda (exit)


@@ -119,8 +119,9 @@
                          (dyn-ref room (slot-ref exit 'to))
                          #f))
   (define player-name
                          (dyn-ref room (slot-ref exit 'to))
                          #f))
   (define player-name

-    (message-ref (<-wait room (message-from message)
-                         'get-name) 'val))
+    (msg-receive (_ #:key val)
+        (<-wait room (message-from message) 'get-name)
+      val))

   (cond
    (exit
     ;; Set the player's new location
   (cond
    (exit
     ;; Set the player's new location


@@ -140,7 +141,7 @@
     (<- room (message-from message) 'tell
         #:text "You don't see any way to go there.\n"))))
 
     (<- room (message-from message) 'tell
         #:text "You don't see any way to go there.\n"))))
 

-(define-mhandler (room-cmd-go-where room message)
+(define (room-cmd-go-where room message)

   (<- room (message-from message) 'tell
       #:text "Go where?\n"))
 
   (<- room (message-from message) 'tell
       #:text "Go where?\n"))
 


@@ -175,10 +176,10 @@
   (define occupant-names-all
     (map
      (lambda (occupant)
   (define occupant-names-all
     (map
      (lambda (occupant)

-       (message-ref
-        (<-wait room occupant 'visible-name
-                #:whos-looking player-id)
-        'text))
+       (call-with-message (<-wait room occupant 'visible-name
+                                  #:whos-looking player-id)
+                          (lambda* (_ #:key text)
+                            text)))

      (remove
       (lambda (x) (equal? x player-id))
       (hash-map->list (lambda (x _) x)
      (remove
       (lambda (x) (equal? x player-id))
       (hash-map->list (lambda (x _) x)


@@ -204,14 +205,12 @@
       #:text final-text))
 
 
       #:text final-text))
 
 

-(define-mhandler (room-look-room room message)
+(define* (room-look-room room message
+                            ;; Either send it to the #:to-id of the message,
+                            ;; or to the sender of the message
+                            #:key (to-id (message-from message)))

   "Command: Player asks to look around the room"
   "Command: Player asks to look around the room"

-  (room-player-looks-around
-   room
-   ;; Either send it to the #:to-id of the message, or to the
-   ;; sender of the message
-   (message-ref message 'to-id
-                (message-from message))))
+  (room-player-looks-around room to-id))

 
 (define (room-find-thing-called room called-this)
   "Find something called CALLED-THIS in the room, if any."
 
 (define (room-find-thing-called room called-this)
   "Find something called CALLED-THIS in the room, if any."


@@ -219,11 +218,10 @@
    (lambda (return)
      (for-each
       (lambda (occupant)
    (lambda (return)
      (for-each
       (lambda (occupant)

-        (define goes-by
-          (message-ref (<-wait room occupant 'goes-by)
-                       'goes-by #f))
-        (if (member called-this goes-by)
-            (return occupant)))
+        (msg-receive (_ #:key goes-by)
+            (<-wait room occupant 'goes-by)
+          (if (member called-this goes-by)
+              (return occupant))))

       (hash-map->list (lambda (key val) key)
                       (slot-ref room 'occupants)))
      #f)))
       (hash-map->list (lambda (key val) key)
                       (slot-ref room 'occupants)))
      #f)))


@@ -231,7 +229,7 @@
 (define %formless-desc
   "You don't see anything special.")
 
 (define %formless-desc
   "You don't see anything special.")
 

-(define-mhandler (room-look-at room message direct-obj)
+(define* (room-look-at room message #:key direct-obj)

   "Look at a specific object in the room."
   (define matching-object
     (room-find-thing-called room direct-obj))
   "Look at a specific object in the room."
   (define matching-object
     (room-find-thing-called room direct-obj))


@@ -239,10 +237,10 @@
   (cond
    (matching-object
     (let ((obj-desc
   (cond
    (matching-object
     (let ((obj-desc

-           (message-ref
-            (<-wait room matching-object 'get-desc
-                    #:whos-looking (message-from message))
-            'val)))
+           (msg-receive (_ #:key val)
+               (<-wait room matching-object 'get-desc
+                       #:whos-looking (message-from message))
+             val)))

       (if obj-desc
           (<- room (message-from message) 'tell
               #:text (string-append obj-desc "\n"))
       (if obj-desc
           (<- room (message-from message) 'tell
               #:text (string-append obj-desc "\n"))


@@ -266,36 +264,39 @@
                      #:text text))
    who-to-tell))
 
                      #:text text))
    who-to-tell))
 

-(define-mhandler (room-act-tell-room room message text)
+(define* (room-act-tell-room room message #:key text exclude wait)

   "Tell the room some messages."
   "Tell the room some messages."

-  (define exclude (message-ref message 'exclude #f))
-  (define wait-delivery (message-ref message 'wait #f))

   (room-tell-room room text
                   #:exclude exclude
   (room-tell-room room text
                   #:exclude exclude

-                  #:wait wait-delivery))
+                  #:wait wait))

 
 

-(define-mhandler (room-cmd-say room message phrase)
+(define* (room-cmd-say room message #:key phrase)

   "Command: Say something to room participants."
   (define player-name
   "Command: Say something to room participants."
   (define player-name

-    (message-ref (<-wait room (message-from message)
-                         'get-name) 'val))
+    (msg-receive (_ #:key val)
+        (<-wait room (message-from message)
+                'get-name)
+      val))

   (define message-to-send
     (format #f "~a says: ~a\n" player-name phrase))
   (room-tell-room room message-to-send))
 
   (define message-to-send
     (format #f "~a says: ~a\n" player-name phrase))
   (room-tell-room room message-to-send))
 

-(define-mhandler (room-cmd-emote room message phrase)
+(define* (room-cmd-emote room message #:key phrase)

   "Command: Say something to room participants."
   (define player-name
   "Command: Say something to room participants."
   (define player-name

-    (message-ref (<-wait room (message-from message)
-                         'get-name) 'val))
+    (msg-receive (_ #:key val)
+        (<-wait room (message-from message)
+                'get-name)
+      val))

   (define message-to-send
     (format #f "* ~a ~a\n" player-name phrase))
   (room-tell-room room message-to-send))
 
   (define message-to-send
     (format #f "* ~a ~a\n" player-name phrase))
   (room-tell-room room message-to-send))
 

-(define-mhandler (room-announce-entrance room message who-entered)
+(define* (room-announce-entrance room message #:key who-entered)

   (define player-name
   (define player-name

-    (message-ref (<-wait room who-entered 'get-name)
-                 'val))
+    (msg-receive (_ #:key val)
+        (<-wait room who-entered 'get-name)
+      val))

   (define message-to-send
     (format #f "~a enters the room.\n" player-name))
   (room-tell-room room message-to-send
   (define message-to-send
     (format #f "~a enters the room.\n" player-name))
   (room-tell-room room message-to-send

diff --git a/mudsync/thing.scm b/mudsync/thing.scm
index a3ae6b003e3d706407252ca931e9f1fbd4d50a56..7b3a71d1538cc81c14693f3630ff88e866d22646 100644 (file)
--- a/mudsync/thing.scm
+++ b/mudsync/thing.scm
@@ -79,16 +79,16 @@
    #:init-value
    (wrap-apply thing-dispatcher)))
 
    #:init-value
    (wrap-apply thing-dispatcher)))
 

-(define-mhandler (thing-cmd-take thing message direct-obj)
+(define* (thing-cmd-take thing message #:key direct-obj)

   (define player (message-from message))
   (define player-name
   (define player (message-from message))
   (define player-name

-    (message-ref
-     (<-wait thing player 'get-name)
-     'val))
+    (msg-receive (_ #:key val)
+        (<-wait thing player 'get-name)
+      val))

   (define player-loc
   (define player-loc

-    (message-ref
-     (<-wait thing player 'get-loc)
-     'val))
+    (msg-receive (_ #:key val)
+        (<-wait thing player 'get-loc)
+      val))

   (define thing-name (slot-ref thing 'name))
   (define should-take
     (slot-ref-maybe-runcheck thing 'takeable player))
   (define thing-name (slot-ref thing 'name))
   (define should-take
     (slot-ref-maybe-runcheck thing 'takeable player))


@@ -108,16 +108,16 @@
           #:text (format #f "It doesn't seem like you can pick up ~a.\n"
                          thing-name))))
 
           #:text (format #f "It doesn't seem like you can pick up ~a.\n"
                          thing-name))))
 

-(define-mhandler (thing-cmd-drop thing message direct-obj)
+(define* (thing-cmd-drop thing message #:key direct-obj)

   (define player (message-from message))
   (define player-name
   (define player (message-from message))
   (define player-name

-    (message-ref
-     (<-wait thing player 'get-name)
-     'val))
+    (msg-receive (_ #:key val)
+        (<-wait thing player 'get-name)
+      val))

   (define player-loc
   (define player-loc

-    (message-ref
-     (<-wait thing player 'get-loc)
-     'val))
+    (msg-receive (_ #:key val)
+        (<-wait thing player 'get-loc)
+      val))

   (define thing-name (slot-ref thing 'name))
   (define should-drop
     (slot-ref-maybe-runcheck thing 'dropable player))
   (define thing-name (slot-ref thing 'name))
   (define should-drop
     (slot-ref-maybe-runcheck thing 'dropable player))

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index 372515ede66d206292df8445bd660df71dd6c70d..16f91b8472e06f5ac66bf41d137e2b5d9a53c890 100644 (file)
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -80,7 +80,7 @@
 ;;; Lobby
 ;;; -----
 
 ;;; 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)
   (define text-to-send
     (format #f "~a says: \"~a\"\n"
             (slot-ref actor 'name)


@@ -157,11 +157,12 @@ or 'skribe'?  Now *that's* composition!"))
   (and (irregex-match name-sre name)
        (not (member name forbidden-words))))
 
   (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
   (define old-name

-    (message-ref
-     (<-wait actor (message-from message) 'get-name)
-     'val))
+    (msg-receive (_ #:key val)
+        (<-wait actor (message-from message) 'get-name)
+      val))

   (define name indir-obj)
   (if (valid-name? indir-obj)
       (begin
   (define name indir-obj)
   (if (valid-name? indir-obj)
       (begin


@@ -199,15 +200,15 @@ character.\n")))
    #:init-value
    (simple-dispatcher summoning-bell-actions*)))
 
    #:init-value
    (simple-dispatcher summoning-bell-actions*)))
 

-(define-mhandler (summoning-bell-cmd-ring bell message)
+(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
   ;; 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))
+    (msg-receive (_ #:key val)
+        (<-wait bell (message-from message) 'get-name)
+      val))

   ;; 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
   ;; 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


@@ -416,11 +417,11 @@ if this room is intended for children or child-like adults."
       (cmd-sit-furniture (wrap-apply furniture-cmd-sit)))
      gameobj-actions))))
 
       (cmd-sit-furniture (wrap-apply furniture-cmd-sit)))
      gameobj-actions))))
 

-(define-mhandler (furniture-cmd-sit actor message direct-obj)
+(define* (furniture-cmd-sit actor message #:key direct-obj)

   (define player-name
   (define player-name

-    (message-ref
-     (<-wait actor (message-from message) 'get-name)
-     'val))
+    (msg-receive (_ #:key val)
+        (<-wait actor (message-from message) 'get-name)
+      val))

   (<- actor (message-from message) 'tell
       #:text (format #f "You ~a ~a.\n"
                      (slot-ref actor 'sit-phrase)
   (<- actor (message-from message) 'tell
       #:text (format #f "You ~a ~a.\n"
                      (slot-ref actor 'sit-phrase)


@@ -529,7 +530,7 @@ seat in the room, though."
    #:init-value
    (simple-dispatcher clerk-actions*)))
 
    #:init-value
    (simple-dispatcher clerk-actions*)))
 

-(define-mhandler (clerk-act-init clerk message)
+(define (clerk-act-init clerk message)

   ;; call the gameobj main init method
   (gameobj-act-init clerk message)
   ;; start our main loop
   ;; call the gameobj main init method
   (gameobj-act-init clerk message)
   ;; start our main loop


@@ -571,7 +572,7 @@ 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..."))
 
 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
   (match (slot-ref clerk 'state)
     ('on-duty
      (<- clerk (message-from message) 'tell


@@ -584,14 +585,14 @@ with tuition at where it is..."))
           (random-choice clerk-slacking-complaints)
           "\"\n")))))
 
           (random-choice clerk-slacking-complaints)
           "\"\n")))))
 

-(define-mhandler (clerk-cmd-ask-incomplete clerk message)
+(define (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")
 
   (<- 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)
+(define (clerk-cmd-ask clerk message indir-obj)

   (match (slot-ref clerk 'state)
     ('on-duty
      (match (assoc (pk 'indir indir-obj) clerk-help-topics)
   (match (slot-ref clerk 'state)
     ('on-duty
      (match (assoc (pk 'indir indir-obj) clerk-help-topics)


@@ -608,7 +609,7 @@ with tuition at where it is..."))
      (<- clerk (message-from message) 'tell
          #:text "The clerk says, \"Sorry, I'm on my break.\"\n"))))
 
      (<- clerk (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 who-summoned)

   (match (slot-ref clerk 'state)
     ('on-duty
      (<- clerk who-summoned 'tell
   (match (slot-ref clerk 'state)
     ('on-duty
      (<- clerk who-summoned 'tell


@@ -634,11 +635,11 @@ feel free to ask me.  For example, 'ask clerk about changing name'.
 You can ask me about the following:
 " clerk-knows-about ".\"\n")))))
 
 You can ask me about the following:
 " clerk-knows-about ".\"\n")))))
 

-(define-mhandler (clerk-cmd-dismiss clerk message)
+(define (clerk-cmd-dismiss clerk message)

   (define player-name
   (define player-name

-    (message-ref
-     (<-wait clerk (message-from message) 'get-name)
-     'val))
+    (msg-receive (_ #:key val)
+        (<-wait clerk (message-from message) 'get-name)
+      val))

   (match (slot-ref clerk 'state)
     ('on-duty
      (<- clerk (gameobj-loc clerk) 'tell-room
   (match (slot-ref clerk 'state)
     ('on-duty
      (<- clerk (gameobj-loc clerk) 'tell-room


@@ -681,7 +682,7 @@ attend to.\n")
 (define clerk-return-to-slacking-text
   "The desk clerk enters and slams the door behind her.\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 (tell-room text)
     (<- clerk (gameobj-loc clerk) 'tell-room
         #:text text

diff --git a/worlds/goblin-hq.scm b/worlds/goblin-hq.scm
index 357f4a6557decaead808d8603e5210e1c394ad3e..0e1de7e91cf2105f831e47345c26cf2bd8102150 100644 (file)
--- a/worlds/goblin-hq.scm
+++ b/worlds/goblin-hq.scm
@@ -79,7 +79,7 @@ Only the universe knows."))
    #:init-value
    (wrap-apply typewriter-dispatch)))
 
    #:init-value
    (wrap-apply typewriter-dispatch)))
 

-(define-mhandler (typewriter-cmd-type-gibberish actor message)
+(define (typewriter-cmd-type-gibberish actor message)

   (<- actor (message-from message) 'tell
       #:text "*tikka takka!*  *tikka takka!*
 You type some gibberish on the typewriter.\n"))
   (<- actor (message-from message) 'tell
       #:text "*tikka takka!*  *tikka takka!*
 You type some gibberish on the typewriter.\n"))


@@ -90,12 +90,12 @@ You type some gibberish on the typewriter.\n"))
       (format #f "You type out a note.\nThe note says: ~s\n"
               type-text)))
 
       (format #f "You type out a note.\nThe note says: ~s\n"
               type-text)))
 

-(define-mhandler (typewriter-cmd-type-something
-                  actor message direct-obj indir-obj)
+(define (typewriter-cmd-type-something
+         actor message direct-obj indir-obj)

   (type-thing actor message direct-obj))
 
   (type-thing actor message direct-obj))
 

-(define-mhandler (typewriter-cmd-type-anything
-                  actor message direct-obj rest)
+(define (typewriter-cmd-type-anything
+         actor message direct-obj rest)

   (type-thing actor message rest))
 
 
   (type-thing actor message rest))