From ab36317bd26a456d36eed83b60034dc627d6af5f Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Tue, 24 Sep 2024 13:45:18 +1000 Subject: [PATCH] opengl: Add texture animation. --- .../opengl-model-circle-lit_textured.adb | 16 ++++ .../opengl-model-circle-lit_textured.ads | 21 +++-- .../opengl-model-hexagon-lit_textured.adb | 19 +++++ .../opengl-model-hexagon-lit_textured.ads | 17 ++-- .../opengl-model-polygon-lit_textured.adb | 39 +++++---- .../opengl-model-polygon-lit_textured.ads | 25 ++++-- .../lean/model/opengl-model-texturing.ads | 4 - .../opengl/source/lean/model/opengl-model.ads | 10 ++- .../opengl/source/lean/opengl-texture_set.adb | 73 ++++++++++++++++ .../opengl/source/lean/opengl-texture_set.ads | 83 +++++++++++++++++-- 4-high/gel/source/forge/gel-forge.adb | 6 +- 11 files changed, 259 insertions(+), 54 deletions(-) diff --git a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb index 5d74724..082eebb 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb @@ -91,6 +91,22 @@ is + overriding + procedure animate (Self : in out Item) + is + use type texture_Set.Animation_view; + begin + if Self.Face.Animation = null + then + return; + end if; + + texture_Set.animate (Self.Face.Animation.all, + Self.Face.texture_Applies); + end animate; + + + --------------------- --- openGL Geometries -- diff --git a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads index f3d3b85..fd40aac 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads @@ -15,9 +15,10 @@ is type Face is record Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0]; - texture_Applies : texture_Set.texture_Apply_array := [others => True]; Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex. - texture_Count : Natural := 0; + texture_Count : Natural := 0; + texture_Applies : texture_Set.texture_Apply_array := [others => True]; + Animation : texture_Set.Animation_view; end record; @@ -43,17 +44,17 @@ is -- overriding - function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level; + function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level; overriding - procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in texture_Set.fade_Level); + procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in texture_Set.fade_Level); - procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in asset_Name); + procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in asset_Name); overriding - function texture_Count (Self : in Item) return Natural; + function texture_Count (Self : in Item) return Natural; overriding @@ -63,6 +64,10 @@ is procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; Now : in Boolean); + overriding + procedure animate (Self : in out Item); + + private diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb index 53483fa..d14689e 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb @@ -90,6 +90,25 @@ is + overriding + procedure animate (Self : in out Item) + is + use type texture_Set.Animation_view; + begin + if Self.Face.Animation = null + then + return; + end if; + + texture_Set.animate (Self.Face.Animation.all, + Self.Face.texture_Applies); + end animate; + + + + --------------------- + --- openGL Geometries + -- overriding function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads index 236d50d..0cc1630 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads @@ -18,6 +18,7 @@ is Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex. texture_Count : Natural := 0; texture_Applies : texture_Set.texture_Apply_array := [others => True]; + Animation : texture_Set.Animation_view; end record; @@ -42,17 +43,17 @@ is -- overriding - function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level; + function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level; overriding - procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in texture_Set.fade_Level); + procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in texture_Set.fade_Level); - procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in asset_Name); + procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in asset_Name); overriding - function texture_Count (Self : in Item) return Natural; + function texture_Count (Self : in Item) return Natural; overriding @@ -62,6 +63,10 @@ is procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; Now : in Boolean); + overriding + procedure animate (Self : in out Item); + + private diff --git a/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb index 57a8a60..b54406b 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb @@ -1,7 +1,9 @@ with openGL.Geometry.lit_textured, openGL.Primitive.indexed, - openGL.Texture.Coordinates; + openGL.Texture.Coordinates, + + ada.Calendar; package body openGL.Model.polygon.lit_textured @@ -84,7 +86,7 @@ is overriding procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in Boolean) + Now : in Boolean) is begin Self.Face.texture_Applies (Which) := Now; @@ -93,6 +95,21 @@ is + overriding + procedure animate (Self : in out Item) + is + use type texture_Set.Animation_view; + begin + if Self.Face.Animation = null + then + return; + end if; + + texture_Set.animate (Self.Face.Animation.all, + Self.Face.texture_Applies); + end animate; + + -------------------- --- to_GL_Geometries @@ -160,27 +177,17 @@ is end new_Face; - upper_Face : Geometry.lit_textured.view; + the_Face : Geometry.lit_textured.view; begin - -- Upper Face + -- Face -- declare use openGL.Texture.Coordinates; the_Vertices : Geometry.lit_textured.Vertex_array (1 .. the_Sites'Length + 1); Coords_and_Centroid : constant Coords_2D_and_Centroid := to_Coordinates (the_Sites); - -- Centroid : Vector_2 := (0.0, 0.0); begin - --- Calculate the centroid and min/max of x and y. - -- - -- for i in the_Sites'Range - -- loop - -- Centroid := Centroid + the_Sites (i); - -- end loop; - -- - -- Centroid := Centroid / Real (the_Sites'Length); - for i in the_Sites'Range loop the_Vertices (Index_t (i)) := (Site => Vector_3 (the_Sites (i) & 0.0), @@ -196,10 +203,10 @@ is T => 0.5 * Self.Face.texture_Tiling), Shine => default_Shine); - upper_Face := new_Face (Vertices => the_Vertices); + the_Face := new_Face (Vertices => the_Vertices); end; - return [1 => upper_Face.all'Access]; + return [1 => the_Face.all'Access]; end to_GL_Geometries; diff --git a/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.ads index c912028..8aa775a 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.ads @@ -12,6 +12,11 @@ is type View is access all Item'Class; + + -------- + --- Face + -- + type Face is record Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0]; @@ -19,6 +24,7 @@ is texture_Count : Natural := 0; texture_Tiling : openGL.Real := 1.0; -- The number of times the texture should be wrapped. texture_Applies : texture_Set.texture_Apply_array := [others => True]; + Animation : texture_Set.Animation_view; end record; @@ -43,17 +49,17 @@ is -- overriding - function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level; + function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level; overriding - procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in texture_Set.fade_Level); + procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in texture_Set.fade_Level); - procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in asset_Name); + procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in asset_Name); overriding - function texture_Count (Self : in Item) return Natural; + function texture_Count (Self : in Item) return Natural; overriding @@ -61,7 +67,11 @@ is overriding procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in Boolean); + Now : in Boolean); + + overriding + procedure animate (Self : in out Item); + private @@ -74,4 +84,5 @@ private Face : lit_textured.Face; end record; + end openGL.Model.polygon.lit_textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-texturing.ads b/3-mid/opengl/source/lean/model/opengl-model-texturing.ads index 1f41db6..72b71c0 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-texturing.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-texturing.ads @@ -3,10 +3,6 @@ with openGL.texture_Set, openGL.Program; --- limited --- with --- openGL.Model; - private package openGL.Model.texturing diff --git a/3-mid/opengl/source/lean/model/opengl-model.ads b/3-mid/opengl/source/lean/model/opengl-model.ads index 6450dc4..cbf0b31 100644 --- a/3-mid/opengl/source/lean/model/opengl-model.ads +++ b/3-mid/opengl/source/lean/model/opengl-model.ads @@ -74,16 +74,18 @@ is -- Texturing -- - function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level; - procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in texture_Set.fade_Level); + function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level; + procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in texture_Set.fade_Level); - function texture_Count (Self : in Item) return Natural; + function texture_Count (Self : in Item) return Natural; function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean; procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; Now : in Boolean); + procedure animate (Self : in out Item) is null; + private diff --git a/3-mid/opengl/source/lean/opengl-texture_set.adb b/3-mid/opengl/source/lean/opengl-texture_set.adb index e36b6a0..8ba06b5 100644 --- a/3-mid/opengl/source/lean/opengl-texture_set.adb +++ b/3-mid/opengl/source/lean/opengl-texture_set.adb @@ -12,6 +12,57 @@ with ada.Text_IO; use ada.Text_IO; package body openGL.texture_Set is + ------------- + --- Animation + -- + + function to_Frames (From : in texture_Set.texture_Ids) return Frames + is + Result : Frames (1 .. From'Length); + begin + for i in From'Range + loop + Result (i).texture_Id := From (i); + end loop; + + return Result; + end to_Frames; + + + + procedure animate (the_Animation : in out Animation; + texture_Applies : in out texture_Apply_array) + is + use ada.Calendar; + + Now : constant ada.Calendar.Time := Clock; + + begin + if Now >= the_Animation.next_frame_Time + then + declare + + next_frame_Id : constant frame_Id := (if the_Animation.Current < the_Animation.frame_Count then the_Animation.Current + 1 + else 1); + old_Frame : Frame renames the_Animation.Frames (the_Animation.Current); + new_Frame : Frame renames the_Animation.Frames (next_frame_Id); + begin + texture_Applies (old_Frame.texture_Id) := False; + texture_Applies (new_Frame.texture_Id) := True; + + the_Animation.Current := next_frame_Id; + the_Animation.next_frame_Time := Now + the_Animation.frame_Duration; + end; + end if; + end animate; + + + + + -------- + --- Item + -- + procedure Texture_is (in_Set : in out Item; Which : texture_ID; Now : in openGL.Texture.Object) is begin @@ -180,4 +231,26 @@ is end enable; + + ----------- + --- Streams + -- + + procedure write (Stream : not null access Ada.Streams.Root_Stream_Type'Class; + Item : in Animation_view) + is + begin + Animation'output (Stream, Item.all); + end write; + + + + procedure read (Stream : not null access Ada.Streams.Root_Stream_Type'Class; + Item : out Animation_view) + is + begin + Item := new Animation' (Animation'Input (Stream)); + end read; + + end openGL.texture_Set; diff --git a/3-mid/opengl/source/lean/opengl-texture_set.ads b/3-mid/opengl/source/lean/opengl-texture_set.ads index d7daff1..9a5c905 100644 --- a/3-mid/opengl/source/lean/opengl-texture_set.ads +++ b/3-mid/opengl/source/lean/opengl-texture_set.ads @@ -1,23 +1,36 @@ with openGL.Program, openGL.Texture, - openGL.Variable.uniform; + ada.Calendar; + +private +with + ada.Streams; package openGL.texture_Set -- --- Facilitates texturing of geometries. +-- Facilitates multi-texturing of geometries. +-- +-- Note that Mesa currently only supports 16 texture units. -- is - --- Note that Mesa currently only supports 16 texture units. + + --------------- + --- Texture Ids -- - -- max_Textures : constant := 32; - max_Textures : constant := 16; - type texture_Id is range 1 .. max_Textures; + max_Textures : constant := 16; -- 32; + + type texture_Id is range 1 .. max_Textures; + type texture_Ids is array (Positive range <>) of texture_Id; + -------- + --- Fade + -- + type fade_Level is delta 0.001 range 0.0 .. 1.0 -- '0.0' is no fading, '1.0' is fully faded (ie invisible). with Atomic; @@ -31,7 +44,7 @@ is record Fade : fade_Level := 0.0; Object : openGL.Texture.Object := openGL.Texture.null_Object; - Applied : Boolean := True; -- Whether this texture is painted on. + Applied : Boolean := True; -- Whether this texture is painted on or not. -- texture_Uniform : openGL.Variable.uniform.sampler2D; -- fade_Uniform : openGL.Variable.uniform.float; end record; @@ -39,6 +52,45 @@ is type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture; + + ------------- + --- Animation + -- + + subtype frame_Id is Positive; + + type Frame is + record + texture_Id : texture_Set.texture_Id; + end record; + + type Frames is array (frame_Id range <>) of Frame; + + function to_Frames (From : in texture_Ids) return Frames; + + + + type Animation (frame_Count : Positive) is + record + frame_Duration : Duration := 0.1; + next_frame_Time : ada.Calendar.Time := ada.Calendar.Clock; + + Current : frame_Id := 1; + Frames : texture_Set.Frames (1 .. frame_Count); + end record; + + type Animation_view is access all Animation; + + + procedure animate (the_Animation : in out Animation; + texture_Applies : in out texture_Apply_array); + + + + -------- + --- Item + -- + type Item is record Textures : fadeable_Textures; @@ -59,4 +111,21 @@ is function Texture (in_Set : in Item) return openGL.Texture.Object; + +private + + ----------- + --- Streams + -- + + procedure write (Stream : not null access ada.Streams.Root_Stream_type'Class; + Item : in texture_Set.Animation_view); + + procedure read (Stream : not null access ada.Streams.Root_Stream_type'Class; + Item : out texture_Set.Animation_view); + + for Animation_view'write use write; + for Animation_view'read use read; + + end openGL.texture_Set; diff --git a/4-high/gel/source/forge/gel-forge.adb b/4-high/gel/source/forge/gel-forge.adb index 8b8dfae..4dc481a 100644 --- a/4-high/gel/source/forge/gel-forge.adb +++ b/4-high/gel/source/forge/gel-forge.adb @@ -166,7 +166,8 @@ is Face => (Fades => [1 => 0.0, others => <>], texture_Applies => [1 => True, others => <>], Textures => [1 => Texture, others => <>], - texture_Count => 1)).all'Access; + texture_Count => 1, + Animation => null)).all'Access; end if; return gel.Sprite.Forge.new_Sprite (Name, @@ -225,7 +226,8 @@ is Textures => [1 => Texture, others => <>], texture_Count => 1, texture_Tiling => texture_Tiling, - texture_Applies => [others => <>])).all'Access; + texture_Applies => [others => <>], + Animation => null)).all'Access; end if; return gel.Sprite.Forge.new_Sprite (Name,