Vovanium
/
Video_library
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

>refactor< images

This commit is contained in:
Vovanium 2023-08-04 23:47:16 +03:00
parent 2f392b68f1
commit ba260cd54d
9 changed files with 49 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
source/base/video-images-indexed-fixed.ads
View File

@ -10,8 +10,7 @@ package Video.Images.Indexed.Fixed is
package With_Own_Palette is new Raster.Generic_Fixed (
Raster_Images => Base.Raster,
Parent => Base.Own.Base_Color_Map,
Map_Color => Base.Own.Map_Color);
Parent => Base.Own.Indexed_Image_Base);
type Image_with_Own_Palette is new With_Own_Palette.Image with null record;
@ -19,8 +18,7 @@ package Video.Images.Indexed.Fixed is
package With_Shared_Palette is new Raster.Generic_Fixed (
Raster_Images => Base.Raster,
Parent => Base.Shared.Base_Color_Map,
Map_Color => Base.Shared.Map_Color);
Parent => Base.Shared.Indexed_Image_Base);
type Image_with_Shared_Palette is new With_Shared_Palette.Image with null record;

6
source/base/video-images-indexed-unbounded.ads
View File

@ -10,8 +10,7 @@ package Video.Images.Indexed.Unbounded is
package With_Own_Palette is new Raster.Generic_Unbounded (
Raster_Images => Base.Raster,
Parent => Base.Own.Base_Color_Map,
Map_Color => Base.Own.Map_Color);
Parent => Base.Own.Indexed_Image_Base);
type Image_with_Own_Palette is new With_Own_Palette.Image with null record;
@ -19,8 +18,7 @@ package Video.Images.Indexed.Unbounded is
package With_Shared_Palette is new Raster.Generic_Unbounded (
Raster_Images => Base.Raster,
Parent => Base.Shared.Base_Color_Map,
Map_Color => Base.Shared.Map_Color);
Parent => Base.Shared.Indexed_Image_Base);
type Image_with_Shared_Palette is new With_Shared_Palette.Image with null record;

21
source/base/video-images-indexed.ads
View File

@ -30,29 +30,38 @@ package Video.Images.Indexed is
Array_Type => Array_Type,
Parent => Indexed_Image);
subtype Image is Raster.Image;
package Fixed_Color_Maps is new Colors.Maps.Generic_Fixed (0, Pixel_Type'Modulus - 1);
generic
type Parent_Color_Map is new Video.Colors.Maps.Constant_Color_Map with private;
type Color_Map is new Video.Colors.Maps.Constant_Color_Map with private;
package Images_with_Color_Map is
type Base_Color_Map is abstract new Parent_Color_Map and Raster.Image with null record;
type Indexed_Image_Base
is abstract new Color_Map and Raster.Image with null record;
function Map_Color (Map : Base_Color_Map; Pixel : Pixel_Type) return Color
function Map_Color (Map : Indexed_Image_Base; Pixel : Pixel_Type) return Color
is (Map.Map_Color (Color_Index (Pixel))) with Inline;
overriding function Pixel_Index (
Source : Base_Color_Map;
Source : Indexed_Image_Base;
A : Point)
return Color_Index
is (Color_Index (Pixel_Type'(Raster.Image'Class (Source).Pixel (A))));
function Pixel (
Source : Indexed_Image_Base;
A : Point)
return Color
is (Source.Map_Color (Color_Index (Pixel_Type'(Raster.Image'Class (Source).Pixel (A)))));
end Images_with_Color_Map;
package Own is new Images_with_Color_Map (
Parent_Color_Map => Fixed_Color_Maps.Fixed_Color_Map);
Color_Map => Fixed_Color_Maps.Fixed_Color_Map);
package Shared is new Images_with_Color_Map (
Parent_Color_Map => Colors.Maps.Shared_Palettes.Constant_Shared_Palette);
Color_Map => Colors.Maps.Shared_Palettes.Constant_Shared_Palette);
end Indexed_Base;

7
source/base/video-images-raster-generic_fixed.ads
View File

@ -5,7 +5,6 @@
generic
with package Raster_Images is new Generic_Raster (<>);
type Parent is abstract tagged private;
with function Map_Color (Map : Parent; Pixel : Raster_Images.Pixel_Type) return Color is <>;
package Video.Images.Raster.Generic_Fixed is
type Image (X_First, X_Last, Y_First, Y_Last : Integer)
@ -22,12 +21,6 @@ package Video.Images.Raster.Generic_Fixed is
return Raster_Images.Pixel_Type
is (Source.Pixels (A.Y, A.X));
overriding function Pixel (
Source : Image;
A : Point)
return Color
is (Map_Color (Parent (Source), Source.Pixels (A.Y, A.X)));
overriding procedure Query_Raster (
Source : in Image;
Query : not null access procedure (R : in Raster_Images.Array_Type));

10
source/base/video-images-raster-generic_unbounded.adb
View File

@ -19,16 +19,6 @@ package body Video.Images.Raster.Generic_Unbounded is
return Data.all (A.Y, A.X);
end Pixel;
overriding function Pixel (
Source : Image;
A : Point)
return Color
is
Data : access Raster_Images.Array_Type := Source.Pixels.Reference;
begin
return Map_Color (Parent (Source), Data.all (A.Y, A.X));
end Pixel;
overriding procedure Query_Raster (
Source : in Image;
Query : not null access procedure (R : in Raster_Images.Array_Type))

6
source/base/video-images-raster-generic_unbounded.ads
View File

