Add watchable slots to <meta-node> metaclass.

1 files changed, 19 insertions, 0 deletions

diff --git a/starling/node.scm b/starling/node.scm
index 8e16c4f..578ce2c 100644
--- a/starling/node.scm
+++ b/starling/node.scm
@@ -36,6 +36,7 @@
             visible?
             paused?
             for-each-child
+            on-change
             on-boot
             on-enter
             on-exit
@@ -66,6 +67,9 @@
 (define-method (asset-slot? (slot <slot>))
   (get-keyword #:asset? (slot-definition-options slot)))
 
+(define-method (watch-slot? (slot <slot>))
+  (get-keyword #:watch? (slot-definition-options slot)))
+
 (define-method (compute-getter-method (class <meta-node>) slot)
   (if (asset-slot? slot)
       (make <method>
@@ -78,6 +82,21 @@
                               value)))))
       (next-method)))
 
+(define-generic on-change)
+
+(define-method (compute-setter-method (class <meta-node>) slot)
+  (let ((method (next-method)))
+    (if (watch-slot? slot)
+        (let ((slot-name (slot-definition-name slot))
+              (proc (method-procedure method)))
+          (make <method>
+            #:specializers (list class <top>)
+            #:procedure (lambda (obj new)
+                          (let ((old (and (slot-bound? obj slot-name)
+                                          (slot-ref obj slot-name))))
+                            (proc obj new)
+                            (on-change obj slot-name old new)))))
+        method)))
 
 (define-class <developer-meta-node> (<meta-node> <redefinable-class>))