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

props stuff
---

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index ebd4db7..9e331da 100644
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -78,6 +78,7 @@
   (desc #:init-value #f
         #:init-keyword #:desc)
 
+  ;; @@: Maybe commands should be renamed to verbs, I dunno
   ;; Commands we can handle
   (commands #:allocation #:each-subclass
             #:init-thunk (build-commands
@@ -101,6 +102,23 @@
                       (build-commands
                        ("drop" ((direct-command cmd-drop #:obvious? #f)))))
 
+  ;; The extremely squishy concept of "props"... properties!
+  ;; These are flags, etc etc of various types.  This is a hashq table.
+  ;; These have upsides and downsides, but the big upside is that you can
+  ;; query a "prop" of a prospective gameobj without knowing what type of
+  ;; gameobj that is, and not fear some kind of breakage.
+  ;;
+  ;; 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)
+  ;; gameobjs may inherit an initial list of these via the
+  ;; initial-props slot, which must always have its
+  ;; #:allocation #:each-subclass and use (wrap-rmeta-slot).
+  ;; The vanilla gameobj has no props, on purpose.
+  (initial-props #:allocation #:each-subclass
+                 #:init-thunk (build-rmeta-slot '()))
+
   ;; Most objects are generally visible by default
   (invisible? #:init-value #f
               #:init-keyword #:invisible?)
@@ -144,6 +162,7 @@
             (get-name gameobj-get-name)
             (set-name! gameobj-act-set-name!)
             (get-desc gameobj-get-desc)
+            (get-prop gameobj-act-get-prop)
             (goes-by gameobj-act-goes-by)
             (visible-name gameobj-visible-name)
             (self-destruct gameobj-act-self-destruct)
@@ -191,13 +210,33 @@
          (replace-step actor occupants))
        replace-steps))))
 
-;; @@: This could be kind of a messy way of doing gameobj-act-init
-;;   stuff.  If only we had generic methods :(
+(define (gameobj-setup-props gameobj)
+  (define class (class-of gameobj))
+  (define props (slot-ref gameobj 'props))
+  (maybe-build-rmeta-slot-cache! class 'initial-props
+                                 eq? hashq-set! hashq-ref)
+  (hash-for-each
+   (lambda (key value)
+     (hashq-set! props key value))
+   (rmeta-slot-table (class-slot-ref class 'initial-props))))
+
+;; TODO: Use the *init* action?
+;;   We could also use a generic method if they didn't have
+;;   what I'm pretty sure is O(n) dispatch in GOOPS...
 (define* (gameobj-act-init actor message #:key replace)
-  "Your most basic game object init procedure.
-Assists in its replacement of occupants if necessary and nothing else."
+  "Your most basic game object init procedure."
+  (gameobj-setup-props actor)
   (run-replacement actor replace gameobj-replace-steps*))
 
+(define* (gameobj-get-prop actor key #:optional dflt)
+  (hashq-ref (slot-ref gameobj 'props) key dflt))
+
+(define* (gameobj-set-prop! actor key val)
+  (hashq-set! (slot-ref gameobj 'props) key val))
+
+(define* (gameobj-act-get-prop actor message key #:optional dflt)
+  (gameobj-get-prop actor key dflt))
+
 (define (gameobj-goes-by gameobj)
   "Find the name we go by.  Defaults to #:name if nothing else provided."
   (cond ((slot-ref gameobj 'goes-by) =>
@@ -319,13 +358,15 @@ and whos-asking, and see if we should just return it or run it."
 (define* (gameobj-act-set-name! actor message val)
   (slot-set! actor 'name val))
 
+(define* (gameobj-desc actor #:key whos-looking)
+  (match (slot-ref actor 'desc)
+    ((? procedure? desc-proc)
+     (desc-proc actor whos-looking))
+    (desc desc)))
+
 (define* (gameobj-get-desc actor message #:key whos-looking)
-  (define desc-text
-    (match (slot-ref actor 'desc)
-      ((? procedure? desc-proc)
-       (desc-proc actor whos-looking))
-      (desc desc)))
-  (<-reply message desc-text))
+  "This is the action equivalent of the gameobj-desc getter"
+  (<-reply message (gameobj-desc actor #:whos-looking whos-looking)))
 
 (define (gameobj-visible-to-player? gameobj whos-looking)
   "Check to see whether we're visible to the player or not.