blob: ed3f2536feb68d6948fed2f571b7ee45cbdc17ba (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
;;; 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 render texture)
#:use-module (sly wrappers gl)
#:export (make-framebuffer
framebuffer?
framebuffer-null?
framebuffer-id framebuffer-renderbuffer-id
framebuffer-texture
null-framebuffer
apply-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 null-framebuffer
(%make-framebuffer 0 0 null-texture))
(define (framebuffer-null? framebuffer)
"Return #t if FRAMEBUFFER is the null framebuffer."
(eq? null-framebuffer framebuffer))
(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 render texture) %make-texture)
texture-id #f width height 0 0 1 1)))
(%make-framebuffer framebuffer-id renderbuffer-id texture))))))
(define (apply-framebuffer framebuffer)
(glBindFramebuffer (version-3-0 framebuffer)
(framebuffer-id framebuffer)))
|
