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