Port to the remove-define-mhandler 8sync branch
[mudsync.git] / mudsync / gameobj.scm
index 334f4397593054d71c744ee062e40c850909be34..8b1040fbcaee86df2aab20369c0ecd6db7486f79 100644 (file)
 (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
 (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
-    (let ((replace-reply
-           (<-wait actor replaces 'assist-replace)))
+    (msg-receive (_ #:key occupants)
+        (<-wait actor replaces 'assist-replace)
       (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 :(
-(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."
-  (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."
@@ -189,7 +186,7 @@ Assists in its replacement of occupants if necessary and nothing else."
              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))
@@ -198,14 +195,14 @@ Assists in its replacement of occupants if necessary and nothing else."
            #: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))
 
-(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))
@@ -214,12 +211,12 @@ Assists in its replacement of occupants if necessary and nothing else."
            #: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))
 
-(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))
 
@@ -243,16 +240,15 @@ Assists in its replacement of occupants if necessary and nothing else."
    '()
    (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."
-  (define exclude (message-ref message 'exclude #f))
   (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)))
 
@@ -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?
-(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))
 
@@ -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-mhandler (gameobj-act-set-name! actor message val)
+(define* (gameobj-act-set-name! actor message #:key 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)
@@ -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))
 
-(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))
@@ -326,7 +322,7 @@ By default, this is whether or not the generally-visible flag is set."
   ;; 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))
 
@@ -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? _)
-     (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