blob: 447dac09e47a39f9fb89d2c8fbe812d3fbda3d76 (
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
|
;;; 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:
;;
;; Manages OpenGL state and reduces state changes.
;;
;;; Code:
(define-module (sly render context)
#:use-module (srfi srfi-9)
#:use-module (gl)
#:use-module (gl enums)
#:use-module (gl low-level)
#:use-module (sly wrappers gl)
#:use-module (sly shader)
#:use-module (sly render texture)
#:use-module (sly render utils)
#:use-module (sly render vertex-array)
#:export (make-render-context
render-context?
with-render-context
render-context-blend-mode set-render-context-blend-mode!
render-context-depth-test? set-render-context-depth-test?!
render-context-texture set-render-context-texture!
render-context-shader set-render-context-shader!
render-context-vertex-array set-render-context-vertex-array!))
(define-record-type <render-context>
(%make-render-context blend-mode depth-test? texture shader vertex-array)
render-context?
(blend-mode render-context-blend-mode %set-render-context-blend-mode!)
(depth-test? render-context-depth-test? %set-render-context-depth-test?!)
(texture render-context-texture %set-render-context-texture!)
(shader render-context-shader %set-render-context-shader!)
(vertex-array render-context-vertex-array %set-render-context-vertex-array!))
(define (make-render-context)
(%make-render-context #f #f #f #f #f))
(define (render-context-reset! context)
(gl-disable (enable-cap blend))
(%set-render-context-blend-mode! context #f)
(gl-disable (enable-cap depth-test))
(%set-render-context-depth-test?! context #f)
(glBindTexture (texture-target texture-2d) 0)
(%set-render-context-texture! context #f)
(glUseProgram 0)
(%set-render-context-shader! context #f)
(glBindVertexArray 0)
(%set-render-context-vertex-array! context #f))
(define-syntax-rule (with-render-context context body ...)
(begin (render-context-reset! context) body ...))
(define (set-render-context-blend-mode! context blend-mode)
(unless (equal? (render-context-blend-mode context) blend-mode)
(if blend-mode
(apply-blend-mode blend-mode)
;; Turn off blending if there is no blend-mode specified.
(gl-disable (enable-cap blend)))
(%set-render-context-blend-mode! context blend-mode)))
(define (set-render-context-depth-test?! context depth-test?)
(unless (eq? (render-context-depth-test? context) depth-test?)
(if depth-test?
(gl-enable (enable-cap depth-test))
(gl-disable (enable-cap depth-test)))
(%set-render-context-depth-test?! context depth-test?)))
(define (set-render-context-texture! context texture)
(let ((current-texture (render-context-texture context)))
(unless (equal? current-texture texture)
(if texture
(begin
;; Enable texturing if it was disabled.
(unless current-texture
(gl-enable (enable-cap texture-2d)))
(apply-texture texture))
(gl-disable (enable-cap texture-2d)))
(%set-render-context-texture! context texture))))
(define (set-render-context-shader! context shader)
(unless (equal? (render-context-shader context) shader)
(apply-shader-program shader)
(%set-render-context-shader! context shader)))
(define (set-render-context-vertex-array! context vertex-array)
(unless (equal? (render-context-vertex-array context) vertex-array)
(apply-vertex-array vertex-array)
(%set-render-context-vertex-array! context vertex-array)))
|
