From 82450aaff2164464a9928a3a01103e7429e35948 Mon Sep 17 00:00:00 2001 From: Vovanium Date: Mon, 13 Feb 2023 03:25:22 +0300 Subject: [PATCH] >refactor< unbounded images --- .../video-images-raster-generic_unbounded.adb | 50 ++++++++++++ .../video-images-raster-generic_unbounded.ads | 41 ++++++++++ ...eo-images-raster-indexed-generic_fixed.ads | 1 - ...mages-raster-indexed-generic_unbounded.adb | 80 ------------------ ...mages-raster-indexed-generic_unbounded.ads | 81 ++++++++----------- 5 files changed, 124 insertions(+), 129 deletions(-) create mode 100644 source/base/video-images-raster-generic_unbounded.adb create mode 100644 source/base/video-images-raster-generic_unbounded.ads delete mode 100644 source/base/video-images-raster-indexed-generic_unbounded.adb diff --git a/source/base/video-images-raster-generic_unbounded.adb b/source/base/video-images-raster-generic_unbounded.adb new file mode 100644 index 0000000..9a8949e --- /dev/null +++ b/source/base/video-images-raster-generic_unbounded.adb @@ -0,0 +1,50 @@ +package body Video.Images.Raster.Generic_Unbounded is + + overriding function Bounding_Box (Source : Image) return Box + is + Data : Raster_Holders.Constant_Reference_Type := Source.Pixels.Constant_Reference; + R : Raster_Images.Raster_Type renames Data.Element.all; + begin + return (X => (R'First (2), R'Last (2)), + Y => (R'First (1), R'Last (1))); + end; + + overriding function Pixel ( + Source : Image; + A : Point) + return Raster_Images.Pixel_Type + is + Data : Raster_Holders.Constant_Reference_Type := Source.Pixels.Constant_Reference; + begin + return Data.Element.all (A.Y, A.X); + end Pixel; + + overriding function Pixel ( + Source : Image; + A : Point) + return Color + is + Data : Raster_Holders.Constant_Reference_Type := Source.Pixels.Constant_Reference; + begin + return Map_Color (Parent (Source), Data.Element.all (A.Y, A.X)); + end Pixel; + + overriding procedure Query_Raster ( + Source : in Image; + Query : not null access procedure (R : in Raster_Images.Raster_Type)) + is + Data : Raster_Holders.Constant_Reference_Type := Source.Pixels.Constant_Reference; + begin + Query (Data.Element.all); + end Query_Raster; + + overriding procedure Process_Raster ( + Target : in out Image; + Process : not null access procedure (R : in out Raster_Images.Raster_Type)) + is + Data : Raster_Holders.Reference_Type := Target.Pixels.Reference; + begin + Process (Data.Element.all); + end Process_Raster; + +end Video.Images.Raster.Generic_Unbounded; diff --git a/source/base/video-images-raster-generic_unbounded.ads b/source/base/video-images-raster-generic_unbounded.ads new file mode 100644 index 0000000..eae2dd9 --- /dev/null +++ b/source/base/video-images-raster-generic_unbounded.ads @@ -0,0 +1,41 @@ +with Ada.Containers.Indefinite_Holders; +-- +-- Images with raster that can be changed in runtime +-- +generic + with package Raster_Images is new Generic_Raster_Images (<>); + 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; + + overriding function Bounding_Box (Source : Image) return Box; + + overriding function Pixel ( + Source : Image; + 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.Raster_Type)); + + overriding procedure Process_Raster ( + Target : in out Image; + Process : not null access procedure (R : in out Raster_Images.Raster_Type)); + +private + use type Raster_Images.Raster_Type; + package Raster_Holders is new Ada.Containers.Indefinite_Holders (Raster_Images.Raster_Type); + + type Image is abstract new Parent and Raster_Images.Image with record + Pixels : Raster_Holders.Holder; + end record; + +end Video.Images.Raster.Generic_Unbounded; diff --git a/source/base/video-images-raster-indexed-generic_fixed.ads b/source/base/video-images-raster-indexed-generic_fixed.ads index d0705ae..f3db619 100644 --- a/source/base/video-images-raster-indexed-generic_fixed.ads +++ b/source/base/video-images-raster-indexed-generic_fixed.ads @@ -42,7 +42,6 @@ package Video.Images.Raster.Indexed.Generic_Fixed is -- - package Fixed_Color_Maps is new Colors.Maps.Generic_Fixed (0, Last_Color_Index); package With_Own_Palette is new Images_with_Color_Map (Fixed_Color_Maps.Fixed_Color_Map); diff --git a/source/base/video-images-raster-indexed-generic_unbounded.adb b/source/base/video-images-raster-indexed-generic_unbounded.adb deleted file mode 100644 index 66b1ec7..0000000 --- a/source/base/video-images-raster-indexed-generic_unbounded.adb +++ /dev/null @@ -1,80 +0,0 @@ -with Ada.Unchecked_Deallocation; - -package body Video.Images.Raster.Indexed.Generic_Unbounded is - - procedure Deallocate is new Ada.Unchecked_Deallocation ( - Object => Raster_Type, - Name => Raster_Access); - - procedure Deallocate is new Ada.Unchecked_Deallocation ( - Object => Colormap_Type, - Name => Colormap_Access); - - overriding function Bounding_Box (Source : Image_with_Own_Palette) return Box - is ( - (Source.Pixels'First (2), Source.Pixels'Last (2)), - (Source.Pixels'First (1), Source.Pixels'Last (1))); - - overriding function Pixel ( - Source : Image_with_Own_Palette; - A : Point) - return Pixel_Type - is (Source.Pixels (A.Y, A.X)); - - overriding function Pixel ( - Source : Image_with_Own_Palette; - A : Point) - return Color - is (Source.Colormap (Integer (Source.Pixels (A.Y, A.X)))); - - overriding function Pixel_Index ( - Source : Image_with_Own_Palette; - A : Point) - return Natural - is (Integer (Source.Pixels (A.Y, A.X))); - - overriding procedure Query_Raster ( - Source : in Image_with_Own_Palette; - Query : not null access procedure (R : in Raster_Type)) - is - begin - Query (Source.Pixels.all); - end Query_Raster; - - overriding procedure Process_Raster ( - Target : in out Image_with_Own_Palette; - Process : not null access procedure (R : in out Raster_Type)) - is - begin - Process (Target.Pixels.all); - end Process_Raster; - - overriding function Map_Color (Source : Image_with_Own_Palette; Index : Natural) return Color - is (Source.Colormap (Index)); - - overriding function To_Palette (Source : Image_with_Own_Palette) return Palette - is (Source.Colormap.all); - - overriding procedure Finalize (Object : in out Image_with_Own_Palette) is - P : Raster_Access := Object.Pixels; -- Exception workaround - C : Colormap_Access := Object.Colormap; - begin - Deallocate (P); -- if Object.Pixels is freed directly it's nullified so exception occurs - Deallocate (C); -- Same - end; - - package body Make is - function By ( - Bounds : Integer_Geometry.Box) - return Image_with_Own_Palette - is - begin - return (Limited_Controlled with - Pixels => new Raster_Type ( - Bounds.Y.First .. Bounds.Y.Last, - Bounds.X.First .. Bounds.Y.Last), - Colormap => new Colormap_Type); - end By; - end Make; - -end Video.Images.Raster.Indexed.Generic_Unbounded; diff --git a/source/base/video-images-raster-indexed-generic_unbounded.ads b/source/base/video-images-raster-indexed-generic_unbounded.ads index 7438692..3d27c97 100644 --- a/source/base/video-images-raster-indexed-generic_unbounded.ads +++ b/source/base/video-images-raster-indexed-generic_unbounded.ads @@ -1,5 +1,8 @@ with Ada.Finalization; use Ada.Finalization; +with Video.Colors.Maps.Generic_Fixed; +with Video.Colors.Maps.Shared_Palettes; +with Video.Images.Raster.Generic_Unbounded; generic type Pixel_Type is mod <>; @@ -13,62 +16,44 @@ package Video.Images.Raster.Indexed.Generic_Unbounded is Last_Color_Index : constant Color_Index := Color_Index (Pixel_Type'Modulus - 1); -- Last color index. Used for palette bounds + generic + type Parent_Color_Map is new Colors.Maps.Constant_Color_Map with private; + package Images_with_Color_Map is + type Base_Color_Map is abstract new Parent_Color_Map with null record; + + function Map_Color (Map : Base_Color_Map; Pixel : Pixel_Type) return Color + is (Map.Map_Color (Color_Index (Pixel))) with Inline; + + package Image_Base is new Raster.Generic_Unbounded ( + Raster_Images => Raster_Images, + Parent => Base_Color_Map); + + type Image is new Image_Base.Image with null record; + -- An actual type + + overriding function Pixel_Index ( + Source : Image; + A : Point) + return Natural + is (Integer (Pixel_Type'(Source.Pixel (A)))); + + end Images_with_Color_Map; + -- - type Image_with_Own_Palette is limited new Limited_Controlled and Raster_Images.Image with private; + package Fixed_Color_Maps is new Colors.Maps.Generic_Fixed (0, Last_Color_Index); - overriding function Bounding_Box (Source : Image_with_Own_Palette) return Box; + package With_Own_Palette is new Images_with_Color_Map (Fixed_Color_Maps.Fixed_Color_Map); - overriding function Pixel ( - Source : Image_with_Own_Palette; - A : Point) - return Pixel_Type; + subtype Image_with_Own_Palette is With_Own_Palette.Image; - overriding function Pixel ( - Source : Image_with_Own_Palette; - A : Point) - return Color; + -- - overriding function Pixel_Index ( - Source : Image_with_Own_Palette; - A : Point) - return Natural; + package With_Shared_Palette is new Images_with_Color_Map ( + Colors.Maps.Shared_Palettes.Constant_Shared_Palette); - overriding procedure Query_Raster ( - Source : in Image_with_Own_Palette; - Query : not null access procedure (R : in Raster_Type)); - - overriding procedure Process_Raster ( - Target : in out Image_with_Own_Palette; - Process : not null access procedure (R : in out Raster_Type)); - - overriding function First_Color (Source : Image_with_Own_Palette) return Color_Index - is (0); - - overriding function Last_Color (Source : Image_with_Own_Palette) return Color_Index - is (Last_Color_Index); - - overriding function Map_Color (Source : Image_with_Own_Palette; Index : Natural) return Color; - - overriding function To_Palette (Source : Image_with_Own_Palette) return Palette; - - overriding procedure Finalize (Object : in out Image_with_Own_Palette); - - package Make is - function By ( - Bounds : Integer_Geometry.Box) - return Image_with_Own_Palette; - end Make; + subtype Image_with_Shared_Palette is With_Shared_Palette.Image; private - type Raster_Access is access Raster_Type; - - subtype Colormap_Type is Palette (0 .. Last_Color_Index); - type Colormap_Access is access Colormap_Type; - - type Image_with_Own_Palette is limited new Limited_Controlled and Raster_Images.Image with record - Pixels : not null Raster_Access; - Colormap : not null Colormap_Access; - end record; end Video.Images.Raster.Indexed.Generic_Unbounded;