basic things, with the ability to pick them up (but not put them down, heh)

[mudsync.git] / mudsync / gameobj.scm

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 0f4d7043e96918251bc1f70d85a63fde16c4566f..b686e3cbd74a4d2d41825f0f5f5777290b8357f4 100644 (file)
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -31,10 +31,14 @@
             gameobj-loc
             gameobj-gm
 
             gameobj-loc
             gameobj-gm
 

+            gameobj-set-loc!

             gameobj-occupants
             gameobj-actions
             gameobj-self-destruct
 
             gameobj-occupants
             gameobj-actions
             gameobj-self-destruct
 

+            slot-ref-maybe-runcheck
+            val-or-run
+

             dyn-ref))
 
 ;;; Gameobj
             dyn-ref))
 
 ;;; Gameobj


@@ -45,11 +49,16 @@
 (define gameobj-actions
   (build-actions
    (init (wrap-apply gameobj-init))
 (define gameobj-actions
   (build-actions
    (init (wrap-apply gameobj-init))

+   ;; Commands for co-occupants

    (get-commands (wrap-apply gameobj-get-commands))
    (get-commands (wrap-apply gameobj-get-commands))

+   ;; Commands for participants in a room

    (get-container-commands (wrap-apply gameobj-get-container-commands))
    (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-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!))
    (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 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))
   (message-handler
    #:init-value
    (simple-dispatcher gameobj-actions))


@@ -111,7 +124,6 @@
     (reply-message actor message
                    #:val (slot-ref actor slot))))
 
     (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))
 (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))
 
                      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)
 (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))
 
   (<-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))
 (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))
 
   "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)
 (define gameobj-get-name (simple-slot-getter 'name))
 
 (define-mhandler (gameobj-act-set-name! actor message val)