-- SPDX-License-Identifier: Apache-2.0 -- -- Copyright (c) 2019 onox -- -- 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. with Ada.Containers.Indefinite_Hashed_Maps; with Ada.Strings.Fixed; with Ada.Strings.Hash; with Ada.Strings.Unbounded; with Ada.Streams; with Ada.Unchecked_Conversion; with GL.Objects.Textures; with GL.Toggles; with GL.Types; with Orka.Logging.Default; with Orka.Rendering.Drawing; with Orka.Rendering.Programs.Modules; with Orka.Rendering.Programs.Uniforms; with Orka.Strings; with Orka.Types; package body Orka.Frame_Graphs is use all type Orka.Logging.Default_Module; use all type Orka.Logging.Severity; procedure Log is new Orka.Logging.Default.Generic_Log (Renderer); function Trim_Image (Value : Integer) return String is (Orka.Strings.Trim (Integer'Image (Value))); function Trim_Image (Value : Size) return String is (Orka.Strings.Trim (Value'Image)); function Trim_Image (Value : Render_Pass_Index) return String is (Trim_Image (Positive (Value))); function Trim_Image (Value : Size_3D) return String is (Trim_Image (Value (X)) & Orka.Strings.Unicode (" × ") & Trim_Image (Value (Y)) & Orka.Strings.Unicode (" × ") & Trim_Image (Value (Z))); function Trim_Image (Value : GL.Buffers.Buffer_Bits) return String is package SU renames Ada.Strings.Unbounded; Result : SU.Unbounded_String; begin if Value.Color then SU.Append (Result, " color"); end if; if Value.Depth then SU.Append (Result, " depth"); end if; if Value.Stencil then SU.Append (Result, " stencil"); end if; return Orka.Strings.Trim (SU.To_String (Result)); end Trim_Image; procedure Log_Resource (Value : Resource) is begin Log (Debug, " " & (+Value.Name) & ":"); Log (Debug, " kind: " & Value.Kind'Image); Log (Debug, " format: " & Value.Format'Image); Log (Debug, " size: " & Trim_Image (Value.Size)); Log (Debug, " samples: " & Trim_Image (Value.Samples)); Log (Debug, " version: " & Trim_Image (Natural (Value.Version))); end Log_Resource; function Name (Object : Resource_Data) return String is (+Object.Description.Name); function "+" (Value : Name_Strings.Bounded_String) return String is (Name_Strings.To_String (Value)); function "+" (Value : String) return Name_Strings.Bounded_String is (Name_Strings.To_Bounded_String (Value)); function Name (Object : Render_Pass) return String is (+Object.Frame_Graph.Passes (Object.Index).Name); function Name (Pass : Render_Pass_Data) return String is (+Pass.Name); ----------------------------------------------------------------------------- procedure Find_Resource (Object : in out Frame_Graph; Subject : Resource; Handle : out Handle_Type; Found : out Boolean) is use type Name_Strings.Bounded_String; begin Found := False; for Index in 1 .. Object.Resources.Length loop declare Description : Resource renames Object.Resources (Index).Description; Implicit : Boolean renames Object.Resources (Index).Implicit; begin if Subject.Name = Description.Name and Subject.Version = Description.Version and not Implicit then if Description /= Subject then raise Constraint_Error with "Already added different resource '" & (+Subject.Name) & "'"; end if; Found := True; Handle := Index; exit; end if; end; end loop; end Find_Resource; procedure Add_Resource (Object : in out Frame_Graph; Subject : Resource; Handle : out Handle_Type) is Found : Boolean; begin Object.Find_Resource (Subject, Handle, Found); if not Found then Object.Resources.Append ((Description => Subject, others => <>)); Handle := Object.Resources.Length; end if; end Add_Resource; ----------------------------------------------------------------------------- type Input_Resource is record Mode : Read_Mode; Data : Resource; Binding : Binding_Point; Implicit : Boolean; Written : Boolean; -- Written to by a previous render pass end record; type Output_Resource is record Mode : Write_Mode; Data : Resource; Binding : Binding_Point; Implicit : Boolean; Read : Boolean; -- Read by a subsequent render pass end record; type Input_Resource_Array is array (Positive range <>) of Input_Resource; type Output_Resource_Array is array (Positive range <>) of Output_Resource; ----------------------------------------------------------------------------- subtype Attachment_Format is Orka.Rendering.Textures.Format_Kind; procedure Verify_Depth_Stencil (Pass : Render_Pass_Data; Format : Attachment_Format) is begin if Pass.Has_Depth and then Format in Depth_Stencil | Depth then raise Program_Error with "Render pass '" & Name (Pass) & "' already has a depth attachment"; end if; if Pass.Has_Stencil and then Format in Depth_Stencil | Stencil then raise Program_Error with "Render pass '" & Name (Pass) & "' already has a stencil attachment"; end if; end Verify_Depth_Stencil; procedure Set_Depth_Stencil (Pass : in out Render_Pass_Data; Format : Attachment_Format) is begin if Format in Depth_Stencil | Depth then Pass.Has_Depth := True; end if; if Format in Depth_Stencil | Stencil then Pass.Has_Stencil := True; end if; end Set_Depth_Stencil; function Get_Attachment_Format (Format : GL.Pixels.Internal_Format) return Attachment_Format renames Orka.Rendering.Textures.Get_Format_Kind; ----------------------------------------------------------------------------- use type GL.Objects.Textures.Texture; package Texture_Maps is new Ada.Containers.Indefinite_Hashed_Maps (Key_Type => String, Element_Type => GL.Objects.Textures.Texture, Hash => Ada.Strings.Hash, Equivalent_Keys => "="); Textures : Texture_Maps.Map; function Get_Texture (Subject : Resource) return GL.Objects.Textures.Texture with Post => Get_Texture'Result.Allocated is begin return Textures.Element (+Subject.Name); exception when Constraint_Error => declare Result : GL.Objects.Textures.Texture (Subject.Kind); begin Result.Allocate_Storage (Levels => Size (Subject.Levels), Samples => Size (Subject.Samples), Format => Subject.Format, Width => Subject.Size (X), Height => Subject.Size (Y), Depth => Subject.Size (Z)); Textures.Insert (+Subject.Name, Result); return Result; end; end Get_Texture; ----------------------------------------------------------------------------- procedure Add_Input (Object : Render_Pass; Subject : Resource; Mode : Read_Mode; Binding : Binding_Point; Handle : out Handle_Type; Implicit : Boolean); function Add_Pass (Object : in out Frame_Graph; Name : String; State : Rendering.States.State; Program : Rendering.Programs.Program; Callback : not null Program_Callback; Side_Effect, Present : Boolean) return Render_Pass'Class is begin Object.Passes.Append ((Name => +Name, Side_Effect => Side_Effect, Present => Present, State => State, Program => Program, Callback => Callback, others => <>)); return Render_Pass' (Frame_Graph => Object'Access, Index => Object.Passes.Length); end Add_Pass; function Add_Pass (Object : in out Frame_Graph; Name : String; State : Rendering.States.State; Program : Rendering.Programs.Program; Callback : not null Program_Callback; Side_Effect : Boolean := False) return Render_Pass'Class is (Object.Add_Pass (Name, State, Program, Callback, Side_Effect => Side_Effect, Present => False)); procedure Unused_Callback (Program : in out Rendering.Programs.Program) is null; procedure Add_Present (Object : in out Frame_Graph; Subject : Resource; Handle : out Handle_Type) is Found : Boolean; begin Object.Find_Resource (Subject, Handle, Found); if not Found then raise Constraint_Error with "Presented resource not found in graph"; end if; declare Unused_Program : Rendering.Programs.Program; Pass : constant Render_Pass'Class := Object.Add_Pass ("Present", (others => <>), Unused_Program, Unused_Callback'Access, Side_Effect => True, Present => True); begin -- The present pass does not always read the resource: the previous -- render pass will use the default framebuffer to write to the -- resource (mode 1), or the present pass will blit (mode 2) or -- render (mode 3) the resource to the default framebuffer Render_Pass (Pass).Add_Input (Subject, Texture_Read, 0, Handle, Implicit => False); Object.Present_Pass := Pass.Index; end; end Add_Present; ----------------------------------------------------------------------------- procedure Add_Output (Object : Render_Pass; Subject : Resource; Write : Write_Mode; Binding : Binding_Point; Handle : out Handle_Type; Implicit : Boolean) is Graph : Orka.Frame_Graphs.Frame_Graph renames Object.Frame_Graph.all; Pass : Render_Pass_Data renames Graph.Passes (Object.Index); Attachment : constant Attachment_Format := Get_Attachment_Format (Subject.Format); begin if Pass.Write_Count > 0 and then Pass.Write_Offset + Pass.Write_Count /= Graph.Write_Handles.Length + 1 then raise Program_Error with "Cannot interleave Add_Output calls for different passes"; end if; if Implicit and Write = Framebuffer_Attachment then Verify_Depth_Stencil (Pass, Attachment); declare Handle : Handle_Type; Prev_Subject : Resource := Subject; begin Prev_Subject.Version := Subject.Version - 1; Object.Add_Input (Prev_Subject, Framebuffer_Attachment, Binding, Handle, Implicit => False); Graph.Resources (Handle).Implicit := True; end; end if; Add_Resource (Graph, Subject, Handle); declare Resource : Resource_Data renames Graph.Resources (Handle); begin if Resource.Render_Pass /= No_Render_Pass then raise Constraint_Error with "Resource '" & Name (Resource) & "'" & " already written by pass '" & Name (Graph.Passes (Resource.Render_Pass)) & "'"; end if; pragma Assert (Resource.Output_Mode = Not_Used); Resource.Render_Pass := Object.Index; Resource.Output_Mode := Write; Resource.Output_Binding := Binding; end; -- Register resource as 'written' by the render pass Graph.Write_Handles.Append (Handle); if Pass.Write_Count = 0 then Pass.Write_Offset := Graph.Write_Handles.Length; end if; Pass.Write_Count := Pass.Write_Count + 1; Set_Depth_Stencil (Pass, Attachment); end Add_Output; procedure Add_Output (Object : Render_Pass; Subject : Resource; Mode : Write_Mode; Binding : Binding_Point) is Handle : Handle_Type; begin Object.Add_Output (Subject, Mode, Binding, Handle, Implicit => True); pragma Assert (Object.Frame_Graph.Resources (Handle).Output_Mode = Mode); pragma Assert (Object.Frame_Graph.Resources (Handle).Output_Binding = Binding); end Add_Output; procedure Add_Input (Object : Render_Pass; Subject : Resource; Mode : Read_Mode; Binding : Binding_Point; Handle : out Handle_Type; Implicit : Boolean) is Graph : Orka.Frame_Graphs.Frame_Graph renames Object.Frame_Graph.all; Pass : Render_Pass_Data renames Graph.Passes (Object.Index); Attachment : constant Attachment_Format := Get_Attachment_Format (Subject.Format); begin if Pass.Read_Count > 0 and then Pass.Read_Offset + Pass.Read_Count /= Graph.Read_Handles.Length + 1 then raise Program_Error with "Cannot interleave Add_Input calls for different passes"; end if; if Implicit and Mode = Framebuffer_Attachment then if Attachment = Color then raise Program_Error with "Use Add_Output or Add_Input_Output for color resource"; end if; Verify_Depth_Stencil (Pass, Attachment); declare Handle : Handle_Type; Next_Subject : Resource := Subject; begin Next_Subject.Version := Subject.Version + 1; Object.Add_Output (Next_Subject, Framebuffer_Attachment, Binding, Handle, Implicit => False); Graph.Resources (Handle).Implicit := True; end; end if; Add_Resource (Graph, Subject, Handle); declare Resource : Resource_Data renames Graph.Resources (Handle); begin -- Resource is not considered modified if the next version is implicit if Resource.Modified then raise Constraint_Error with "Cannot read old version of modified resource '" & Name (Resource) & "'"; end if; -- Because a resource records only one input mode, verify this -- resource is read by multiple render passes using only one -- particular method if Resource.Input_Mode not in Not_Used | Mode then raise Constraint_Error with "Resource '" & Name (Resource) & "' must be read as " & Resource.Input_Mode'Image; end if; Resource.Read_Count := Resource.Read_Count + 1; Resource.Input_Mode := Mode; Resource.Input_Binding := Binding; end; -- Register resource as 'read' by the render pass Graph.Read_Handles.Append (Handle); if Pass.Read_Count = 0 then Pass.Read_Offset := Graph.Read_Handles.Length; end if; Pass.Read_Count := Pass.Read_Count + 1; Set_Depth_Stencil (Pass, Attachment); end Add_Input; procedure Add_Input (Object : Render_Pass; Subject : Resource; Mode : Read_Mode; Binding : Binding_Point) is Handle : Handle_Type; begin Object.Add_Input (Subject, Mode, Binding, Handle, Implicit => True); pragma Assert (Object.Frame_Graph.Resources (Handle).Input_Mode = Mode); pragma Assert (Object.Frame_Graph.Resources (Handle).Input_Binding = Binding); end Add_Input; function Add_Input_Output (Object : Render_Pass; Subject : Resource; Mode : Read_Write_Mode; Binding : Binding_Point) return Resource is Graph : Orka.Frame_Graphs.Frame_Graph renames Object.Frame_Graph.all; Handle : Handle_Type; Read : constant Read_Mode := (case Mode is when Not_Used => Not_Used, when Framebuffer_Attachment => Framebuffer_Attachment, when Image_Load_Store => Image_Load); Write : constant Write_Mode := (case Mode is when Not_Used => Not_Used, when Framebuffer_Attachment => Framebuffer_Attachment, when Image_Load_Store => Image_Store); Next_Subject : Resource := Subject; begin Object.Add_Input (Subject, Read, Binding, Handle, Implicit => False); declare Resource : Resource_Data renames Graph.Resources (Handle); begin Resource.Modified := True; end; Next_Subject.Version := Subject.Version + 1; Object.Add_Output (Next_Subject, Write, Binding, Handle, Implicit => False); return Next_Subject; end Add_Input_Output; function Cull (Object : Frame_Graph; Present : Resource) return Renderable_Graph'Class is Stack : Handle_Vectors.Vector (Positive (Object.Resources.Length)); Index : Handle_Type; begin return Result : Renderable_Graph (Maximum_Passes => Object.Maximum_Passes, Maximum_Handles => Object.Maximum_Handles, Maximum_Resources => Object.Maximum_Resources) do -- Copy data structures before culling Result.Graph.Passes := Object.Passes; Result.Graph.Resources := Object.Resources; Result.Graph.Read_Handles := Object.Read_Handles; Result.Graph.Write_Handles := Object.Write_Handles; Result.Initialized := False; Add_Present (Result.Graph, Present, Index); declare Resource : Resource_Data renames Result.Graph.Resources (Index); begin if Resource.Render_Pass = No_Render_Pass then raise Constraint_Error with "Presented resource not written by a pass"; end if; end; -- Raise an error if there is a render pass that will be -- culled immediately. This simplifies the stack so that it -- only needs to contain indices of resources. for Pass of Result.Graph.Passes loop Pass.References := Pass.Write_Count; if not Pass.Side_Effect and Pass.References = 0 then raise Constraint_Error with "Render pass '" & (+Pass.Name) & "' does not write to any resource"; end if; end loop; for Index in 1 .. Result.Graph.Resources.Length loop declare Resource : Resource_Data renames Result.Graph.Resources (Index); begin Resource.References := Resource.Read_Count; if Resource.References = 0 then if Resource.Render_Pass = No_Render_Pass then raise Constraint_Error with "Resource '" & Name (Resource) & " not connected"; end if; Stack.Append (Index); end if; end; end loop; while not Stack.Is_Empty loop Stack.Remove_Last (Index); declare -- Pass is the render pass that writes to the resource Resource : Resource_Data renames Result.Graph.Resources (Index); Pass : Render_Pass_Data renames Result.Graph.Passes (Resource.Render_Pass); -- Assert that the render pass does write to the resource Write_Offset : Positive renames Pass.Write_Offset; Write_Count : Natural renames Pass.Write_Count; pragma Assert (for some Offset in Write_Offset .. Write_Offset + Write_Count - 1 => Result.Graph.Write_Handles (Offset) = Index); begin Pass.References := Pass.References - 1; -- Update ref count of resources read by the render pass -- if the render pass got culled if not Pass.Side_Effect and Pass.References = 0 then for Index in Pass.Read_Offset .. Pass.Read_Offset + Pass.Read_Count - 1 loop declare Resource_Handle : constant Handle_Type := Result.Graph.Read_Handles (Index); Resource : Resource_Data renames Result.Graph.Resources (Resource_Handle); begin Resource.References := Resource.References - 1; if Resource.References = 0 and Resource.Render_Pass /= No_Render_Pass then Stack.Append (Resource_Handle); end if; end; end loop; end if; end; end loop; -- Here we are done with culling. Next step is to iterate over -- the passes that survived culling and create framebuffers and -- textures. end return; end Cull; function Input_Resources (Object : Renderable_Graph; Pass : Render_Pass_Data) return Input_Resource_Array is begin return Result : Input_Resource_Array (1 .. Pass.Read_Count) do for Index in 1 .. Pass.Read_Count loop declare Data : Resource_Data renames Object.Graph.Resources (Object.Graph.Read_Handles (Pass.Read_Offset + Index - 1)); begin Result (Index) := (Mode => Data.Input_Mode, Data => Data.Description, Binding => Data.Input_Binding, Written => Data.Render_Pass /= No_Render_Pass, Implicit => Data.Implicit); end; end loop; end return; end Input_Resources; function Output_Resources (Object : Renderable_Graph; Pass : Render_Pass_Data) return Output_Resource_Array is begin return Result : Output_Resource_Array (1 .. Pass.Write_Count) do for Index in 1 .. Pass.Write_Count loop declare Data : Resource_Data renames Object.Graph.Resources (Object.Graph.Write_Handles (Pass.Write_Offset + Index - 1)); begin Result (Index) := (Mode => Data.Output_Mode, Data => Data.Description, Binding => Data.Output_Binding, Read => Data.References > 0, Implicit => Data.Implicit); end; end loop; end return; end Output_Resources; function Is_Initialized (Object : Renderable_Graph) return Boolean is (Object.Initialized); procedure Initialize (Object : in out Renderable_Graph; Location : Resources.Locations.Location_Ptr; Default : Rendering.Framebuffers.Framebuffer) is subtype Selector_Type is GL.Buffers.Explicit_Color_Buffer_Selector; subtype Buffer_Type is GL.Buffers.Draw_Buffer_Index; subtype Point_Type is Rendering.Framebuffers.Color_Attachment_Point; function To_Color_Buffer (Value : Attachment_Point) return Selector_Type is (Selector_Type'Val (Selector_Type'Pos (Selector_Type'First) + Value)); function To_Attachment_Point (Value : Attachment_Point) return Point_Type is (Point_Type'Val (Point_Type'Pos (Point_Type'First) + Value)); Present_Pass : Render_Pass_Data renames Object.Graph.Passes (Object.Graph.Present_Pass); pragma Assert (Present_Pass.Read_Count = 1); -- Look up the resource that is going to be presented to the screen Present_Resource_Handle : constant Handle_Type := Object.Graph.Read_Handles (Present_Pass.Read_Offset); Present_Resource : Resource_Data renames Object.Graph.Resources (Present_Resource_Handle); Default_Size : constant Size_3D := (Default.Width, Default.Height, 1); Last_Pass_Index : constant Render_Pass_Index := Present_Resource.Render_Pass; begin declare package Programs renames Orka.Rendering.Programs; Resource : Resource_Data renames Present_Resource; Format : constant Attachment_Format := Get_Attachment_Format (Resource.Description.Format); -- Look up the last render pass *before* the present pass Last_Render_Pass : Render_Pass_Data renames Object.Graph.Passes (Last_Pass_Index); Attachments : Natural := 0; Has_Non_Color_Attachment : Boolean := False; begin -- Mode 1: Previous render pass has one FB color attachment (this resource) -- Action: Previous render pass can use the default framebuffer -- -- Mode 2: Previous render pass has multiple FB color attachments -- or other non-color FB attachments -- Action: Blit the resource to the default framebuffer -- -- Mode 3: Resource is not written as a FB color attachment -- or resource is a depth and/or stencil attachment -- Action: Bind the resource as a texture and render to the -- default framebuffer if Resource.Output_Mode /= Framebuffer_Attachment or Format /= Color then -- Mode 3: Bind resource as texture and render to default framebuffer -- (Presented resource is added as input to present pass in procedure Add_Present) Object.Present_Mode := Render_To_Default; Object.Present_Program := Programs.Create_Program (Programs.Modules.Create_Module (Location, VS => "oversized-triangle.vert", FS => "frame-graph-present.frag")); Object.Present_Program.Uniform ("screenResolution").Set_Vector (Orka.Types.Singles.Vector4' (Orka.Float_32 (Default.Width), Orka.Float_32 (Default.Height), 0.0, 0.0)); Log (Warning, "Presenting " & Name (Resource) & " using extra render pass"); if Resource.Output_Mode /= Framebuffer_Attachment then Log (Warning, " output mode: " & Resource.Output_Mode'Image & " (/= " & Read_Mode'Image (Framebuffer_Attachment) & ")"); end if; if Format /= Color then Log (Warning, " format: " & Format'Image & " (/= " & Color'Image & ")"); end if; else for Last_Resource of Object.Output_Resources (Last_Render_Pass) loop if Last_Resource.Mode = Framebuffer_Attachment then case Get_Attachment_Format (Last_Resource.Data.Format) is when Color => Attachments := Attachments + 1; when Depth | Depth_Stencil | Stencil => -- Cannot use mode 1, because we have no control over the format -- of the depth/stencil buffer of the default framebuffer Has_Non_Color_Attachment := True; end case; end if; end loop; if Attachments = 1 and not Has_Non_Color_Attachment and Resource.Description.Kind = Texture_2D and Resource.Description.Size = Default_Size and Resource.Description.Samples = Natural (Default.Samples) then -- Mode 1: Use Default as the framebuffer of Last_Render_Pass Object.Present_Mode := Use_Default; Log (Debug, "Presenting " & Name (Resource) & " using default framebuffer"); elsif Resource.Description.Kind in Texture_2D | Texture_2D_Multisample then -- Mode 2 Object.Present_Mode := Blit_To_Default; Log (Warning, "Presenting " & Name (Resource) & " by blitting"); if Attachments /= 1 or Has_Non_Color_Attachment then Log (Warning, " last render pass:"); Log (Warning, " name: " & Name (Last_Render_Pass)); if Attachments /= 1 then Log (Warning, " attachments: " & Trim_Image (Attachments) & " (/= 1)"); end if; if Has_Non_Color_Attachment then Log (Warning, " has depth or stencil attachments"); end if; end if; if Resource.Description.Kind /= Texture_2D then Log (Warning, " kind: " & Resource.Description.Kind'Image & " (/= " & Texture_2D'Image & ")"); end if; if Resource.Description.Size /= Default_Size then Log (Warning, " scaling: from " & Trim_Image (Resource.Description.Size) & " to " & Trim_Image (Default_Size)); end if; if Resource.Description.Samples /= Natural (Default.Samples) then Log (Warning, " samples: " & Trim_Image (Resource.Description.Samples) & " (/= " & Trim_Image (Natural (Default.Samples)) & ")"); end if; end if; end if; end; for Index in 1 .. Object.Graph.Passes.Length loop declare Pass : Render_Pass_Data renames Object.Graph.Passes (Index); Width, Height : Size := Size'First; Samples_Attachments : Natural := Natural'First; Clear_Mask : GL.Buffers.Buffer_Bits := (others => False); Invalidate_Mask : GL.Buffers.Buffer_Bits := (others => False); -- If Clear_Buffers = Render_Buffers then we only need to call -- Set_Draw_Buffers once after creating the framebuffer, otherwise -- buffers need to be set before clearing and rendering Clear_Buffers : GL.Buffers.Color_Buffer_List (0 .. 7) := (others => GL.Buffers.None); Render_Buffers : GL.Buffers.Color_Buffer_List (0 .. 7) := (others => GL.Buffers.None); Buffers_Equal : Boolean := False; Invalidate_Points : Rendering.Framebuffers.Use_Point_Array := (others => False); Depth_Writes, Stencil_Writes : Boolean := True; Clear_Buffer, Invalidate_Buffer : Boolean; begin if Pass.Side_Effect or Pass.References > 0 then -- Clear input resources read as framebuffer attachments -- which are new (not written by a previous render pass) for Resource of Object.Input_Resources (Pass) loop if Resource.Mode = Framebuffer_Attachment then Clear_Buffer := not Resource.Written; case Get_Attachment_Format (Resource.Data.Format) is when Depth_Stencil => Clear_Mask.Depth := Clear_Buffer; Clear_Mask.Stencil := Clear_Buffer; when Depth => Clear_Mask.Depth := Clear_Buffer; when Stencil => Clear_Mask.Stencil := Clear_Buffer; when Color => -- Clear the color buffers, but only those that -- do not have a render pass that writes to it if Clear_Buffer then Clear_Buffers (Buffer_Type (Resource.Binding)) := To_Color_Buffer (Resource.Binding); Clear_Mask.Color := True; end if; end case; end if; end loop; -- Present pass is always the default framebuffer. Make sure -- the color buffer of the default framebuffer is cleared when -- we manually need to blit or render some texture to the screen if Pass.Present then Clear_Mask.Color := True; end if; -- Invalidate output attachments that are transcient -- (not read by a subsequent render pass) for Resource of Object.Output_Resources (Pass) loop if Resource.Mode = Framebuffer_Attachment then Invalidate_Buffer := not Resource.Read; Samples_Attachments := Natural'Max (Samples_Attachments, Resource.Data.Samples); case Get_Attachment_Format (Resource.Data.Format) is when Depth_Stencil => Invalidate_Mask.Depth := Invalidate_Buffer; Invalidate_Mask.Stencil := Invalidate_Buffer; Depth_Writes := not Resource.Implicit; Stencil_Writes := not Resource.Implicit; when Depth => Invalidate_Mask.Depth := Invalidate_Buffer; Depth_Writes := not Resource.Implicit; when Stencil => Invalidate_Mask.Stencil := Invalidate_Buffer; Stencil_Writes := not Resource.Implicit; when Color => -- Invalidate the color buffers, but only those that -- are not read by a subsequent render pass if Invalidate_Buffer then Invalidate_Points (To_Attachment_Point (Resource.Binding)) := True; Invalidate_Mask.Color := True; end if; -- Even if the resource is not read, the buffer is -- still used as a draw buffer because the shader -- will probably render to it Render_Buffers (Buffer_Type (Resource.Binding)) := To_Color_Buffer (Resource.Binding); end case; end if; -- Compute maximum width and height over all the output -- resources (which may be attached to the framebuffer). -- Ideally all attachments have the same size, but the -- GL spec allows for them to be different. Furthermore, -- a framebuffer may have zero attachments, so iterate over -- all resources irrespective of their write mode. Width := Size'Max (Width, Resource.Data.Size (X)); Height := Size'Max (Height, Resource.Data.Size (Y)); end loop; if Pass.Write_Count = 0 then pragma Assert (Pass.Side_Effect); -- Use width and height from default framebuffer Width := Default.Width; Height := Default.Height; else pragma Assert (Width > 0 and Height > 0); end if; declare use type GL.Buffers.Color_Buffer_List; begin -- Output attachments always have a corresponding -- input resource (implicit if necessary), but if -- the resource is not new (written by previous pass) -- then the resource is not cleared Buffers_Equal := Clear_Buffers = Render_Buffers; end; -- Skip present pass if last normal render pass already uses default framebuffer if Object.Present_Mode /= Use_Default or not Pass.Present then Object.Framebuffers.Append ((Index => Index, Framebuffer => Framebuffer_Holders.To_Holder (if Object.Present_Mode = Use_Default and Last_Pass_Index = Index then Default elsif Object.Present_Mode /= Use_Default and Pass.Present then Default else Rendering.Framebuffers.Create_Framebuffer (Width => Width, Height => Height, Samples => Size (Samples_Attachments))), Clear_Mask => Clear_Mask, Invalidate_Mask => Invalidate_Mask, Clear_Buffers => Clear_Buffers, Render_Buffers => Render_Buffers, Buffers_Equal => Buffers_Equal, Invalidate_Points => Invalidate_Points, Depth_Writes => Depth_Writes, Stencil_Writes => Stencil_Writes)); if Object.Present_Mode = Use_Default and Last_Pass_Index = Index then Pass.Side_Effect := True; Pass.Present := True; elsif Object.Present_Mode = Blit_To_Default and Last_Pass_Index = Index then Object.Last_Pass_Index := Object.Framebuffers.Length; end if; declare procedure Set_Buffers (Framebuffer : in out Rendering.Framebuffers.Framebuffer) is use type GL.Buffers.Color_Buffer_Selector; begin -- Clear color to black and depth to 0.0 (because of reversed Z) Framebuffer.Set_Default_Values ((Color => (0.0, 0.0, 0.0, 1.0), Depth => 0.0, others => <>)); if Framebuffer.Default then -- The resource is 'read' by the present pass pragma Assert (not Invalidate_Mask.Color); if not Buffers_Equal then pragma Assert (for all Buffer of Clear_Buffers => Buffer = GL.Buffers.None); end if; if Object.Present_Mode = Use_Default then pragma Assert (Render_Buffers (Render_Buffers'First) = GL.Buffers.Color_Attachment0); pragma Assert (for all Index in Render_Buffers'First + 1 .. Render_Buffers'Last => Render_Buffers (Index) = GL.Buffers.None); -- Not calling Set_Draw_Buffers because the default -- framebuffer already has an initial draw buffer -- (GL.Buffers.Back_Left for double-buffered context) end if; else if Object.Present_Mode = Blit_To_Default and Last_Pass_Index = Index then -- Compute the point of the resource read by the present pass for Resource of Object.Output_Resources (Pass) loop if Resource.Mode = Framebuffer_Attachment and Get_Attachment_Format (Resource.Data.Format) = Color and Resource.Data = Present_Resource.Description then Framebuffer.Set_Read_Buffer (To_Color_Buffer (Resource.Binding)); end if; end loop; end if; if Buffers_Equal then Framebuffer.Set_Draw_Buffers (Render_Buffers); end if; for Resource of Object.Input_Resources (Pass) loop if Resource.Mode = Framebuffer_Attachment then -- TODO Support attaching layer of resource -- using value in 1 .. Resource.Data.Size (Z) if Get_Attachment_Format (Resource.Data.Format) /= Color then Framebuffer.Attach (Get_Texture (Resource.Data)); else Framebuffer.Attach (Texture => Get_Texture (Resource.Data), Attachment => To_Attachment_Point (Resource.Binding)); end if; end if; end loop; end if; end Set_Buffers; begin Object.Framebuffers (Object.Framebuffers.Length).Framebuffer.Update_Element (Set_Buffers'Access); end; end if; end if; end; end loop; Object.Initialized := True; end Initialize; procedure Log_Graph (Object : in out Renderable_Graph) is begin for Data of Object.Framebuffers loop declare Pass : Render_Pass_Data renames Object.Graph.Passes (Data.Index); pragma Assert (Pass.Side_Effect or else Pass.References > 0); procedure Execute_Pass (Framebuffer : Rendering.Framebuffers.Framebuffer) is use type GL.Buffers.Explicit_Color_Buffer_Selector; begin Log (Debug, "Pass " & Name (Pass) & " (" & Trim_Image (Data.Index) & ")"); Log (Debug, " count:"); Log (Debug, " read: " & Pass.Read_Count'Image); Log (Debug, " write: " & Pass.Write_Count'Image); Log (Debug, " references: " & Pass.References'Image); Log (Debug, " side effects: " & Pass.Side_Effect'Image); Log (Debug, " present: " & Pass.Present'Image); Log (Debug, " framebuffer: " & Framebuffer.Image); Log (Debug, " writes:"); Log (Debug, " depth: " & Data.Depth_Writes'Image); Log (Debug, " stencil: " & Data.Stencil_Writes'Image); Log (Debug, " masks:"); Log (Debug, " clear: " & Trim_Image (Data.Clear_Mask)); Log (Debug, " invalidate: " & Trim_Image (Data.Invalidate_Mask)); if not Framebuffer.Default then Log (Debug, " invalidate:"); for I in Data.Invalidate_Points'Range loop if Data.Invalidate_Points (I) then Log (Debug, " - " & I'Image); end if; end loop; Log (Debug, " buffers:"); Log (Debug, " clear:"); for I in Data.Clear_Buffers'Range loop if Data.Clear_Buffers (I) /= GL.Buffers.None then Log (Debug, " - " & Data.Clear_Buffers (I)'Image); end if; end loop; if not Data.Buffers_Equal then Log (Debug, " render:"); for I in Data.Render_Buffers'Range loop if Data.Clear_Buffers (I) /= GL.Buffers.None then Log (Debug, " - " & Data.Render_Buffers (I)'Image); end if; end loop; end if; end if; Log (Debug, " inputs:"); for Resource of Object.Input_Resources (Pass) loop Log_Resource (Resource.Data); Log (Debug, " mode: " & Resource.Mode'Image); Log (Debug, " binding: " & Trim_Image (Natural (Resource.Binding))); Log (Debug, " implicit: " & Resource.Implicit'Image); Log (Debug, " written: " & Resource.Written'Image); end loop; Log (Debug, " outputs:"); for Resource of Object.Output_Resources (Pass) loop Log_Resource (Resource.Data); Log (Debug, " mode: " & Resource.Mode'Image); Log (Debug, " binding: " & Trim_Image (Natural (Resource.Binding))); Log (Debug, " implicit: " & Resource.Implicit'Image); Log (Debug, " read: " & Resource.Read'Image); end loop; if Pass.Present then Log (Debug, "Present pass mode: " & Object.Present_Mode'Image); case Object.Present_Mode is when Blit_To_Default => Log (Debug, "Blitting to default framebuffer from pass " & Trim_Image (Object.Framebuffers (Object.Last_Pass_Index).Index)); when Use_Default | Render_To_Default => null; end case; end if; end Execute_Pass; begin Data.Framebuffer.Query_Element (Execute_Pass'Access); end; end loop; end Log_Graph; procedure Render (Object : in out Renderable_Graph; Context : in out Contexts.Context'Class) is package Textures renames Orka.Rendering.Textures; begin for Data of Object.Framebuffers loop declare Pass : Render_Pass_Data renames Object.Graph.Passes (Data.Index); pragma Assert (Pass.Side_Effect or else Pass.References > 0); procedure Execute_Pass (Framebuffer : in out Rendering.Framebuffers.Framebuffer) is begin Framebuffer.Use_Framebuffer; GL.Buffers.Set_Depth_Mask (True); GL.Buffers.Set_Stencil_Mask (2#1111_1111#); if Data.Buffers_Equal then Framebuffer.Clear (Data.Clear_Mask); else Framebuffer.Set_Draw_Buffers (Data.Clear_Buffers); Framebuffer.Clear (Data.Clear_Mask); Framebuffer.Set_Draw_Buffers (Data.Render_Buffers); end if; GL.Buffers.Set_Depth_Mask (Data.Depth_Writes); GL.Buffers.Set_Stencil_Mask (if Data.Stencil_Writes then 2#1111_1111# else 0); GL.Toggles.Set (GL.Toggles.Depth_Test, Pass.Has_Depth); GL.Toggles.Set (GL.Toggles.Stencil_Test, Pass.Has_Stencil); -- Note: unconditional writing (write + no test) would require -- enable testing + GL.Buffers.Set_Depth_Function (GL.Types.Always), -- but is not supported because otherwise a user would need to call -- Add_Input_Output instead of just Add_Output for a depth resource -- Apply GL state updates Context.Update_State (Pass.State); -- Bind textures and images for Resource of Object.Input_Resources (Pass) loop case Resource.Mode is when Texture_Read => Textures.Bind (Get_Texture (Resource.Data), Textures.Texture, Natural (Resource.Binding)); when Image_Load => Textures.Bind (Get_Texture (Resource.Data), Textures.Image, Natural (Resource.Binding)); when Not_Used | Framebuffer_Attachment => null; end case; end loop; for Resource of Object.Output_Resources (Pass) loop -- Resource has already been attached in procedure Initialize -- if mode is Framebuffer_Attachment if Resource.Mode = Image_Store then Textures.Bind (Get_Texture (Resource.Data), Textures.Image, Natural (Resource.Binding)); end if; end loop; pragma Assert (Framebuffer.Default = Pass.Present); if Pass.Present then case Object.Present_Mode is when Use_Default => -- User-defined program will use default framebuffer to render to screen Pass.Program.Use_Program; Pass.Callback (Pass.Program); when Blit_To_Default => declare procedure Resolve_From_Pass (Other_Framebuffer : Rendering.Framebuffers.Framebuffer) is begin Other_Framebuffer.Resolve_To (Framebuffer); end Resolve_From_Pass; begin -- Blit input texture to screen Object.Framebuffers (Object.Last_Pass_Index).Framebuffer.Query_Element (Resolve_From_Pass'Access); end; when Render_To_Default => -- Render input texture to screen Object.Present_Program.Use_Program; GL.Buffers.Set_Depth_Function (GL.Types.Always); Orka.Rendering.Drawing.Draw (GL.Types.Triangles, 0, 3); GL.Buffers.Set_Depth_Function (GL.Types.Greater); -- FIXME Need to know depth func of previous state end case; else Pass.Program.Use_Program; Pass.Callback (Pass.Program); end if; -- Invalidate attachments that are transcient -- (not read by a subsequent render pass) Framebuffer.Invalidate (Data.Invalidate_Mask); -- TODO Use Data.Invalidate_Points for the color attachment points end Execute_Pass; begin Data.Framebuffer.Update_Element (Execute_Pass'Access); end; end loop; end Render; ---------------------------------------------------------------------- procedure Write_Graph (Object : in out Renderable_Graph; Location : Resources.Locations.Writable_Location_Ptr; Path : String) is package SU renames Ada.Strings.Unbounded; package SF renames Ada.Strings.Fixed; function Trim (Value : String) return String is (SF.Trim (Value, Ada.Strings.Both)); function Image (Value : String) return String is ('"' & Value & '"'); function Image (Value : Integer) return String is (Trim (Value'Image)); function Image (Value : Boolean) return String is (if Value then "true" else "false"); Result : SU.Unbounded_String; First : Boolean; procedure Append (Key, Value : String; Comma : Boolean := False) is begin SU.Append (Result, '"' & Key & '"' & ':' & Value); if Comma then SU.Append (Result, ','); end if; end Append; procedure Append_Comma is begin if not First then SU.Append (Result, ','); end if; First := False; end Append_Comma; begin SU.Append (Result, "{"); -- Vertices (render passes and resources) First := True; Append ("passes", "["); for Pass of Object.Graph.Passes loop Append_Comma; SU.Append (Result, '{'); Append ("name", Image (+Pass.Name), True); Append ("readCount", Image (Pass.Read_Count), True); Append ("writeCount", Image (Pass.Write_Count), True); Append ("sideEffect", Image (Pass.Side_Effect), True); Append ("references", Image (Pass.References)); SU.Append (Result, '}'); end loop; SU.Append (Result, "],"); First := True; Append ("resources", "["); for Resource of Object.Graph.Resources loop Append_Comma; SU.Append (Result, '{'); Append ("name", Image (+Resource.Description.Name), True); Append ("kind", Image (Resource.Description.Kind'Image), True); Append ("format", Image (Resource.Description.Format'Image), True); Append ("version", Image (Natural (Resource.Description.Version)), True); Append ("implicit", Image (Resource.Implicit), True); Append ("readMode", Image (Resource.Input_Mode'Image), True); Append ("writeMode", Image (Resource.Output_Mode'Image), True); Append ("readCount", Image (Resource.Read_Count), True); Append ("references", Image (Resource.References)); SU.Append (Result, '}'); end loop; SU.Append (Result, "],"); -- Edges (reads and writes) First := True; Append ("reads", "["); for Index in 1 .. Object.Graph.Passes.Length loop declare Pass : Render_Pass_Data renames Object.Graph.Passes (Index); begin -- Passes reading from resources for Resource_Index in Pass.Read_Offset .. Pass.Read_Offset + Pass.Read_Count - 1 loop declare Handle : Handle_Type renames Object.Graph.Read_Handles (Resource_Index); begin Append_Comma; SU.Append (Result, '{'); Append ("source", Image (Natural (Handle) - 1), True); Append ("target", Image (Natural (Index - 1))); SU.Append (Result, '}'); end; end loop; end; end loop; SU.Append (Result, "],"); First := True; Append ("writes", "["); for Index in 1 .. Object.Graph.Passes.Length loop declare Pass : Render_Pass_Data renames Object.Graph.Passes (Index); begin -- Passes writing to resources for Resource_Index in Pass.Write_Offset .. Pass.Write_Offset + Pass.Write_Count - 1 loop declare Handle : Handle_Type renames Object.Graph.Write_Handles (Resource_Index); begin Append_Comma; SU.Append (Result, '{'); Append ("source", Image (Natural (Index - 1)), True); Append ("target", Image (Natural (Handle) - 1)); SU.Append (Result, '}'); end; end loop; end; end loop; SU.Append (Result, "]"); SU.Append (Result, "}"); declare subtype JSON_Byte_Array is Resources.Byte_Array (1 .. Ada.Streams.Stream_Element_Offset (SU.Length (Result))); function Convert is new Ada.Unchecked_Conversion (Source => String, Target => JSON_Byte_Array); begin Location.Write_Data (Path, Convert (SU.To_String (Result))); end; end Write_Graph; end Orka.Frame_Graphs;