173 lines
4.2 KiB
Ada
173 lines
4.2 KiB
Ada
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;
|
|
|
|
|
|
|
|
|
|
-----------
|
|
--- Details
|
|
--
|
|
|
|
function to_Details (texture_Assets : in asset_Names;
|
|
Animation : in Animation_view := null) return Details
|
|
is
|
|
Result : Details;
|
|
begin
|
|
Result.texture_Count := texture_Assets'Length;
|
|
|
|
for i in 1 .. texture_Assets'Length
|
|
loop
|
|
Result.Textures (i) := texture_Assets (i);
|
|
end loop;
|
|
|
|
Result.Animation := Animation;
|
|
|
|
return Result;
|
|
end to_Details;
|
|
|
|
|
|
|
|
-- function to_Set (texture_Assets : in asset_Names;
|
|
-- Animation : in Animation_view := null) return Item
|
|
-- is
|
|
-- Result : Item (Count => texture_Assets'Length);
|
|
--
|
|
-- begin
|
|
-- for i in 1 .. Result.Count
|
|
-- loop
|
|
-- Result.Details (i).Object := texture.null_Object;
|
|
-- Result.Details (i).Texture := texture_Assets (Integer (i));
|
|
-- Result.Details (i).Fade := 0.0;
|
|
-- Result.Details (i).texture_Tiling := (S => 1.0, T => 1.0);
|
|
--
|
|
-- if i = 1
|
|
-- then
|
|
-- Result.Details (i).texture_Apply := True;
|
|
-- else
|
|
-- Result.Details (i).texture_Apply := False;
|
|
-- end if;
|
|
-- end loop;
|
|
--
|
|
-- Result.Animation := Animation;
|
|
--
|
|
-- return Result;
|
|
-- end to_Set;
|
|
|
|
|
|
|
|
--------------
|
|
--- Attributes
|
|
--
|
|
|
|
-- function get_Details (Self : in Item) return Detail_array
|
|
-- is
|
|
-- begin
|
|
-- return Self.Details;
|
|
-- end get_Details;
|
|
--
|
|
--
|
|
--
|
|
-- procedure Details_are (Self : in out Item; Now : in Detail_array)
|
|
-- is
|
|
-- begin
|
|
-- Self.Details := Now;
|
|
-- end Details_are;
|
|
--
|
|
--
|
|
--
|
|
-- function get_Animation (Self : in Item) return Animation_view
|
|
-- is
|
|
-- begin
|
|
-- return Self.Animation;
|
|
-- end get_Animation;
|
|
--
|
|
--
|
|
--
|
|
-- procedure Animation_is (Self : in out Item; Now : in Animation_view)
|
|
-- is
|
|
-- begin
|
|
-- Self.Animation := Now;
|
|
-- end Animation_is;
|
|
|
|
|
|
|
|
-----------
|
|
--- Streams
|
|
--
|
|
|
|
procedure write (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
|
|
Item : in Animation_view)
|
|
is
|
|
begin
|
|
if Item = null
|
|
then
|
|
Boolean'write (Stream, False);
|
|
else
|
|
Boolean'write (Stream, True);
|
|
Animation'output (Stream, Item.all);
|
|
end if;
|
|
end write;
|
|
|
|
|
|
|
|
procedure read (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
|
|
Item : out Animation_view)
|
|
is
|
|
Item_not_null : Boolean;
|
|
begin
|
|
Boolean'read (Stream, Item_not_null);
|
|
|
|
if Item_not_null
|
|
then
|
|
Item := new Animation' (Animation'Input (Stream));
|
|
else
|
|
Item := null;
|
|
end if;
|
|
end read;
|
|
|
|
|
|
end openGL.texture_Set;
|