orka_b455160b/orka_tools/src/orka_ktx.adb

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2017 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.

with Ada.Command_Line;
with Ada.Containers.Indefinite_Holders;
with Ada.Directories;
with Ada.Exceptions;
with Ada.Real_Time;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Ada.Containers.Vectors;

with GL.Objects.Samplers;
with GL.Objects.Textures;
with GL.Toggles;
with GL.Types;
with GL.Viewports;

with Orka.Behaviors;
with Orka.Cameras.Rotate_Around_Cameras;
with Orka.Contexts.AWT;
with Orka.Debug;
with Orka.Loggers.Terminal;
with Orka.Logging;
with Orka.Loops;
with Orka.Rendering.Drawing;
with Orka.Rendering.Framebuffers;
with Orka.Rendering.Programs.Modules;
with Orka.Rendering.Programs.Uniforms;
with Orka.Rendering.Textures;
with Orka.Resources.Locations.Directories;
with Orka.Resources.Textures.KTX;
with Orka.Types;
with Orka.Windows;

with AWT.Inputs;

with Orka_Package_KTX;

procedure Orka_KTX is
   Width   : constant := 1280;
   Height  : constant := 720;

   type Zoom_Mode is (Best_Fit, Actual_Size);

   type View_Mode is (External, Internal);

   package Job_System renames Orka_Package_KTX.Job_System;
   package Loader     renames Orka_Package_KTX.Loader;

   use type Orka.Integer_32;

   package SU renames Ada.Strings.Unbounded;

   use type SU.Unbounded_String;
