create-gameobj

[mudsync.git] / mudsync / gameobj.scm

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 33d9cd04af3dc33b1e49fb1067362bc7979ae0d4..21c655980b4d33d52c7dbd45fb250b9bb37c6045 100644 (file)
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -32,6 +32,7 @@
   #:use-module (oop goops)
   #:export (<gameobj>
 
+            create-gameobj
             gameobj-loc
             gameobj-gm
 
@@ -43,6 +44,7 @@
             slot-ref-maybe-runcheck
             val-or-run
 
+            build-props
             dyn-ref
 
             ;; Some of the more common commands
@@ -52,6 +54,7 @@
 ;;; Gameobj
 ;;; =======
 
+(define build-props build-rmeta-slot)
 
 ;;; *all* game components that talk to players should somehow
 ;;; derive from this class.
@@ -111,13 +114,15 @@
   ;; props by default only have a 'get-prop read-only action handler;
   ;; any coordination of setting a prop between actors must be
   ;; added to that actor, to keep things from getting out of control.
-  (props #:init-thunk make-hash-table)
+  (props #:init-thunk make-hash-table
+         #:init-keyword #:props)
   ;; gameobjs may inherit an initial list of these via the
   ;; initial-props slot, which must always have its
-  ;; #:allocation #:each-subclass and use (build-rmeta-slot).
+  ;; #:allocation #:each-subclass and use (build-props) for the
+  ;; #:init-thunk.
   ;; The vanilla gameobj has no props, on purpose.
   (initial-props #:allocation #:each-subclass
-                 #:init-thunk (build-rmeta-slot '()))
+                 #:init-thunk (build-props '()))
 
   ;; Most objects are generally visible by default
   (invisible? #:init-value #f
@@ -183,6 +188,27 @@
 ;;; gameobj message handlers
 ;;; ========================
 
+;; TODO: This init stuff is a mess, and should be redone now that
+;;   we have the *init* action stuff.  We've really spread out the
+;;   logic for creating a gameobj in several places, eg gm-inject-special!
+(define (create-gameobj class gm loc . args)
+  "Create a gameobj of CLASS with GM and set to location LOC, applying rest of ARGS.
+Note that this doesn't do any special dyn-ref of the location."
+  (let ((new-gameobj (apply create-actor (%current-actor) class
+                            #:gm gm args)))
+    ;; Set the location
+    (<-wait new-gameobj 'set-loc! #:loc loc)
+    ;; Initialize the object
+    (<-wait new-gameobj 'init)))
+
+;; ;; @@: Should we also dyn-ref the loc here?  We can do that, unlike with
+;; ;;   create-gameobj.
+;; ;;   Another route could be to have set-loc! itself know how to use the
+;; ;;   dyn-ref.
+;; (define (gameobj-create-gameobj gameobj class loc . args)
+;;   "Like create-gameobj but saves the step of passing in the gm."
+;;   (apply create-gameobj class (gameobj-gm gameobj) loc args))
+
 ;; Kind of a useful utility, maybe?
 (define (simple-slot-getter slot)
   (lambda (actor message)
@@ -215,10 +241,13 @@
   (define props (slot-ref gameobj 'props))
   (maybe-build-rmeta-slot-cache! class 'initial-props
                                  eq? hashq-set! hashq-ref)
+  ;; Kind of a kludge... we read through the rmeta-slot-cache
+  ;; and use that to build up the table
   (hash-for-each
    (lambda (key value)
-     (hashq-set! props key value))
-   (rmeta-slot-table (class-slot-ref class 'initial-props))))
+     (when (not (hashq-ref props key value)) ; don't override init'ed instance values
+       (hashq-set! props key value)))
+   (rmeta-slot-cache (class-slot-ref class 'initial-props))))
 
 ;; TODO: Use the *init* action?
 ;;   We could also use a generic method if they didn't have
@@ -448,6 +477,8 @@ By default, this is whether or not the generally-visible flag is set."
   (match special-symbol
     ;; if it's a symbol, look it up dynamically
     ((? symbol? _)
+     ;; TODO: If we get back an #f at this point, should we throw
+     ;;   an error?  Obviously #f is okay, but maybe not if 
      (mbody-val (<-wait (slot-ref gameobj 'gm) 'lookup-special
                         #:symbol special-symbol)))
     ;; if it's false, return nothing