X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fthing.scm;h=7b3a71d1538cc81c14693f3630ff88e866d22646;hp=341371f7531dbccdd4de448b878524f5224e90da;hb=6cff5b0062ef928204295ab4327bf2d417070421;hpb=7e11c67b59dc07a46576b2acaa4657ee533df7d5 diff --git a/mudsync/thing.scm b/mudsync/thing.scm index 341371f..7b3a71d 100644 --- a/mudsync/thing.scm +++ b/mudsync/thing.scm @@ -28,25 +28,27 @@ #:use-module (ice-9 format) #:export ( thing-commands + thing-commands* thing-contained-commands - thing-actions)) + thing-contained-commands* + thing-actions + thing-actions*)) (define thing-commands (list (direct-command "take" 'cmd-take))) -;;; Are these kinds of things useful? -;; ;; Doesn't inherit anything (gameobj has no commands) -;; ;; so it's an alias. -;; (define thing-commands* thing-commands) +;; Doesn't inherit anything (gameobj has no commands) +;; so it's an alias. +(define thing-commands* thing-commands) (define thing-contained-commands (list - (empty-command "drop" 'cmd-drop))) + (direct-command "drop" 'cmd-drop))) -;; ;; Doesn't inherit anything (gameobj has no contained-commands) -;; ;; so it's an alias. -;; (define thing-contained-commands* thing-contained-commands) +;; Doesn't inherit anything (gameobj has no contained-commands) +;; so it's an alias. +(define thing-contained-commands* thing-contained-commands) (define thing-actions (build-actions @@ -77,12 +79,16 @@ #: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 - (message-ref - (<-wait thing player 'get-name) - 'val)) + (msg-receive (_ #:key val) + (<-wait thing player 'get-name) + val)) + (define player-loc + (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)) @@ -93,7 +99,7 @@ (<- thing player 'tell #:text (format #f "You pick up ~a.\n" thing-name)) - (<- thing (gameobj-loc thing) 'tell-room + (<- thing player-loc 'tell-room #:text (format #f "~a picks up ~a.\n" player-name thing-name) @@ -102,16 +108,16 @@ #: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 - (message-ref - (<-wait thing player 'get-name) - 'val)) + (msg-receive (_ #:key val) + (<-wait thing player 'get-name) + val)) (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))