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 cb844d1e65ab01a983ba81da808bd194c2e08993..b686e3cbd74a4d2d41825f0f5f5777290b8357f4 100644 (file)
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -31,9 +31,15 @@
             gameobj-loc
             gameobj-gm
 
+            gameobj-set-loc!
             gameobj-occupants
             gameobj-actions
-            gameobj-self-destruct))
+            gameobj-self-destruct
+
+            slot-ref-maybe-runcheck
+            val-or-run
+
+            dyn-ref))
 
 ;;; Gameobj
 ;;; =======
@@ -43,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!))
@@ -87,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))
@@ -109,11 +124,11 @@
     (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))
   ;; Snarf all the occupants!
+  (display "replacing occupant\n")
   (when occupants
     (for-each
      (lambda (occupant)
@@ -125,7 +140,7 @@
   (list gameobj-replace-step-occupants))
 
 (define (run-replacement actor message replace-steps)
-  (define replaces (message-ref message 'replaces #f))
+  (define replaces (message-ref message 'replace #f))
   (when replaces
     (let ((replace-reply
            (<-wait actor replaces 'assist-replace)))
@@ -134,7 +149,6 @@
          (replace-step actor replace-reply))
        replace-steps))))
 
-
 ;; @@: This could be kind of a messy way of doing gameobj-init
 ;;   stuff.  If only we had generic methods :(
 (define-mhandler (gameobj-init actor message)
@@ -185,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)
@@ -223,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))
@@ -241,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)
@@ -307,3 +342,21 @@ By default, this is whether or not the generally-visible flag is set."
   "Vanilla method for assisting in self-replacement for live hacking"
   (apply <-reply actor message
          (gameobj-replace-data* actor)))
+
+\f
+;;; Utilities every gameobj has
+;;; ---------------------------
+
+(define (dyn-ref gameobj special-symbol)
+  "Dynamically look up a special object from the gm"
+  (match special-symbol
+    ;; if it's a symbol, look it up dynamically
+    ((? symbol? _)
+     (message-ref
+      (<-wait gameobj (slot-ref gameobj 'gm) 'lookup-special
+              #:symbol special-symbol)
+      'val))
+    ;; if it's false, return nothing
+    ((#f #f))
+    ;; otherwise it's probably an address, return it as-is
+    (_ special-symbol)))