begin
   if Ada.Command_Line.Argument_Count /= 1 then
      Ada.Text_IO.Put_Line ("Usage: <path to .ktx file>");
      Job_System.Shutdown;
      Loader.Shutdown;
      return;
   end if;

   Orka.Logging.Set_Logger (Orka.Loggers.Terminal.Create_Logger (Level => Orka.Loggers.Info));

   declare
      Context : constant Orka.Contexts.Context'Class := Orka.Contexts.AWT.Create_Context
        (Version => (4, 2), Flags  => (Debug => True, others => False));

      Window : constant Orka.Windows.Window'Class
        := Orka.Contexts.AWT.Create_Window (Context, Width, Height, Resizable => False);
   begin
      Orka.Debug.Set_Log_Messages (Enable => True);

      declare
         Full_Path     : constant String := Ada.Command_Line.Argument (1);

         Location_Path : constant String := Ada.Directories.Containing_Directory (Full_Path);

         Texture_Path      : SU.Unbounded_String :=
           SU.To_Unbounded_String (Ada.Directories.Simple_Name (Full_Path));
         Load_Texture_Path : SU.Unbounded_String := Texture_Path;

         type Load_Action_Kind is (Previous_File, Next_File);

         procedure Load_File (Action : Load_Action_Kind) is
            package String_Vectors is new Ada.Containers.Vectors
              (Positive, SU.Unbounded_String);

            Files : String_Vectors.Vector;

            procedure Process_File (File : Ada.Directories.Directory_Entry_Type) is
               Name : constant String := Ada.Directories.Simple_Name (File);
            begin
               Files.Append (SU.To_Unbounded_String (Name));
            end Process_File;

            use all type Ada.Directories.File_Kind;
         begin
            Ada.Directories.Search
              (Directory => Location_Path,
               Pattern   => "*.ktx",
               Filter    => (Ordinary_File => True, others => False),
               Process   => Process_File'Access);

            declare
               Cursor : String_Vectors.Cursor := Files.Find (Texture_Path);

               use type String_Vectors.Cursor;
            begin
               case Action is
                  when Previous_File =>
                     Cursor := String_Vectors.Previous (Cursor);
                  when Next_File =>
                     Cursor := String_Vectors.Next (Cursor);
               end case;

               if Cursor /= String_Vectors.No_Element then
                  Load_Texture_Path := Files (Cursor);
               end if;
            end;
         end Load_File;

         use Orka.Rendering.Programs;
         use Orka.Rendering.Framebuffers;
         use Orka.Resources;

         ----------------------------------------------------------------------

         FB_D : Framebuffer := Create_Default_Framebuffer (Window.Width, Window.Height);

         use Orka.Cameras;
         Lens : constant Camera_Lens :=
           Create_Lens (Width, Height, Transforms.FOV (36.0, 50.0));
         Current_Camera : aliased Rotate_Around_Cameras.Rotate_Around_Camera :=
           Rotate_Around_Cameras.Create_Camera (Lens);

         ----------------------------------------------------------------------

         use GL.Objects.Textures;
         use GL.Objects.Samplers;

         Sampler_1 : Sampler;

         Location_Textures : constant Locations.Location_Ptr :=
           Locations.Directories.Create_Location (Location_Path);

         package Texture_Holders is new Ada.Containers.Indefinite_Holders
           (Element_Type => GL.Objects.Textures.Texture);

         T_1 : Texture_Holders.Holder;

         Maximum_Level : Mipmap_Level;

         ----------------------------------------------------------------------

         Location_Shaders : constant Locations.Location_Ptr
           := Locations.Directories.Create_Location ("data/shaders");

         function Get_Module (Kind : LE.Texture_Kind) return Modules.Module is
            use all type LE.Texture_Kind;
         begin
            case Kind is
               when Texture_1D =>
                  return Modules.Create_Module (Location_Shaders,
                    VS => "oversized-triangle.vert",
                    FS => "tools/ktx-1D.frag");
               when Texture_2D =>
                  return Modules.Create_Module (Location_Shaders,
                    VS => "oversized-triangle.vert",
                    FS => "tools/ktx-2D.frag");
               when Texture_3D =>
                  return Modules.Create_Module (Location_Shaders,
                    VS => "tools/volume.vert",
                    FS => "tools/ktx-3D.frag");
               when Texture_Cube_Map =>
                  return Modules.Create_Module (Location_Shaders,
                    VS => "tools/cube.vert",
                    FS => "tools/ktx-cube.frag");
               when Texture_2D_Array =>
                  return Modules.Create_Module (Location_Shaders,
                    VS => "oversized-triangle.vert",
                    FS => "tools/ktx-2D-array.frag");
               when others => raise Constraint_Error with "Unsupported texture kind";
            end case;
         end Get_Module;

         procedure Draw (Kind : LE.Texture_Kind) is
            use all type LE.Texture_Kind;
         begin
            case Kind is
               when Texture_1D | Texture_2D | Texture_2D_Array =>
                  Orka.Rendering.Drawing.Draw (GL.Types.Triangles, 0, 3);
               when Texture_3D | Texture_Cube_Map =>
                  Orka.Rendering.Drawing.Draw (GL.Types.Triangles, 0, 6 * 6);
               when others => raise Constraint_Error;
            end case;
         end Draw;

         procedure Update_Title
           (Kind   : LE.Texture_Kind;
            Mode   : Zoom_Mode;
            View   : View_Mode;
            Colors : Boolean;
            Level, Levels : Mipmap_Level)
         is
            use all type LE.Texture_Kind;

            Text : SU.Unbounded_String := "KTX viewer - " & Texture_Path;
         begin
            if Levels > 1 then
               SU.Append (Text, " (level " & Orka.Logging.Trim (Mipmap_Level'Image (Level + 1)) &
                 "/" & Orka.Logging.Trim (Levels'Image) & ")");
            end if;

            case Kind is
               when Texture_1D | Texture_2D | Texture_2D_Array =>
                  SU.Append (Text, " (zoom: " & Mode'Image & ")");
               when Texture_3D | Texture_Cube_Map =>
                  SU.Append (Text, " (view: " & View'Image & ")");
                  SU.Append (Text, " (colors: " & Colors'Image & ")");
               when others => null;
            end case;

            Window.Set_Title (SU.To_String (Text));
         end Update_Title;

         function Get_Orientation
           (Pointer     : AWT.Inputs.Pointer_State;
            Render_View : View_Mode;
            Rotate      : Boolean) return Orka.Types.Doubles.Vector4
         is
            use all type AWT.Inputs.Dimension;
            use all type Orka.Index_4D;
            use type Orka.Float_64;

            Result : Orka.Types.Doubles.Vector4 :=
              (0.0, 0.0, Orka.Float_64 (Pointer.Scroll (Y)), 0.0);
         begin
            if Rotate then
               Result (X) := Orka.Float_64 (Pointer.Relative (X));
               Result (Y) := Orka.Float_64 (Pointer.Relative (Y));

               case Render_View is
                  when Internal => Result (X) := -Result (X);
                  when External => Result (Y) := -Result (Y);
               end case;
            end if;

            return Result;
         end Get_Orientation;

         P_1 : Program;
      begin
         --  Clear color to black and depth to 0.0 (because of reversed Z)
         FB_D.Set_Default_Values
           ((Color => (0.0, 0.0, 0.0, 1.0), Depth => 0.0, others => <>));

         FB_D.Use_Framebuffer;

         Sampler_1.Set_X_Wrapping (Clamp_To_Edge);
         Sampler_1.Set_Y_Wrapping (Clamp_To_Edge);

         Sampler_1.Set_Minifying_Filter (Linear);
         Sampler_1.Set_Magnifying_Filter (Linear);

         Sampler_1.Bind (0);

         GL.Toggles.Disable (GL.Toggles.Depth_Test);
         GL.Toggles.Enable (GL.Toggles.Texture_Cube_Map_Seamless);

         declare
            Level : Mipmap_Level := 0 with Atomic;

            Render_Zoom   : Zoom_Mode := Best_Fit with Atomic;
            Render_View   : View_Mode := External with Atomic;
            Render_Colors : Boolean   := False  with Atomic;

            package Loops is new Orka.Loops
              (Time_Step   => Ada.Real_Time.Microseconds (2_083),
               Frame_Limit => Ada.Real_Time.Microseconds (16_667),
               Camera      => Current_Camera'Unchecked_Access,
               Job_Manager => Job_System);

            procedure Render
              (Scene  : not null Orka.Behaviors.Behavior_Array_Access;
               Camera : Orka.Cameras.Camera_Ptr)
            is
               use all type LE.Texture_Kind;
            begin
               FB_D.Clear;

               if Load_Texture_Path /= SU.Null_Unbounded_String then
                  T_1 := Texture_Holders.To_Holder (Orka.Resources.Textures.KTX.Read_Texture
                    (Location_Textures, SU.To_String (Load_Texture_Path)));

                  P_1 := Create_Program (Get_Module (T_1.Constant_Reference.Kind));
                  P_1.Use_Program;

                  declare
                     Uni_Texture : constant Uniforms.Uniform_Sampler :=
                       P_1.Uniform_Sampler ("colorTexture");
                  begin
                     Uni_Texture.Verify_Compatibility (T_1.Constant_Reference);
                     Orka.Rendering.Textures.Bind
                       (T_1.Constant_Reference, Orka.Rendering.Textures.Texture, 0);
                  end;

                  Maximum_Level := T_1.Constant_Reference.Mipmap_Levels - 1;
                  Level         := Mipmap_Level'Min (Level, Maximum_Level);

                  Texture_Path      := Load_Texture_Path;
                  Load_Texture_Path := SU.Null_Unbounded_String;
               end if;

               T_1.Constant_Reference.Set_Lowest_Mipmap_Level (Level);

               Update_Title
                 (T_1.Constant_Reference.Kind, Render_Zoom, Render_View, Render_Colors,
                  Level, Maximum_Level + 1);

               case T_1.Constant_Reference.Kind is
                  when Texture_1D | Texture_2D | Texture_2D_Array =>
                     declare
                        Uni_Screen   : constant Uniforms.Uniform := P_1.Uniform ("screenSize");
                        Uni_Best_Fit : constant Uniforms.Uniform := P_1.Uniform ("useBestFit");
                     begin
                        Uni_Screen.Set_Vector (Orka.Types.Singles.Vector4'
                          (Orka.Float_32 (Window.Width), Orka.Float_32 (Window.Height), 0.0, 0.0)
                        );
                        Uni_Best_Fit.Set_Boolean (Render_Zoom = Best_Fit);
                     end;
                  when Texture_3D | Texture_Cube_Map =>
                     declare
                        Uni_View : constant Uniforms.Uniform := P_1.Uniform ("view");
                        Uni_Proj : constant Uniforms.Uniform := P_1.Uniform ("proj");

                        Uni_External : constant Uniforms.Uniform := P_1.Uniform ("showExternal");
                        Uni_Colors   : constant Uniforms.Uniform := P_1.Uniform ("showColors");
                     begin
                        Uni_View.Set_Matrix (Camera.View_Matrix);
                        Uni_Proj.Set_Matrix (Camera.Projection_Matrix);

                        Uni_External.Set_Boolean (Render_View = External);
                        Uni_Colors.Set_Boolean (Render_Colors);
                     end;
                  when others => null;
               end case;

               --  The viewport of the default framebuffer could be adjusted
               --  automatically by implementing Window's procedure On_Configure
               GL.Viewports.Set_Viewports
                 ((0 => (X      => 0.0,
                         Y      => 0.0,
                         Width  => Orka.Float_32 (Window.Width),
                         Height => Orka.Float_32 (Window.Height))
                 ));

               Draw (T_1.Constant_Reference.Kind);

               Window.Swap_Buffers;

               if Window.Should_Close then
                  Loops.Stop_Loop;
               end if;
            end Render;
         begin
            Loops.Scene.Add (Orka.Behaviors.Null_Behavior);

            declare
               task Render_Task is new Orka.Contexts.Task_With_Surface_Context with
                  entry Move_Context
                    (Context : not null Orka.Contexts.Surface_Context_Access;
                     Window  : in out Orka.Windows.Window'Class);
               end Render_Task;

               task body Render_Task is
                  Context : Orka.Contexts.Surface_Context_Access;
               begin
                  accept Move_Context
                    (Context : not null Orka.Contexts.Surface_Context_Access;
                     Window  : in out Orka.Windows.Window'Class)
                  do
                     Context.Make_Current (Window);
                     Render_Task.Context := Context;
                  end Move_Context;

                  Loops.Run_Loop (Render'Access);
                  Context.Make_Not_Current;
               exception
                  when Error : others =>
                     Ada.Text_IO.Put_Line ("Error: " &
                       Ada.Exceptions.Exception_Information (Error));
                     Context.Make_Not_Current;
                     raise;
               end Render_Task;

               Did_Rotate_Camera : Boolean := False;
            begin
               Context.Move_To (Render_Task, Window);

               while not Window.Should_Close loop
                  AWT.Process_Events (0.016667);

                  declare
                     Pointer  : constant AWT.Inputs.Pointer_State  := Window.State;
                     Keyboard : constant AWT.Inputs.Keyboard_State := Window.State;

                     use all type AWT.Inputs.Button_State;
                     use all type AWT.Inputs.Keyboard_Button;
                     use all type AWT.Inputs.Pointer_Button;
                     use all type AWT.Inputs.Pointer_Mode;

                     Rotate_Camera : constant Boolean :=
                       Pointer.Focused and Pointer.Buttons (Right) = Pressed;
                  begin
                     if Keyboard.Pressed (Key_Escape) then
                        Window.Close;
                     end if;

                     if Keyboard.Pressed (Key_Arrow_Down) then
                        Level := Mipmap_Level'Max (0, Level - 1);
                     end if;

                     if Keyboard.Pressed (Key_Arrow_Up) then
                        Level := Mipmap_Level'Min (Maximum_Level, Level + 1);
                     end if;

                     if Keyboard.Pressed (Key_Arrow_Left) then
                        Load_File (Previous_File);
                     end if;

                     if Keyboard.Pressed (Key_Arrow_Right) then
                        Load_File (Next_File);
                     end if;

                     if Keyboard.Pressed (Key_Z) then
                        if Render_Zoom = Zoom_Mode'Last then
                           Render_Zoom := Zoom_Mode'First;
                        else
                           Render_Zoom := Zoom_Mode'Succ (Render_Zoom);
                        end if;
                     end if;

                     if Keyboard.Pressed (Key_V) then
                        if Render_View = View_Mode'Last then
                           Render_View := View_Mode'First;
                        else
                           Render_View := View_Mode'Succ (Render_View);
                        end if;
                     end if;

                     if Keyboard.Pressed (Key_C) then
                        Render_Colors := not Render_Colors;
                     end if;

                     if Rotate_Camera /= Did_Rotate_Camera then
                        Window.Set_Pointer_Mode (if Rotate_Camera then Locked else Visible);
                     end if;
                     Did_Rotate_Camera := Rotate_Camera;

                     --  FIXME Update with PO?
                     Rotate_Around_Cameras.Rotate_Around_Camera'Class
                       (Current_Camera).Change_Orientation
                          (Get_Orientation (Pointer, Render_View, Rotate_Camera));
                  end;
               end loop;
            end;
         end;
      end;
   end;

   Job_System.Shutdown;
   Loader.Shutdown;
exception
   when Error : others =>
      Ada.Text_IO.Put_Line ("Error: " & Ada.Exceptions.Exception_Information (Error));
      Job_System.Shutdown;
      Loader.Shutdown;
end Orka_KTX;