From c486ff8e897fda698ee1d2efcb982eb30ffca24a Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 25 Oct 2014 11:20:03 -0400
Subject: render: Add simple renderer.

* sly/render/renderer.scm: New file.
* Makefile.am (SOURCES): Add it.
---
 Makefile.am             |   1 +
 sly/render/renderer.scm | 110 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 111 insertions(+)
 create mode 100644 sly/render/renderer.scm

diff --git a/Makefile.am b/Makefile.am
index fbf85ae..d84c5ac 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -54,6 +54,7 @@ SOURCES = 					\
   sly/window.scm					\
   sly/joystick.scm				\
   sly/render/vertex-array.scm			\
+  sly/render/renderer.scm			\
   $(WRAPPER_SOURCES)
 
 WRAPPER_SOURCES =				\
diff --git a/sly/render/renderer.scm b/sly/render/renderer.scm
new file mode 100644
index 0000000..857c8bc
--- /dev/null
+++ b/sly/render/renderer.scm
@@ -0,0 +1,110 @@
+;;; 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 renderer.
+;;
+;;; Code:
+
+(define-module (sly render renderer)
+  #:use-module (system foreign)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:use-module (gl)
+  #:use-module (gl low-level)
+  #:use-module (sly camera)
+  #:use-module (sly shader)
+  #:use-module (sly texture)
+  #:use-module (sly transform)
+  #:use-module (sly render vertex-array)
+  #:export (make-render-op render-op?
+            render-op-transform render-op-vertex-array
+            render-op-texture render-op-shader
+            render-op-uniforms
+            make-renderer renderer?
+            renderer-cameras renderer-ops
+            render))
+
+;; Representation of a single OpenGL render call.
+(define-record-type <render-op>
+  (%make-render-op transform vertex-array texture shader uniforms
+                   depth-test?)
+  render-op?
+  (transform render-op-transform)
+  (vertex-array render-op-vertex-array)
+  (texture render-op-texture)
+  (shader render-op-shader)
+  (uniforms render-op-uniforms)
+  (depth-test? render-op-depth-test?))
+
+(define* (make-render-op #:optional #:key (transform identity-transform)
+                         (vertex-array #f) (texture #f) (shader #f)
+                         (uniforms '()) (depth-test? #t))
+  "Create a new render operation object.  Optional arguments include:
+TRANSFORM, a model transformation matrix.  VERTEX-ARRAY, the geometry
+container.  TEXTURE, the texture object to bind.  SHADER, the shader
+program to bind.  UNIFORMS, the variables to be passed to the shader.
+And DEPTH-TEST?, a flag that determines whether the depth buffer is
+activated or not."
+  (%make-render-op transform vertex-array texture shader uniforms depth-test?))
+
+(define-syntax-rule (with-texture-maybe texture body ...)
+  (if texture
+      (with-texture texture body ...)
+      (begin body ...)))
+
+(define (apply-render-op view op)
+  "Render the contents of OP.  The transform of OP is multiplied by
+the VIEW transform before rendering and passed to the shader as the
+uniform variable 'mvp'."
+  (match op
+    (($ <render-op> transform vertex-array texture shader uniforms depth-test?)
+     (when depth-test?
+       (gl-enable (enable-cap depth-test)))
+     (with-shader-program shader
+       (for-each (lambda (uniform)
+                   (match uniform
+                     ((name value)
+                      (uniform-set! shader name value))))
+                 `(("mvp" ,(transform* view transform))
+                   ,@uniforms))
+       (with-vertex-array vertex-array
+         (with-texture-maybe texture
+           (glDrawElements (begin-mode triangles)
+                           (vertex-array-length vertex-array)
+                           (data-type unsigned-int)
+                           %null-pointer))))
+     (when depth-test?
+       (gl-disable (enable-cap depth-test))))))
+
+(define-record-type <renderer>
+  (make-renderer cameras ops)
+  renderer?
+  (cameras renderer-cameras)
+  (ops renderer-ops))
+
+(define (render renderer)
+  "Apply all of the render operations in RENDERER.  The render
+operations are applied once for each camera."
+  (define (render-with-camera camera)
+    (let ((view (transform* (camera-projection camera)
+                            (camera-location camera))))
+      (for-each (cut apply-render-op view <>)
+                (renderer-ops renderer))))
+  (for-each render-with-camera (renderer-cameras renderer)))
-- 
cgit v1.2.3