summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2014-10-28 19:55:03 -0400
committerDavid Thompson <dthompson2@worcester.edu>2014-10-28 19:55:03 -0400
commit901afdd86ebae15796189762203d63d193f3d21e (patch)
tree30516a633cf7e08e8a1ebc20d88fe66ed17a8365
parent6dbafc2f271415cae39442e17f73a51747de439e (diff)
render: Add framebuffer module.
* sly/render/framebuffer.scm: New file. * Makefile.am (SOURCES): Add it.
-rw-r--r--Makefile.am1
-rw-r--r--sly/render/framebuffer.scm118
2 files changed, 119 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am
index 86e9d15..397f639 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -54,6 +54,7 @@ SOURCES = \
sly/joystick.scm \
sly/render/utils.scm \
sly/render/camera.scm \
+ sly/render/framebuffer.scm \
sly/render/vertex-array.scm \
sly/render/renderer.scm \
$(WRAPPER_SOURCES)
diff --git a/sly/render/framebuffer.scm b/sly/render/framebuffer.scm
new file mode 100644
index 0000000..c8e891f
--- /dev/null
+++ b/sly/render/framebuffer.scm
@@ -0,0 +1,118 @@
+;;; 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:
+;;
+;; Render to texture.
+;;
+;;; Code:
+
+(define-module (sly render framebuffer)
+ #:use-module ((system foreign) #:select (bytevector->pointer %null-pointer))
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-9)
+ #:use-module (gl)
+ #:use-module (gl low-level)
+ #:use-module (gl enums)
+ #:use-module (sly wrappers gl)
+ #:export (make-framebuffer
+ framebuffer?
+ framebuffer-id framebuffer-renderbuffer-id
+ framebuffer-texture
+ with-framebuffer))
+
+(define (generate-framebuffer)
+ "Generate a new OpenGL framebuffer object."
+ (let ((bv (u32vector 1)))
+ (glGenFramebuffers 1 (bytevector->pointer bv))
+ (u32vector-ref bv 0)))
+
+(define (generate-renderbuffer)
+ "Generate a new OpenGL renderbuffer object."
+ (let ((bv (u32vector 1)))
+ (glGenRenderbuffers 1 (bytevector->pointer bv))
+ (u32vector-ref bv 0)))
+
+(define-record-type <framebuffer>
+ (%make-framebuffer id renderbuffer-id texture)
+ framebuffer?
+ (id framebuffer-id)
+ (renderbuffer-id framebuffer-renderbuffer-id)
+ (texture framebuffer-texture))
+
+(define make-framebuffer
+ (let ((draw-buffers (u32vector (version-3-0 color-attachment0))))
+ (lambda (width height)
+ "Create a new framebuffer that renders to a texture with
+dimensions WIDTH x HEIGHT."
+ (let ((framebuffer-id (generate-framebuffer))
+ (renderbuffer-id (generate-renderbuffer))
+ (texture-id (gl-generate-texture)))
+ (glBindFramebuffer (version-3-0 framebuffer) framebuffer-id)
+ ;; Setup texture that will be attached to the framebuffer.
+ (with-gl-bind-texture (texture-target texture-2d) texture-id
+ (gl-texture-parameter (texture-target texture-2d)
+ (texture-parameter-name texture-min-filter)
+ (texture-min-filter nearest))
+ (gl-texture-parameter (texture-target texture-2d)
+ (texture-parameter-name texture-mag-filter)
+ (texture-mag-filter nearest))
+ (gl-texture-image-2d (texture-target texture-2d)
+ 0
+ (pixel-format rgb)
+ width
+ height
+ 0
+ (pixel-format rgb)
+ (color-pointer-type unsigned-byte)
+ %null-pointer)
+ ;; Setup depth buffer.
+ (glBindRenderbuffer (version-3-0 renderbuffer)
+ renderbuffer-id)
+ (glRenderbufferStorage (version-3-0 renderbuffer)
+ (pixel-format depth-component)
+ width
+ height)
+ (glFramebufferRenderbuffer (version-3-0 framebuffer)
+ (arb-framebuffer-object depth-attachment)
+ (version-3-0 renderbuffer)
+ renderbuffer-id)
+ ;; Setup framebuffer.
+ (glFramebufferTexture2D (version-3-0 framebuffer)
+ (version-3-0 color-attachment0)
+ (texture-target texture-2d)
+ texture-id
+ 0)
+ (glDrawBuffers 1 (bytevector->pointer draw-buffers))
+ ;; Check for errors.
+ (unless (= (glCheckFramebufferStatus (version-3-0 framebuffer))
+ (version-3-0 framebuffer-complete))
+ (error "Framebuffer cannot be created")))
+ ;; Clean up.
+ (glBindRenderbuffer (version-3-0 renderbuffer) 0)
+ (glBindFramebuffer (version-3-0 framebuffer) 0)
+ ;; Build high-level framebuffer object.
+ (let ((texture ((@@ (sly texture) %make-texture)
+ texture-id #f width height 0 0 1 1)))
+ (%make-framebuffer framebuffer-id renderbuffer-id texture))))))
+
+(define-syntax-rule (with-framebuffer framebuffer body ...)
+ (begin
+ (glBindFramebuffer (version-3-0 framebuffer)
+ (framebuffer-id framebuffer))
+ body ...
+ (glBindFramebuffer (version-3-0 framebuffer) 0)))