Port to the remove-define-mhandler 8sync branch

[mudsync.git] / mudsync / gameobj.scm

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