with Ada.Exceptions;
package body WL.Images is
------------
-- Create --
------------
procedure Create
(Image : in out Image_Type'Class;
Width : Pixel_X_Count;
Height : Pixel_Y_Count;
Layers : Layer_Count := 1)
is
Layer : Image_Layer_Record := (Width, Height, others => <>);
begin
for I in 1 .. Layers loop
Layer.Data := new Image_Data (1 .. Width, 1 .. Height);
Image.Layers.Append (Layer);
end loop;
end Create;
----------
-- Read --
----------
procedure Read
(Reader : Image_Reader'Class;
Path : String;
Image : out Image_Type'Class)
is
File : WL.Binary_IO.File_Type;
begin
WL.Binary_IO.Open (File, WL.Binary_IO.In_File, Path);
Reader.Read (File, Image);
WL.Binary_IO.Close (File);
exception
when E : others =>
raise Constraint_Error with
"Unable to read from '"
& Path & "': " & Ada.Exceptions.Exception_Message (E);
end Read;
---------------
-- Set_Color --
---------------
procedure Set_Color
(Image : in out Image_Type'Class;
X : Pixel_X_Range;
Y : Pixel_Y_Range;
Color : Image_Color)
is
begin
Image.Set_Color (1, X, Y, Color);
end Set_Color;
---------------
-- Set_Color --
---------------
procedure Set_Color
(Image : in out Image_Type'Class;
Layer : Layer_Index;
X : Pixel_X_Range;
Y : Pixel_Y_Range;
Color : Image_Color)
is
begin
Image.Layers (Layer).Data (X, Y) := Color;
end Set_Color;
-----------
-- Write --
-----------
procedure Write
(Writer : Image_Writer'Class;
Path : String;
Image : Image_Type'Class)
is
File : WL.Binary_IO.File_Type;
begin
WL.Binary_IO.Create (File, WL.Binary_IO.Out_File, Path);
Writer.Write (File, Image);
WL.Binary_IO.Close (File);
exception
when E : others =>
raise Constraint_Error with
"Unable to write to '"
& Path & "': " & Ada.Exceptions.Exception_Message (E);
end Write;
end WL.Images;