diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | sly/render/group.scm | 126 | ||||
| -rw-r--r-- | sly/render/model.scm | 126 |
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)) |