First commit!

1 files changed, 198 insertions, 0 deletions

diff --git a/starling/node.scm b/starling/node.scm
new file mode 100644
index 0000000..2d4b1c3
--- /dev/null
+++ b/starling/node.scm
@@ -0,0 +1,198 @@
+;;; Starling Game Engine
+;;; Copyright © 2018 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
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Starling.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Base class for all game objects.
+;;
+;;; Code:
+
+(define-module (starling node)
+  #:use-module (chickadee scripting)
+  #:use-module (oop goops)
+  #:export (<node>
+            name
+            rank
+            parent
+            children
+            agenda
+            booted?
+            active?
+            on-boot
+            on-enter
+            on-exit
+            activate
+            deactivate
+            update
+            update*
+            render
+            render*
+            child-ref
+            &
+            attach-to
+            detach))
+
+(define-class <node> ()
+  ;; Symbolic name.  Used for easy lookup of children within a parent.
+  (name #:accessor name #:init-form (gensym "anonymous-") #:init-keyword #:name)
+  ;; An integer value that determines priority order for
+  ;; updating/rendering.
+  (rank #:getter rank #:init-value 0 #:init-keyword #:rank)
+  ;; The node that this node is attached to.  A node may only have one
+  ;; parent.
+  (parent #:accessor parent #:init-form #f)
+  ;; List of children ordered by rank.
+  (children #:accessor children #:init-form '())
+  ;; Children indexed by name for fast lookup.
+  (children-map #:getter children-map #:init-form (make-hash-table))
+  ;; Script scheduler.
+  (agenda #:getter agenda #:init-form (make-agenda))
+  ;; Flips to #t upon first entering a scene.
+  (booted? #:accessor booted? #:init-form #f)
+  ;; Flips to #t when node is part of current scene.
+  (active? #:accessor active? #:init-form #f))
+
+(define (for-each-child proc node)
+  (for-each proc (children node)))
+
+
+;;;
+;;; Life cycle event handlers
+;;;
+
+(define-method (update (node <node>) dt)
+  "Advance simulation of NODE by the time delta DT."
+  #t)
+
+(define-method (update* (node <node>) dt)
+  "Update NODE and all of its children.  DT is the amount of time
+passed since the last update, in milliseconds."
+  ;; Update children first, recursively.
+  (for-each-child (lambda (child) (update* child dt)) node)
+  ;; Update script, then "physics" (or whatever the update method is
+  ;; doing).
+  (with-agenda (agenda node)
+    (update-agenda 1)
+    (update node dt)))
+
+(define-method (render (node <node>) alpha)
+  "Render NODE.  ALPHA is the distance between the previous update and
+the next update represented as a ratio in the range [0, 1]."
+  #t)
+
+(define-method (render* (node <node>) alpha)
+  "Render NODE and all of its children, recursively.
+ALPHA is the distance between the previous update and the next update
+represented as a ratio in the range [0, 1]."
+  (render node alpha)
+  (for-each-child (lambda (child) (render child alpha)) node))
+
+(define-method (on-boot (node <node>))
+  "Perform initialization tasks for NODE."
+  #t)
+
+(define-method (on-enter (node <node>))
+  "Perform task now that NODE has entered the current scene."
+  #t)
+
+(define-method (on-exit (node <node>))
+  "Perform task now that NODE has left the current scene."
+  #t)
+
+
+;;;
+;;; Life cycle state management
+;;;
+
+(define-method (boot (node <node>))
+  "Prepare NODE to enter the game world for the first time."
+  (on-boot node)
+  (set! (booted? node) #t))
+
+(define-method (activate (node <node>))
+  "Mark NODE and all of its children as active."
+  ;; First time activating?  We must boot!
+  (with-agenda (agenda node)
+    (unless (booted? node) (boot node))
+    (set! (active? node) #t)
+    (on-enter node)
+    (for-each-child activate node)))
+
+(define-method (deactivate (node <node>))
+  "Mark NODE and all of its children as inactive."
+  (with-agenda (agenda node)
+    (set! (active? node) #f)
+    (on-exit node)
+    (for-each-child deactivate node)))
+
+
+;;;
+;;; Child management
+;;;
+
+(define-method (child-ref (parent <node>) name)
+  "Return the child node of PARENT whose name is NAME."
+  (hash-ref (children-map parent) name))
+
+(define-syntax &
+  (syntax-rules ()
+    ((_ parent child-name)
+     (child-ref parent child-name))
+    ((_ parent child-name . rest)
+     (& (child-ref parent child-name) . rest))))
+
+(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
+  ;; any of them cannot be attached.
+  (for-each (lambda (child)
+              (when (parent child)
+                (error "node already has a parent:" child))
+              (when (child-ref new-parent (name child))
+                (error "node name taken:" (name child))))
+            new-children)
+  ;; Adopt the children and sort them by their rank so that
+  ;; updating/rendering happens in the desired order.
+  (set! (children new-parent)
+        (sort (append new-children (children new-parent))
+              (lambda (a b)
+                (< (rank a) (rank b)))))
+  ;; Mark the children as having parents and add them to the name
+  ;; index for quick lookup later.
+  (for-each (lambda (child)
+              (set! (parent child) new-parent)
+              ;; If the parent is active, that means the new children
+              ;; must also be active.
+              (when (active? new-parent)
+                (activate child))
+              (hashq-set! (children-map new-parent) (name child) child))
+            new-children))
+
+(define-method (detach (node <node>))
+  "Detach NODE from its parent."
+  (let ((p (parent node)))
+    (unless p
+      (error "node has no parent" node))
+    (set! (children parent) (delq node (children parent)))
+    (hashq-remove! (children-map parent) (name node))
+    ;; Detaching deactives the node and all of its children.
+    (when (active? node)
+      (deactivate node))
+    (set! (parent node) #f)))
+
+(define-method (detach . nodes)
+  "Detach all NODES from their respective parents."
+  (for-each detach nodes))