From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Sun, 29 Jan 2017 23:41:58 +0000 (-0600)
Subject: props subsystem
X-Git-Tag: fosdem-2017~43
X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=fc80f814a2ebd5e562e9e5dbf74eea8daf063db7;p=mudsync.git

props subsystem
---

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 33d9cd0..6011be2 100644
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -43,6 +43,7 @@
             slot-ref-maybe-runcheck
             val-or-run
 
+            build-props
             dyn-ref
 
             ;; Some of the more common commands
@@ -52,6 +53,7 @@
 ;;; Gameobj
 ;;; =======
 
+(define build-props build-rmeta-slot)
 
 ;;; *all* game components that talk to players should somehow
 ;;; derive from this class.
@@ -111,13 +113,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
@@ -215,10 +219,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