Allow to specify what the player is on take-from / put-in / etc as keyword

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 65ddc296262c7d2a767e53db858330170d4aed3d..6f2ddf071747d72118fb4c1b2057705955356dfe 100644 (file)
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -407,8 +407,9 @@ By default, this is whether or not the generally-visible flag is set."
 ;;; Basic actions
 ;;; -------------
 
 ;;; Basic actions
 ;;; -------------
 

-(define* (cmd-take gameobj message #:key direct-obj)
-  (define player (message-from message))
+(define* (cmd-take gameobj message
+                   #:key direct-obj
+                   (player (message-from message)))

   (define player-name
     (mbody-val (<-wait player 'get-name)))
   (define player-loc
   (define player-name
     (mbody-val (<-wait player 'get-name)))
   (define player-loc


@@ -435,8 +436,9 @@ By default, this is whether or not the generally-visible flag is set."
           #:text (format #f "It doesn't seem like you can take ~a.\n"
                          our-name))))
 
           #:text (format #f "It doesn't seem like you can take ~a.\n"
                          our-name))))
 

-(define* (cmd-drop gameobj message #:key direct-obj)
-  (define player (message-from message))
+(define* (cmd-drop gameobj message
+                   #:key direct-obj
+                   (player (message-from message)))

   (define player-name
     (mbody-val (<-wait player 'get-name)))
   (define player-loc
   (define player-name
     (mbody-val (<-wait player 'get-name)))
   (define player-loc


@@ -481,8 +483,8 @@ By default, this is whether or not the generally-visible flag is set."
 ;; @@: Moving this to a container subclass/mixin could allow a lot more
 ;;   customization of take out / put in phrases
 (define* (cmd-take-from gameobj message
 ;; @@: Moving this to a container subclass/mixin could allow a lot more
 ;;   customization of take out / put in phrases
 (define* (cmd-take-from gameobj message

-                        #:key direct-obj indir-obj preposition)
-  (define player (message-from message))
+                        #:key direct-obj indir-obj preposition
+                        (player (message-from message)))

   (define player-name
     (mbody-val (<-wait player 'get-name)))
   (define player-loc
   (define player-name
     (mbody-val (<-wait player 'get-name)))
   (define player-loc


@@ -556,8 +558,8 @@ By default, this is whether or not the generally-visible flag is set."
         #:exclude player))))
 
 (define* (cmd-put-in gameobj message
         #:exclude player))))
 
 (define* (cmd-put-in gameobj message

-                     #:key direct-obj indir-obj preposition)
-  (define player (message-from message))
+                     #:key direct-obj indir-obj preposition
+                     (player (message-from message)))

   (define player-name
     (mbody-val (<-wait player 'get-name)))
   (define player-loc
   (define player-name
     (mbody-val (<-wait player 'get-name)))
   (define player-loc


@@ -592,17 +594,17 @@ By default, this is whether or not the generally-visible flag is set."
   (cond
    ;; Is it not there, or maybe we won't allow it to be taken?
    ((not this-thing)
   (cond
    ;; Is it not there, or maybe we won't allow it to be taken?
    ((not this-thing)

-    (<- (message-from message) 'tell
+    (<- player 'tell

         #:text `("You don't seem to have any such " ,direct-obj " to put "
                  ,preposition " " ,our-name ".")))
 
    ((or (not (should-put-in-me)))
         #:text `("You don't seem to have any such " ,direct-obj " to put "
                  ,preposition " " ,our-name ".")))
 
    ((or (not (should-put-in-me)))

-    (<- (message-from message) 'tell
+    (<- player 'tell

         #:text (default-objection)))
    ;; the thing we wsant to take itself has objected...
    ((this-thing-objection) =>
     (lambda (objection)
         #:text (default-objection)))
    ;; the thing we wsant to take itself has objected...
    ((this-thing-objection) =>
     (lambda (objection)

-      (<- (message-from message) 'tell
+      (<- player 'tell

           #:text objection)))
    ;; looks like we can take it
    (else
           #:text objection)))
    ;; looks like we can take it
    (else