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
126
127
128
129
130
131
132
133
134
135
136
137
|
;;; 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 render shader)
#:use-module (sly render texture)
#:use-module (sly math transform)
#:use-module (sly math vector)
#:use-module (sly render utils)
#:use-module (sly render camera)
#:use-module (sly render context)
#: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-blend-mode render-op-uniforms
transform-render-op
make-renderer renderer?
renderer-ops
render))
;; Representation of a single OpenGL render call.
(define-record-type <render-op>
(%make-render-op transform vertex-array texture shader uniforms
blend-mode 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)
(blend-mode render-op-blend-mode)
(depth-test? render-op-depth-test?))
(define* (make-render-op #:optional #:key (transform identity-transform)
(vertex-array #f) (texture #f) (shader #f)
(uniforms '()) (blend-mode default-blend-mode)
(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
blend-mode depth-test?))
(define* (transform-render-op op transform)
"Return a new render operation object that is the same as OP, but
with its transformation matrix multiplied by TRANSFORM."
(match op
(($ <render-op> local-transform vertex-array texture shader uniforms
blend-mode depth-test?)
(%make-render-op (transform* transform local-transform) vertex-array
texture shader uniforms blend-mode depth-test?))))
(define apply-render-op
;; Rendering should only ever happen from the main thread, so
;; mutating this transform is just fine.
(let ((mvp (make-transform 0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0)))
(lambda (context view op)
"Render OP by applying its transform (multiplied by VIEW), texture,
shader, vertex array, uniforms, blend mode, etc. to the render
CONTEXT."
(match op
(($ <render-op> transform vertex-array texture shader uniforms
blend-mode depth-test?)
(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 vertex-array)
(set-render-context-texture! context texture)
(transform*! mvp transform view)
(for-each (lambda (uniform)
(match uniform
((name value)
(uniform-set! shader name value))))
`(("mvp" ,mvp)
,@uniforms))
(glDrawElements (begin-mode triangles)
(vertex-array-length vertex-array)
(data-type unsigned-int)
%null-pointer))))))
(define-record-type <renderer>
(make-renderer context cameras ops)
renderer?
(context renderer-context)
(cameras renderer-cameras)
(ops renderer-ops))
(define render
(let ((view (make-transform 0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0)))
(lambda (renderer)
"Apply all of the render operations in RENDERER. The render
operations are applied once for each camera."
(let ((context (renderer-context renderer)))
(with-render-context context
(for-each (lambda (camera)
(transform*! view
(camera-location camera)
(camera-projection camera))
(for-each (cut apply-render-op context view <>)
(renderer-ops renderer)))
(renderer-cameras renderer)))))))
|
