blob: 6017c4072babce4fd296cae2016bbfc9a5a69f05 (
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
|
;;; Chickadee Game Toolkit
;;; Copyright © 2020, 2021 David Thompson <dthompson2@worcester.edu>
;;;
;;; Chickadee 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.
;;;
;;; Chickadee 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
;;
;; Polygon face rendering configuration.
;;
;;; Code:
(define-module (chickadee graphics polygon)
#:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
#:use-module (gl)
#:use-module (ice-9 match)
#:use-module (srfi srfi-9)
#:export (make-polygon-mode
polygon-mode?
polygon-mode-front
polygon-mode-back
fill-polygon-mode
line-polygon-mode
point-polygon-mode
g:polygon-mode
current-polygon-mode
cull-face-mode?
cull-face-mode-front?
cull-face-mode-back?
no-cull-face-mode
back-cull-face-mode
front-cull-face-mode
front-and-back-cull-face-mode
g:cull-face-mode
current-cull-face-mode))
(define-record-type <polygon-mode>
(make-polygon-mode front back)
polygon-mode?
(front polygon-mode-front)
(back polygon-mode-back))
(define fill-polygon-mode (make-polygon-mode 'fill 'fill))
(define line-polygon-mode (make-polygon-mode 'line 'line))
(define point-polygon-mode (make-polygon-mode 'point 'point))
(define (bind-polygon-mode mode)
(define (glmode sym)
(match sym
('fill (polygon-mode fill))
('line (polygon-mode line))
('point (polygon-mode point))))
(let ((front (polygon-mode-front mode))
(back (polygon-mode-back mode)))
(if (eq? front back)
(gl-polygon-mode (cull-face-mode front-and-back) (glmode front))
(begin
(gl-polygon-mode (cull-face-mode front) (glmode front))
(gl-polygon-mode (cull-face-mode back) (glmode back))))))
(define-graphics-state g:polygon-mode
current-polygon-mode
#:default fill-polygon-mode
#:bind bind-polygon-mode)
(define-record-type <cull-face-mode>
(make-cull-face-mode front? back?)
cull-face-mode?
(front? cull-face-mode-front?)
(back? cull-face-mode-back?))
(define no-cull-face-mode (make-cull-face-mode #f #f))
(define back-cull-face-mode (make-cull-face-mode #f #t))
(define front-cull-face-mode (make-cull-face-mode #t #f))
(define front-and-back-cull-face-mode (make-cull-face-mode #t #t))
(define (bind-cull-face-mode mode)
(let ((front? (cull-face-mode-front? mode))
(back? (cull-face-mode-back? mode)))
(cond
((and front? back?)
(gl-enable (enable-cap cull-face))
(gl-cull-face (cull-face-mode front-and-back)))
(front?
(gl-enable (enable-cap cull-face))
(gl-cull-face (cull-face-mode front)))
(back?
(gl-enable (enable-cap cull-face))
(gl-cull-face (cull-face-mode back)))
(else
(gl-disable (enable-cap cull-face))))))
(define-graphics-state g:cull-face-mode
current-cull-face-mode
#:default back-cull-face-mode
#:bind bind-cull-face-mode)
|
