From 901afdd86ebae15796189762203d63d193f3d21e Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 28 Oct 2014 19:55:03 -0400
Subject: render: Add framebuffer module.

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

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)))
-- 
cgit v1.2.3