node: Add on-attach and on-detach methods.

1 files changed, 15 insertions, 2 deletions

diff --git a/starling/node.scm b/starling/node.scm
index 07fef48..920a9bd 100644
--- a/starling/node.scm
+++ b/starling/node.scm
@@ -1,5 +1,5 @@
 ;;; Starling Game Engine
-;;; Copyright © 2018 David Thompson <davet@gnu.org>
+;;; Copyright © 2018, 2019 David Thompson <davet@gnu.org>
 ;;;
 ;;; This program is free software: you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -50,6 +50,8 @@
             render-tree
             child-ref
             &
+            on-attach
+            on-detach
             attach-to
             detach
             run-script
@@ -205,6 +207,12 @@ represented as a ratio in the range [0, 1]."
     ((_ parent child-name . rest)
      (& (child-ref parent 'child-name) . rest))))
 
+(define-method (on-attach (parent <node>) (child <node>))
+  #t)
+
+(define-method (on-detach (parent <node>) (child <node>))
+  #t)
+
 (define-method (attach-to (new-parent <node>) . new-children)
     "Attach NEW-CHILDREN to NEW-PARENT."
   ;; Validate all children first.  The whole operation will fail if
@@ -230,6 +238,10 @@ represented as a ratio in the range [0, 1]."
               ;; must also be active.
               (when (active? new-parent)
                 (activate child)))
+            new-children)
+  ;; Notify parent of attach event.
+  (for-each (lambda (child)
+              (on-attach new-parent child))
             new-children))
 
 (define-method (detach (node <node>))
@@ -242,7 +254,8 @@ represented as a ratio in the range [0, 1]."
     ;; Detaching deactives the node and all of its children.
     (when (active? node)
       (deactivate node))
-    (set! (parent node) #f)))
+    (set! (parent node) #f)
+    (on-detach p node)))
 
 (define-method (detach . nodes)
   "Detach all NODES from their respective parents."