@ -7,7 +7,6 @@ with Video.Pixels.Generic_Holders;
generic
with package Raster_Images is new Generic_Raster (<>);
type Parent is abstract tagged private;
with function Map_Color (Map : Parent; Pixel : Raster_Images.Pixel_Type) return Color is <>;
package Video.Images.Raster.Generic_Unbounded is
type Image is abstract new Parent and Raster_Images.Image with private;
@ -19,11 +18,6 @@ package Video.Images.Raster.Generic_Unbounded is
A : Point)
return Raster_Images.Pixel_Type;
overriding function Pixel (
Source : Image;
A : Point)
return Color;
overriding procedure Query_Raster (
Source : in Image;
Query : not null access procedure (R : in Raster_Images.Array_Type));

21
source/base/video-images-rgb-fixed.ads
View File

@ -3,22 +3,12 @@ with Video.Images.Raster.Generic_Fixed;
package Video.Images.RGB.Fixed is
generic
type Pixel_Type is private;
type Array_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
with function To_Color (Pixel : Pixel_Type) return Color is <>;
with package Raster_Images is new Generic_Raster (
Pixel_Type => Pixel_Type,
Array_Type => Array_Type,
Parent => RGB_Raster_Image);
with package Base is new RGB.Base (
Pixel_Type => Pixel_Type,
To_Color => To_Color);
with package Base is new RGB_Base (<>);
package Generic_Fixed is
package Fixed_Base is new Raster.Generic_Fixed (
Raster_Images => Raster_Images,
Parent => Base.Raster_Image_Base,
Map_Color => Base.Map_Color);
Raster_Images => Base.Raster,
Parent => Base.RGB_Image_Base);
-- Generic instantiation
type Image is new Fixed_Base.Image with null record;
@ -27,9 +17,6 @@ package Video.Images.RGB.Fixed is
end Generic_Fixed;
package Fixed_RGB888 is new Generic_Fixed (
Pixel_Type => RGB888_Pixel,
Array_Type => RGB888_Array,
Raster_Images => RGB888,
Base => RGB888_Base);
Base => RGB888);
end Video.Images.RGB.Fixed;

26
source/base/video-images-rgb-unbounded.ads
View File

@ -3,22 +3,12 @@ with Video.Images.Raster.Generic_Unbounded;
package Video.Images.RGB.Unbounded is
generic
type Pixel_Type is private;
type Array_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
with function To_Color (Pixel : Pixel_Type) return Color is <>;
with package Raster_Images is new Generic_Raster (
Pixel_Type => Pixel_Type,
Array_Type => Array_Type,
Parent => RGB_Raster_Image);
with package Base is new RGB.Base (
Pixel_Type => Pixel_Type,
To_Color => To_Color);
with package Base is new RGB_Base (<>);
package Generic_Unbounded is
package Unbounded_Base is new Raster.Generic_Unbounded (
Raster_Images => Raster_Images,
Parent => Base.Raster_Image_Base,
Map_Color => Base.Map_Color);
Raster_Images => Base.Raster,
Parent => Base.RGB_Image_Base);
-- Generic instantiation
type Image is new Unbounded_Base.Image with null record;
@ -27,15 +17,9 @@ package Video.Images.RGB.Unbounded is
end Generic_Unbounded;
package Unbounded_RGB565 is new Generic_Unbounded (
Pixel_Type => RGB565_Pixel,
Array_Type => RGB565_Array,
Raster_Images => RGB565,
Base => RGB565_Base);
Base => RGB565);
package Unbounded_RGB888 is new Generic_Unbounded (
Pixel_Type => RGB888_Pixel,
Array_Type => RGB888_Array,
Raster_Images => RGB888,
Base => RGB888_Base);
Base => RGB888);
end Video.Images.RGB.Unbounded;

39
source/base/video-images-rgb.ads
View File

@ -6,34 +6,37 @@ use Video.Pixels.RGB;
package Video.Images.RGB is
type RGB_Raster_Image is limited interface and Raster_Image;
type RGB_Image is limited interface and Raster_Image;
generic
type Pixel_Type is private;
type Array_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
with function To_Color (Pixel : Pixel_Type) return Color is <>;
package Base is
package RGB_Base is
type Raster_Image_Base is abstract tagged null record;
package Raster is new Generic_Raster (
Pixel_Type => Pixel_Type,
Array_Type => Array_Type,
Parent => RGB_Image);
function Map_Color (Map : Raster_Image_Base; Pixel : Pixel_Type) return Color
is (To_Color (Pixel)) with Inline;
subtype Image is Raster.Image;
end Base;
type RGB_Image_Base is abstract new Image with null record;
package RGB565 is new Generic_Raster (
function Pixel (
Source : RGB_Image_Base;
A : Point)
return Color
is (To_Color (Pixel_Type'(Raster.Image'Class (Source).Pixel (A))));
end RGB_Base;
package RGB565 is new RGB_Base (
Pixel_Type => RGB565_Pixel,
Array_Type => RGB565_Array,
Parent => RGB_Raster_Image);
Array_Type => RGB565_Array);
package RGB565_Base is new Base (
Pixel_Type => RGB565_Pixel);
package RGB888 is new Generic_Raster (
package RGB888 is new RGB_Base (
Pixel_Type => RGB888_Pixel,
Array_Type => RGB888_Array,
Parent => RGB_Raster_Image);
package RGB888_Base is new Base (
Pixel_Type => RGB888_Pixel);
Array_Type => RGB888_Array);
end Video.Images.RGB;