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
138
139
140
141
142
143
144
145
146
147
|
;;; Chickadee Game Toolkit
;;; Copyright © 2017, 2021 David Thompson <dthompson2@worcester.edu>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;
;; Viewports specify the renderable section of a window.
;;
;;; Code:
(define-module (chickadee graphics viewport)
#:use-module (srfi srfi-9)
#:export (<viewport>
make-viewport
viewport?
viewport-x
viewport-y
viewport-width
viewport-height
viewport-min-depth
viewport-max-depth
<scissor-rect>
make-scissor-rect
scissor-rect?
scissor-rect-x
scissor-rect-y
scissor-rect-width
scissor-rect-height))
(define-record-type <viewport>
(%make-viewport x y width height min-depth max-depth)
viewport?
(x viewport-x)
(y viewport-y)
(width viewport-width)
(height viewport-height)
(min-depth viewport-min-depth)
(max-depth viewport-max-depth))
(define* (make-viewport x y width height #:key (min-depth 0.0) (max-depth 1.0))
(%make-viewport x y width height min-depth max-depth))
(define-record-type <scissor-rect>
(make-scissor-rect x y width height)
scissor-rect?
(x scissor-rect-x)
(y scissor-rect-y)
(width scissor-rect-width)
(height scissor-rect-height))
;; (define-record-type <viewport>
;; (%make-viewport x y width height clear-color clear-flags)
;; viewport?
;; (x viewport-x)
;; (y viewport-y)
;; (width viewport-width)
;; (height viewport-height)
;; (clear-color viewport-clear-color)
;; (clear-flags viewport-clear-flags))
;; (define %default-clear-flags '(color-buffer depth-buffer stencil-buffer))
;; ;; Just a fun color from the Dawnbringer 32-color palette instead of
;; ;; boring old black.
;; (define %default-clear-color tango-light-sky-blue)
;; (define (assert-non-negative-integer n)
;; (if (and (integer? n) (>= n 0))
;; n
;; (error "expecting non-negative integer:" n)))
;; (define* (make-viewport x y width height #:key
;; (clear-color %default-clear-color)
;; (clear-flags %default-clear-flags))
;; "Create a viewport that covers an area of the window starting from
;; coordinates (X, Y) and spanning WIDTH x HEIGHT pixels. Fill the
;; viewport with CLEAR-COLOR when clearing the screen. Clear the buffers
;; denoted by the list of symbols in CLEAR-FLAGS. Possible values for
;; CLEAR-FLAGS are 'color-buffer', 'depth-buffer', 'accum-buffer', and
;; 'stencil-buffer'."
;; (%make-viewport (assert-non-negative-integer x)
;; (assert-non-negative-integer y)
;; (assert-non-negative-integer width)
;; (assert-non-negative-integer height)
;; clear-color
;; clear-flags))
;; (define null-viewport (make-viewport 0 0 0 0))
;; (define clear-buffer-mask
;; (memoize
;; (lambda (flags)
;; (apply logior
;; ;; Map symbols to OpenGL constants.
;; (map (match-lambda
;; ('depth-buffer 256)
;; ('accum-buffer 512)
;; ('stencil-buffer 1024)
;; ('color-buffer 16384))
;; flags)))))
;; (define (clear-viewport)
;; (gl-clear (clear-buffer-mask (viewport-clear-flags (current-viewport)))))
;; (define (apply-viewport viewport)
;; "Set the OpenGL state for VIEWPORT. Clip rendering to the viewport
;; area, set the clear color, and clear necessary buffers."
;; (unless (eq? viewport null-viewport)
;; (let ((x (viewport-x viewport))
;; (y (viewport-y viewport))
;; (w (viewport-width viewport))
;; (h (viewport-height viewport))
;; (c (viewport-clear-color viewport)))
;; (gl-enable (enable-cap scissor-test))
;; (gl-viewport x y w h)
;; (gl-scissor x y w h)
;; (gl-clear-color (color-r c) (color-g c) (color-b c) (color-a c)))))
;; (define (bind-viewport viewport)
;; "Set the OpenGL state for VIEWPORT. Clip rendering to the viewport
;; area, and set the clear color.."
;; (unless (eq? viewport null-viewport)
;; (let ((x (viewport-x viewport))
;; (y (viewport-y viewport))
;; (w (viewport-width viewport))
;; (h (viewport-height viewport))
;; (c (viewport-clear-color viewport)))
;; (gl-enable (enable-cap scissor-test))
;; (gl-viewport x y w h)
;; (gl-scissor x y w h)
;; (gl-clear-color (color-r c) (color-g c) (color-b c) (color-a c)))))
;; (define-graphics-state g:viewport
;; current-viewport
;; #:default null-viewport
;; #:bind bind-viewport)
|
