From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Sat, 28 Jan 2017 19:24:54 +0000 (-0600)
Subject: Allow to specify what the player is on take-from / put-in / etc as keyword
X-Git-Tag: fosdem-2017~61
X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=a665b6e113d400b364f5b22ab151e7d84d5a0a38;p=mudsync.git

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 65ddc29..6f2ddf0 100644
--- 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
 ;;; -------------
 
-(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
@@ -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))))
 
-(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
@@ -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
-                        #: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
@@ -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
-                     #: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
@@ -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)
-    (<- (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)))
-    (<- (message-from message) 'tell
+    (<- player 'tell
         #: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