summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am2
-rw-r--r--sly/render/group.scm126
-rw-r--r--sly/render/model.scm126
3 files changed, 254 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am
index ea11a5f..929f9ba 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -48,6 +48,8 @@ SOURCES = \
sly/render/font.scm \
sly/render/framebuffer.scm \
sly/render/mesh.scm \
+ sly/render/model.scm \
+ sly/render/group.scm \
sly/render/texture.scm \
sly/render/scene.scm \
sly/render/shader.scm \
diff --git a/sly/render/group.scm b/sly/render/group.scm
new file mode 100644
index 0000000..e3e53a3
--- /dev/null
+++ b/sly/render/group.scm
@@ -0,0 +1,126 @@
+;;; Sly
+;;; Copyright (C) 2014 David Thompson <davet@gnu.org>
+;;;
+;;; Sly 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.
+;;;
+;;; Sly 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:
+;;
+;; Hierarchy of renderable objects using a directed acyclic graph
+;; structure.
+;;
+;;; Code:
+
+(define-module (sly render group)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-9)
+ #:use-module (sly math transform)
+ #:use-module (sly render shader)
+ #:use-module (sly render texture)
+ #:use-module (sly render utils)
+ #:use-module (sly render camera)
+ #:use-module (sly render context)
+ #:use-module (sly render model)
+ #:export (make-group group
+ group?
+ group-transform group-visible? group-children
+ draw-group
+ move place show))
+
+;;;
+;;; Group
+;;;
+
+;; The composite object of the scene graph. Groups have zero or more
+;; children, which may be groups or models.
+(define-record-type <group>
+ (%make-group transform visible? children)
+ group?
+ (transform group-transform)
+ (visible? group-visible?)
+ (children group-children))
+
+(define* (make-group children #:optional #:key (transform identity-transform)
+ (visible? #t))
+ "Create a new group containing CHILDREN in which each child is
+rendered relative to TRANSFORM. The VISIBLE? flag determines whether
+or not to render child nodes."
+ (%make-group transform visible? children))
+
+(define (%draw-group group parent-transform view context)
+ (match group
+ (($ <group> transform visible? children)
+ (when visible?
+ (with-temp-transform context world-transform
+ (transform*! world-transform transform parent-transform)
+ (for-each (lambda (child)
+ (let ((draw (match child
+ ((? group? group) %draw-group)
+ ((? model? model) draw-model))))
+ (draw child world-transform view context)))
+ children))))))
+
+(define (set-transform-identity! t)
+ (let ((matrix (transform-matrix t)))
+ (array-set! matrix 1 0 0)
+ (array-set! matrix 0 0 1)
+ (array-set! matrix 0 0 2)
+ (array-set! matrix 0 0 3)
+ (array-set! matrix 0 1 0)
+ (array-set! matrix 1 1 1)
+ (array-set! matrix 0 1 2)
+ (array-set! matrix 0 1 3)
+ (array-set! matrix 0 2 0)
+ (array-set! matrix 0 2 1)
+ (array-set! matrix 1 2 2)
+ (array-set! matrix 0 2 3)
+ (array-set! matrix 0 3 0)
+ (array-set! matrix 0 3 1)
+ (array-set! matrix 0 3 2)
+ (array-set! matrix 1 3 3)))
+
+(define (draw-group group camera context)
+ "Draw the scene defined by GROUP as viewed by CAMERA, with the given
+render CONTEXT."
+ (with-temp-transform context view
+ (transform*! view
+ (camera-location camera)
+ (camera-projection camera))
+ (with-temp-transform context base-transform
+ (set-transform-identity! base-transform)
+ (apply-viewport (camera-viewport camera))
+ (%draw-group group base-transform view context))))
+
+;;;
+;;; Utility Procedures
+;;;
+
+(define (group . children)
+ "Create a new group containing the list of CHILDREN."
+ (make-group children))
+
+(define (move position . children)
+ "Create a new group in which the list of CHILDREN are translated by
+the vector POSITION."
+ (make-group children #:transform (translate position)))
+
+(define (place transform . children)
+ "Create a new group in which the tranformation matrices of the
+CHILDREN are multiplied by TRANSFORM."
+ (make-group children #:transform transform))
+
+(define (show visible? . children)
+ "Create a new group in which the visibility of the list of
+CHILDREN is determined by the VISIBLE? flag."
+ (make-group children #:visible? visible?))
diff --git a/sly/render/model.scm b/sly/render/model.scm
new file mode 100644
index 0000000..c766b76
--- /dev/null
+++ b/sly/render/model.scm
@@ -0,0 +1,126 @@
+;;; Sly
+;;; Copyright (C) 2014 David Thompson <davet@gnu.org>
+;;;
+;;; Sly 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.
+;;;
+;;; Sly 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:
+;;
+;; OpenGL rendering state.
+;;
+;;; Code:
+
+(define-module (sly render model)
+ #:use-module (system foreign)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (gl)
+ #:use-module (gl low-level)
+ #:use-module (sly math transform)
+ #:use-module (sly math vector)
+ #:use-module (sly math rect)
+ #:use-module (sly render shader)
+ #:use-module (sly render texture)
+ #:use-module (sly render utils)
+ #:use-module (sly render camera)
+ #:use-module (sly render color)
+ #:use-module (sly render context)
+ #:use-module (sly render vertex-array)
+ #:export (make-model model model-inherit
+ model?
+ model-mesh model-texture model-shader model-color
+ model-blend-mode model-depth-test?
+ draw-model
+ paint blend))
+
+;; Representation of a single OpenGL render call.
+(define-record-type <model>
+ (%make-model mesh texture shader color blend-mode depth-test?)
+ model?
+ ;; This is a vertex array.
+ ;; TODO: Rename <vertex-array> to mesh and remove old mesh type.
+ (mesh model-mesh)
+ (texture model-texture)
+ (shader model-shader)
+ (color model-color)
+ (blend-mode model-blend-mode)
+ (depth-test? model-depth-test?))
+
+(define* (make-model #:optional #:key (mesh #f) (texture #f) (shader #f)
+ (color white) (blend-mode default-blend-mode)
+ (depth-test? #t))
+ "Create a new model from MESH and the given rendering state. When
+rendering, TEXTURE and SHADER are bound, BLEND-MODE and DEPTH-TEST?
+are set, and the COLOR uniform variable is set."
+ (%make-model mesh texture shader color blend-mode depth-test?))
+
+(define model make-model)
+
+(define kwargs->alist
+ (match-lambda
+ (((? keyword? key) value . rest)
+ (cons (cons (keyword->symbol key) value) (kwargs->alist rest)))
+ (() '())))
+
+(define model-inherit
+ (let* ((fields (record-type-fields <model>))
+ (field-indices (iota (length fields))))
+ (lambda (original . kwargs)
+ "Create a new model based on the fields of ORIGINAL, only
+changing the fields specified in KWARGS."
+ (let ((field+value (kwargs->alist kwargs)))
+ (apply %make-model
+ (map (lambda (field index)
+ (let ((override (find (match-lambda
+ ((k . v)
+ (eq? field k)))
+ field+value)))
+ (if override
+ (cdr override)
+ (struct-ref original index))))
+ fields field-indices))))))
+
+(define (draw-model model world-transform view context)
+ "Render MODEL by applying its transform (multiplied by VIEW), texture,
+shader, vertex array, uniforms, blend mode, etc. to the render
+CONTEXT."
+ (match model
+ (($ <model> mesh texture shader color blend-mode depth-test?)
+ (with-temp-transform context mvp
+ (transform*! mvp world-transform view)
+ (set-render-context-depth-test?! context depth-test?)
+ (set-render-context-blend-mode! context blend-mode)
+ (set-render-context-shader! context shader)
+ (set-render-context-vertex-array! context mesh)
+ (set-render-context-texture! context texture)
+ ;; TODO: Support user-defined uniforms.
+ (uniform-set! shader "mvp" mvp)
+ (uniform-set! shader "color" color)
+ (glDrawElements (begin-mode triangles)
+ (vertex-array-length mesh)
+ (data-type unsigned-int)
+ %null-pointer)))))
+
+;;;
+;;; Utility Procedures
+;;;
+
+(define (paint color model)
+ "Create a copy of MODEL, but with a new COLOR."
+ (model-inherit model #:color color))
+
+(define (blend blend-mode model)
+ "Create a copy of MODEL, but with a new BLEND-MODE."
+ (model-inherit model #:blend-mode blend-mode))