X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=inline;f=mudsync%2Fcontainer.scm;h=65ef0b71097e0b8aaf2582cd02ec451e78fb4db0;hb=086e3362830393bcd51a3d79fe50c66ca15b7112;hp=46a52e5a6a9db261681d16a05b83c89b5eb25dad;hpb=76ece1325111d6736003c3a3c7b6383f07478d3e;p=mudsync.git
diff --git a/mudsync/container.scm b/mudsync/container.scm
index 46a52e5..65ef0b7 100644
--- a/mudsync/container.scm
+++ b/mudsync/container.scm
@@ -17,11 +17,16 @@
;;; along with Mudsync. If not, see .
;;; Containers
+;;; ==========
+;;;
+;;; While all gameobjs are containers, some gameobjs are more
+;;; containers than others.
(define-module (mudsync container)
#: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 (
@@ -45,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)))
@@ -70,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
@@ -111,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)))
@@ -135,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