diff options
Diffstat (limited to 'sly/scene-graph.scm')
| -rw-r--r-- | sly/scene-graph.scm | 217 |
1 files changed, 217 insertions, 0 deletions
diff --git a/sly/scene-graph.scm b/sly/scene-graph.scm new file mode 100644 index 0000000..de191fe --- /dev/null +++ b/sly/scene-graph.scm @@ -0,0 +1,217 @@ +;;; Sly +;;; Copyright (C) 2014 David Thompson <dthompson2@worcester.edu> +;;; +;;; 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 this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Scene graph API. +;; +;;; Code: + +(define-module (sly scene-graph) + #:use-module (ice-9 hash-table) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (gl) + #:use-module (sly wrappers gl) + #:use-module (sly color) + #:use-module (sly rect) + #:use-module (sly signal) + #:use-module (sly transform) + #:use-module (sly vector) + #:export (make-scene-node + scene-node? + scene-node-transform + scene-node-color + scene-node-texture + scene-node-shader + scene-node-arrays + scene-node-children + draw-scene-node)) + +;; Types of scene nodes: +;; - Group: position, scale, rotation, children +;; - Vertices: vertex arrays + style (shader, texture) + +;; All nodes have the following +;; - transform +;; - children +;; - shader +;; - texture +;; - vertex array + +;; (define (sprite) +;; (make-scene-node #:transform (make-transform* #:translate (vector2 100 100)) +;; #:color white +;; #:texture (load-texture "images/p1_front.png") +;; #:arrays `((vertex float ,vertices +;; #:stride ,texture-vertex-size +;; #:offset ,x-offset) +;; (texture float ,vertices +;; #:stride ,texture-vertex-size +;; #:offset ,s-offset)) +;; #:shader sprite-shader)) + +;;; +;;; Meshes +;;; + +(define-vertex sprite-vertex + (position vector2) + (texcoord vector2)) + + + +(define-record-type <geometry> + (make-geometry primitive size arrays) + geometry? + (primitive geometry-primitive) + (size geometry-size) + (arrays geometry-arrays)) + +(define gl-primitives + (alist->hash-table + '((points . 0) + (lines . 1) + (line-loop . 2) + (line-strip . 3) + (triangles . 4) + (triangle-strip . 5) + (triangle-fan . 6) + (quads . 7) + (quad-strip . 8) + (polygon . 9)))) + +(define gl-arrays + (alist->hash-table + '((vertex-array . 32884) + (normal-array . 32885) + (color-array . 32886) + (index-array . 32887) + (texture-coord-array . 32888) + (edge-flag-array . 32889)))) + +(define gl-types + (alist->hash-table + '((byte . 5120) + (unsigned-byte . 5121) + (short . 5122) + (unsigned-short . 5123) + (int . 5124) + (unsigned-int . 5125) + (float . 5126) + (#{2-bytes}# . 5127) + (#{3-bytes}# . 5128) + (#{4-bytes}# . 5129) + (double . 5130) + (double-ext . 5130)))) + +(define (draw-geometry geometry) + (define (iter arrays) + (cond + ((null? arrays) + (let ((primitive (hash-ref gl-primitives (geometry-primitive geometry)))) + (gl-draw-arrays primitive 0 (geometry-size geometry)))) + (else + (match (car arrays) + ((array-type data-type vertices . rest) + (with-gl-client-state (hash-ref gl-arrays array-type) + (set-gl-vertex-array (hash-ref gl-types data-type) vertices) + (iter (cdr arrays)))))))) + (iter (geometry-arrays geometry))) + +(define foo + '(vertex float #(1 2 3 4) #:stride 4 #:offset 8)) + +(match foo + ((array-type data-type vertices . kwargs) + (format #t "~a ~a ~a\n" array-type data-type vertices) + (let lp ((kwargs kwargs)) + (match kwargs + ((key value . rest) + (format #t "~a - ~a\n" key value) + (lp rest)) + (_ #f))))) + +(define-record-type <scene-node> + (%make-scene-node transform color texture shader arrays children) + scene-node? + (transform scene-node-transform) + (color scene-node-color) + (texture scene-node-texture) + (shader scene-node-shader) + (arrays scene-node-arrays) + (primitive scene-node-primitive) + (children scene-node-children)) + +(define* (make-scene-node #:optional #:key (transform identity-transform) + (color white) (texture #f) (shader #f) + (arrays '()) (children '())) + (%make-scene-node transform color texture shader arrays children)) + +(define* (draw-scene-node node #:optional (transform identity-transform)) + (let ((transform (transform* transform (scene-node-transform node)))) + ;; WRITEME + (for-each (cut draw-scene-node <> transform) + (scene-node-children node)))) + +(define (draw-arrays node) + #f) + +;; (define (draw-sprite transform) +;; (display "drew a sprite\n")) + +;; (define (draw-label transform) +;; (display "drew a label\n")) + +;; (define s +;; (make-scene-node +;; #:position (vector2 100 100) +;; #:size (vector2 200 200) +;; #:proc draw-sprite +;; #:children +;; (list (make-scene-node +;; #:position (vector2 50 50) +;; #:size (vector2 50 50) +;; #:rotation 45 +;; #:proc draw-label)))) + +;; (draw-scene-node s) + +;; (define scene +;; (scene-graph +;; (sprite +;; (position (vector2 320 240)) +;; (texture "logo.png") +;; (anchor 'center)) +;; (label +;; (position (vector2 320 160)) +;; (text "Some Really Awesome Game") +;; (anchor 'bottom-center)) +;; (group +;; (position (vector2 160 300)) +;; (children +;; (sprite +;; (position (vector2 16 16)) +;; (texture "load-game.png")) +;; (sprite +;; (position (vector2 64 16)) +;; (texture "new-game.png")) +;; (sprite +;; (position (vector2 96 16)) +;; (texture "options.png")))))) |