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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227 | -- SPDX-License-Identifier: Apache-2.0
--
-- Copyright (c) 2016 onox <denkpadje@gmail.com>
--
-- 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.
private with Ada.Containers.Indefinite_Holders;
with GL.Buffers;
with GL.Objects.Framebuffers;
with GL.Objects.Textures;
with GL.Types.Colors;
with Orka.Rendering.Textures;
package Orka.Rendering.Framebuffers is
pragma Preelaborate;
use GL.Types;
use all type Rendering.Textures.Format_Kind;
package FB renames GL.Objects.Framebuffers;
package Textures renames GL.Objects.Textures;
subtype Color_Attachment_Point is FB.Attachment_Point
range FB.Color_Attachment_0 .. FB.Color_Attachment_7;
type Use_Point_Array is array (Rendering.Framebuffers.Color_Attachment_Point) of Boolean;
-- TODO Use as formal parameter in procedure Invalidate
type Buffer_Values is record
Color : Colors.Color := (0.0, 0.0, 0.0, 1.0);
Depth : GL.Buffers.Depth := 0.0;
Stencil : GL.Buffers.Stencil_Index := 0;
end record;
type Framebuffer (Default : Boolean) is tagged private;
function Create_Framebuffer
(Width, Height : Size;
Samples : Size := 0) return Framebuffer
with Post => not Create_Framebuffer'Result.Default;
-----------------------------------------------------------------------------
function Create_Default_Framebuffer
(Width, Height : Natural) return Framebuffer
with Post => Create_Default_Framebuffer'Result.Default;
-----------------------------------------------------------------------------
function Width (Object : Framebuffer) return Size;
function Height (Object : Framebuffer) return Size;
function Samples (Object : Framebuffer) return Size;
function Image (Object : Framebuffer) return String;
-- Return a description of the given framebuffer
procedure Use_Framebuffer (Object : Framebuffer);
-- Use the framebuffer during rendering
--
-- The viewport is adjusted to the size of the framebuffer.
procedure Set_Default_Values (Object : in out Framebuffer; Values : Buffer_Values);
-- Set the default values for the color buffers and depth and stencil
-- buffers
function Default_Values (Object : Framebuffer) return Buffer_Values;
-- Return the current default values used when clearing the attached
-- textures
procedure Set_Read_Buffer
(Object : Framebuffer;
Buffer : GL.Buffers.Color_Buffer_Selector);
-- Set the buffer to use when blitting to another framebuffer with
-- procedure Resolve_To
procedure Set_Draw_Buffers
(Object : in out Framebuffer;
Buffers : GL.Buffers.Color_Buffer_List);
-- Set the buffers to use when drawing to output variables in a fragment
-- shader, when calling procedure Clear, or when another framebuffer
-- blits its read buffer to this framebuffer with procedure Resolve_To
procedure Clear
(Object : Framebuffer;
Mask : GL.Buffers.Buffer_Bits := (others => True));
-- Clear the attached textures for which the mask is True using
-- the default values set with Set_Default_Values
--
-- For clearing to be effective, the following conditions must apply:
--
-- - Write mask off
-- - Rasterizer discard disabled
-- - Scissor test off or scissor rectangle set to the desired region
-- - Called procedure Set_Draw_Buffers with a list of attachments
--
-- If a combined depth/stencil texture has been attached, the depth
-- and stencil components can be cleared separately, but it may be
-- faster to clear both components.
procedure Invalidate
(Object : Framebuffer;
Mask : GL.Buffers.Buffer_Bits);
-- Invalidate the attached textures for which the mask is True
procedure Resolve_To
(Object, Subject : Framebuffer;
Mask : GL.Buffers.Buffer_Bits := (Color => True, others => False))
with Pre => Object /= Subject and
(Mask.Color or Mask.Depth or Mask.Stencil) and
(if Object.Samples > 0 and Subject.Samples > 0 then
Object.Samples = Subject.Samples);
-- Copy one or more buffers, resolving multiple samples and scaling
-- if necessary, from the source to the destination framebuffer
--
-- If a buffer is specified in the mask, then the buffer should exist
-- in both framebuffers, otherwise the buffer is not copied. Call
-- Set_Read_Buffer and Set_Draw_Buffers to control which buffer is read
-- from and which buffers are written to.
--
-- Format of color buffers may differ and will be converted (if
-- supported). Formats of depth and stencil buffers must match.
--
-- Note: simultaneously resolving multiple samples and scaling
-- of color buffers requires GL_EXT_framebuffer_multisample_blit_scaled.
-- If this extension is not present, then two separate calls to this
-- procedure are needed.
procedure Attach
(Object : in out Framebuffer;
Texture : Textures.Texture;
Attachment : Color_Attachment_Point := FB.Color_Attachment_0;
Level : Textures.Mipmap_Level := 0)
with Pre => (not Object.Default and Texture.Allocated and
(if Rendering.Textures.Get_Format_Kind (Texture.Internal_Format) = Color then
(Object.Width = Texture.Width (Level) and
Object.Height = Texture.Height (Level))))
or else raise Constraint_Error with
"Cannot attach " & Rendering.Textures.Image (Texture, Level) &
" to " & Object.Image,
Post => (if Rendering.Textures.Get_Format_Kind (Texture.Internal_Format) = Color then
Object.Has_Attachment (Attachment));
-- Attach the texture to an attachment point based on the internal
-- format of the texture or to the given attachment point if the
-- texture is color renderable
--
-- The internal format of the texture must be valid for the given
-- attachment point.
--
-- If one of the attached textures is layered (3D, 1D/2D array, cube
-- map [array], or 2D multisampled array), then all attachments must
-- have the same kind.
--
-- If the texture is layered and you want to attach a specific layer,
-- then you must call the procedure Attach_Layer below instead.
--
-- All attachments of the framebuffer must have the same amount of
-- samples and they must all have fixed sample locations, or none of
-- them must have them.
procedure Attach_Layer
(Object : in out Framebuffer;
Texture : Textures.Texture;
Attachment : FB.Attachment_Point;
Layer : Natural;
Level : Textures.Mipmap_Level := 0)
with Pre => (not Object.Default and Texture.Allocated and
Texture.Layered and
(if Attachment in Color_Attachment_Point then
(Object.Width = Texture.Width (Level) and
Object.Height = Texture.Height (Level))))
or else raise Constraint_Error with
"Cannot attach layer of " & Rendering.Textures.Image (Texture, Level) &
" to " & Object.Image,
Post => Object.Has_Attachment (Attachment);
-- Attach the selected 1D/2D layer of the texture to the attachment point
--
-- The internal format of the texture must be valid for the given
-- attachment point.
--
-- The texture must be layered (3D, 1D/2D array, cube
-- map [array], or 2D multisampled array).
procedure Detach
(Object : in out Framebuffer;
Attachment : FB.Attachment_Point)
with Pre => not Object.Default,
Post => not Object.Has_Attachment (Attachment);
-- Detach any texture currently attached to the given attachment point
function Has_Attachment
(Object : Framebuffer;
Attachment : FB.Attachment_Point) return Boolean;
Framebuffer_Incomplete_Error : exception;
private
package Attachment_Holder is new Ada.Containers.Indefinite_Holders
(Element_Type => Textures.Texture, "=" => Textures."=");
package Color_Buffer_List_Holder is new Ada.Containers.Indefinite_Holders
(Element_Type => GL.Buffers.Color_Buffer_List, "=" => GL.Buffers."=");
type Attachment_Array is array (FB.Attachment_Point)
of Attachment_Holder.Holder;
type Framebuffer (Default : Boolean) is tagged record
GL_Framebuffer : FB.Framebuffer;
Attachments : Attachment_Array;
Defaults : Buffer_Values;
Draw_Buffers : Color_Buffer_List_Holder.Holder;
Width, Height, Samples : Size;
end record;
end Orka.Rendering.Framebuffers;
|