>refactor< unbounded images

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;

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;

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);

source/base/video-images-raster-indexed-generic_unbounded.adb

@@ -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;

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 (
+	subtype Image_with_Own_Palette is With_Own_Palette.Image;
-		Source   : Image_with_Own_Palette;
-		A        : Point)
-		return     Pixel_Type;
 
-	overriding function Pixel (
+	--
-		Source   : Image_with_Own_Palette;
-		A        : Point)
-		return     Color;
 
-	overriding function Pixel_Index (
+	package With_Shared_Palette is new Images_with_Color_Map (
-		Source : Image_with_Own_Palette;
+		Colors.Maps.Shared_Palettes.Constant_Shared_Palette);
-		A      : Point)
-		return   Natural;
 
-	overriding procedure Query_Raster (
+	subtype Image_with_Shared_Palette is With_Shared_Palette.Image;
-		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;
 
 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;