Make asset access transparent and add reload handler method.

1 files changed, 54 insertions, 2 deletions

diff --git a/starling/node.scm b/starling/node.scm
index 6ddcd2c..58896b8 100644
--- a/starling/node.scm
+++ b/starling/node.scm
@@ -23,6 +23,7 @@
 (define-module (starling node)
   #:use-module (chickadee scripting)
   #:use-module (oop goops)
+  #:use-module (starling asset)
   #:use-module (starling config)
   #:export (<node>
             name
@@ -60,6 +61,54 @@
             blink)
   #:replace (pause))
 
+(define-class <meta-node> (<class>))
+
+(define-method (asset-slot? (slot <slot>))
+  (get-keyword #:asset? (slot-definition-options slot)))
+
+(define-method (compute-getter-method (class <meta-node>) slot)
+  (if (asset-slot? slot)
+      (make <method>
+        #:specializers (list class)
+        #:procedure (let ((slot-name (slot-definition-name slot)))
+                      (lambda (obj)
+                        (let ((value (slot-ref obj slot-name)))
+                          (if (is-a? value <asset>)
+                              (asset-ref value)
+                              value)))))
+      (next-method)))
+
+
+(define-class <developer-meta-node> (<meta-node> <redefinable-class>))
+
+(define-method (compute-setter-method (class <developer-meta-node>) slot)
+  (if (asset-slot? slot)
+      (make <method>
+        #:specializers (list class <top>)
+        #:procedure (let ((slot-name (slot-definition-name slot)))
+                      (lambda (obj new)
+                        (let ((old (and (slot-bound? obj slot-name)
+                                        (slot-ref obj slot-name))))
+                          (when (is-a? old <asset>)
+                            (remove-subscriber old obj slot-name))
+                          (when (is-a? new <asset>)
+                            (add-subscriber new obj slot-name))
+                          (slot-set! obj slot-name new)))))
+      (next-method)))
+
+(define-method (make (class <developer-meta-node>) . initargs)
+  (let ((instance (next-method)))
+    ;; Subscribe for updates to all asset slots.
+    (for-each (lambda (slot)
+                (when (asset-slot? slot)
+                  (let* ((slot-name (slot-definition-name slot))
+                         (value (and (slot-bound? instance slot-name)
+                                     (slot-ref instance slot-name))))
+                    (when (is-a? value <asset>)
+                      (add-subscriber value instance slot-name)))))
+              (class-slots class))
+    instance))
+
 (define-class <node> ()
   ;; Auto-generated process-unique identifier.  As of now I don't see
   ;; a need for globally unique identifiers and this is much faster.
@@ -92,8 +141,8 @@
   (paused? #:accessor paused? #:init-form #f #:init-keyword #:paused?)
   ;; Use redefinable classes when in dev mode.
   #:metaclass (if developer-mode?
-                  <redefinable-class>
-                  <class>))
+                  <developer-meta-node>
+                  <meta-node>))
 
 (define-method (initialize (node <node>) initargs)
   (next-method)
@@ -148,6 +197,9 @@ represented as a ratio in the range [0, 1]."
   "Perform task now that NODE has left the current scene."
   #t)
 
+(define-method (on-asset-reload (node <node>) slot-name asset)
+  #t)
+
 
 ;;;
 ;;; Life cycle state management