summaryrefslogtreecommitdiff
path: root/starling/node.scm
diff options
context:
space:
mode:
Diffstat (limited to 'starling/node.scm')
-rw-r--r--starling/node.scm56
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