X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgameobj.scm;h=b686e3cbd74a4d2d41825f0f5f5777290b8357f4;hp=0f4d7043e96918251bc1f70d85a63fde16c4566f;hb=7e11c67b59dc07a46576b2acaa4657ee533df7d5;hpb=2d7173d04d4b01f4480ec700c6419407232ef1bb;ds=sidebyside

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 0f4d704..b686e3c 100644
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -31,10 +31,14 @@
             gameobj-loc
             gameobj-gm
 
+            gameobj-set-loc!
             gameobj-occupants
             gameobj-actions
             gameobj-self-destruct
 
+            slot-ref-maybe-runcheck
+            val-or-run
+
             dyn-ref))
 
 ;;; Gameobj
@@ -45,11 +49,16 @@
 (define gameobj-actions
   (build-actions
    (init (wrap-apply gameobj-init))
+   ;; Commands for co-occupants
    (get-commands (wrap-apply gameobj-get-commands))
+   ;; Commands for participants in a room
    (get-container-commands (wrap-apply gameobj-get-container-commands))
+   ;; Commands for inventory items, etc (occupants of the gameobj commanding)
+   (get-contained-commands (wrap-apply gameobj-get-contained-commands))
    (get-occupants (wrap-apply gameobj-get-occupants))
    (add-occupant! (wrap-apply gameobj-add-occupant!))
    (remove-occupant! (wrap-apply gameobj-remove-occupant!))
+   (get-loc (wrap-apply gameobj-act-get-loc))
    (set-loc! (wrap-apply gameobj-act-set-loc!))
    (get-name (wrap-apply gameobj-get-name))
    (set-name! (wrap-apply gameobj-act-set-name!))
@@ -89,6 +98,10 @@
 
   ;; Commands we can handle by being something's container
   (container-commands #:init-value '())
+
+  ;; Commands we can handle by being contained by something else
+  (contained-commands #:init-value '())
+
   (message-handler
    #:init-value
    (simple-dispatcher gameobj-actions))
@@ -111,7 +124,6 @@
     (reply-message actor message
                    #:val (slot-ref actor slot))))
 
-
 (define (gameobj-replace-step-occupants actor replace-reply)
   (define occupants
     (message-ref replace-reply 'occupants #f))
@@ -187,6 +199,15 @@ Assists in its replacement of occupants if necessary and nothing else."
                      verb))
   (<-reply actor message #:commands filtered-commands))
 
+(define-mhandler (gameobj-get-contained-commands actor message verb)
+  "Get commands as being contained (eg inventory) of commanding gameobj"
+  (define filtered-commands
+    (filter-commands (val-or-run (slot-ref actor 'contained-commands))
+                     verb))
+  (<-reply actor message
+           #:commands filtered-commands
+           #:goes-by (gameobj-goes-by actor)))
+
 (define-mhandler (gameobj-add-occupant! actor message who)
   "Add an actor to our list of present occupants"
   (hash-set! (slot-ref actor 'occupants)
@@ -225,6 +246,10 @@ Assists in its replacement of occupants if necessary and nothing else."
   (<-reply actor message
            #:occupants occupants))
 
+(define-mhandler (gameobj-act-get-loc actor message)
+  (<-reply actor message
+           #:val (slot-ref actor 'loc)))
+
 (define (gameobj-set-loc! gameobj loc)
   "Set the location of this object."
   (define old-loc (gameobj-loc gameobj))
@@ -243,6 +268,14 @@ Assists in its replacement of occupants if necessary and nothing else."
   "Action routine to set the location."
   (gameobj-set-loc! actor loc))
 
+(define (slot-ref-maybe-runcheck gameobj slot whos-asking)
+  "Do a slot-ref on gameobj, evaluating it including ourselves
+and whos-asking, and see if we should just return it or run it."
+  (match (slot-ref gameobj slot)
+    ((? procedure? slot-val-proc)
+     (slot-val-proc gameobj whos-asking))
+    (anything-else anything-else)))
+
 (define gameobj-get-name (simple-slot-getter 'name))
 
 (define-mhandler (gameobj-act-set-name! actor message val)