X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fcontainer.scm;fp=mudsync%2Fcontainer.scm;h=65ef0b71097e0b8aaf2582cd02ec451e78fb4db0;hp=3e7763d5e6dddc710ff414ff4f7fc513c05ea22d;hb=086e3362830393bcd51a3d79fe50c66ca15b7112;hpb=0327c09557568d1fefd7d642333c21c8a9f655db diff --git a/mudsync/container.scm b/mudsync/container.scm index 3e7763d..65ef0b7 100644 --- a/mudsync/container.scm +++ b/mudsync/container.scm @@ -26,6 +26,7 @@ #:use-module (8sync) #:use-module (oop goops) #:use-module (mudsync gameobj) + #:use-module (mudsync receive-star) #:use-module (mudsync utils) #:use-module (ice-9 control) #:export ( @@ -49,23 +50,23 @@ #:key direct-obj indir-obj preposition (player (message-from message))) (define player-name - (mbody-val (<-wait player 'get-name))) + (<-wait player 'get-name)) (define player-loc - (mbody-val (<-wait player 'get-loc))) + (<-wait player 'get-loc)) (define our-name (slot-ref gameobj 'name)) ;; We need to check if we even have such a thing (define this-thing (call/ec (lambda (return) (for-each (lambda (occupant) - (define goes-by (mbody-val (<-wait occupant 'goes-by))) + (define goes-by (<-wait occupant 'goes-by)) (when (ci-member direct-obj goes-by) (return occupant))) (gameobj-occupants gameobj)) ;; nothing found #f))) (define (this-thing-name) - (mbody-val (<-wait this-thing 'get-name))) + (<-wait this-thing 'get-name)) (define (should-take-from-me) (and this-thing (slot-ref-maybe-runcheck gameobj 'take-from-me? player this-thing))) @@ -74,7 +75,7 @@ ,(this-thing-name) " " ,preposition " " ,our-name ".")) (define (this-thing-objection) - (mbody-receive (_ taken-ok? #:key why-not) ; does the object object to being removed? + (receive* (taken-ok? #:key why-not) ; does the object object to being removed? (<-wait this-thing 'ok-to-be-taken-from? player) ; @@ no need to supply from where (and (not taken-ok?) ;; Either give the specified reason, or give a boilerplate one @@ -115,23 +116,23 @@ #:key direct-obj indir-obj preposition (player (message-from message))) (define player-name - (mbody-val (<-wait player 'get-name))) + (<-wait player 'get-name)) (define player-loc - (mbody-val (<-wait player 'get-loc))) + (<-wait player 'get-loc)) (define our-name (slot-ref gameobj 'name)) ;; We need to check if we even have such a thing (define this-thing (call/ec (lambda (return) (for-each (lambda (occupant) - (define goes-by (mbody-val (<-wait occupant 'goes-by))) + (define goes-by (<-wait occupant 'goes-by)) (when (ci-member direct-obj goes-by) (return occupant))) - (mbody-val (<-wait player 'get-occupants))) + (<-wait player 'get-occupants)) ;; nothing found #f))) (define (this-thing-name) - (mbody-val (<-wait this-thing 'get-name))) + (<-wait this-thing 'get-name)) (define (should-put-in-me) (and this-thing (slot-ref-maybe-runcheck gameobj 'put-in-me? player this-thing))) @@ -139,7 +140,7 @@ `("As much as you'd like to, it doesn't seem like you can put " ,(this-thing-name) " " ,preposition " " ,our-name ".")) (define (this-thing-objection) - (mbody-receive (_ put-in-ok? #:key why-not) ; does the object object to being moved? + (receive* (put-in-ok? #:key why-not) ; does the object object to being moved? (<-wait this-thing 'ok-to-be-put-in? player (actor-id gameobj)) (and (not put-in-ok?) ;; Either give the specified reason, or give a boilerplate one