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

* rename Raster type to Pixel_Array

This commit is contained in:
Vovanium 2023-07-29 22:24:23 +03:00
parent 135317eb5a
commit be4e09913e
47 changed files with 287 additions and 292 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
source/base/video-images-raster-argb.ads
View File

@ -1,26 +1,26 @@
--
-- Instantiations of Generic_Raster_Images with RGB types
--
with Video.Rasters.ARGB;
use Video.Rasters.ARGB;
with Video.Pixels.ARGB;
use Video.Pixels.ARGB;
package Video.Images.Raster.ARGB is
type ARGB_Raster_Image is limited interface and Raster_Image;
package ARGB1555 is new Generic_Raster_Images (
Pixel_Type => ARGB1555_Pixel,
Raster_Type => ARGB1555_Raster,
Parent => ARGB_Raster_Image);
Pixel_Type => ARGB1555_Pixel,
Array_Type => ARGB1555_Array,
Parent => ARGB_Raster_Image);
package ARGB4444 is new Generic_Raster_Images (
Pixel_Type => ARGB4444_Pixel,
Raster_Type => ARGB4444_Raster,
Parent => ARGB_Raster_Image);
Pixel_Type => ARGB4444_Pixel,
Array_Type => ARGB4444_Array,
Parent => ARGB_Raster_Image);
package ARGB8888 is new Generic_Raster_Images (
Pixel_Type => ARGB8888_Pixel,
Raster_Type => ARGB8888_Raster,
Parent => ARGB_Raster_Image);
Pixel_Type => ARGB8888_Pixel,
Array_Type => ARGB8888_Array,
Parent => ARGB_Raster_Image);
end Video.Images.Raster.ARGB;

4
source/base/video-images-raster-generic_fixed.adb
View File

@ -2,7 +2,7 @@ package body Video.Images.Raster.Generic_Fixed is
overriding procedure Query_Raster (
Source : in Image;
Query : not null access procedure (R : in Raster_Images.Raster_Type))
Query : not null access procedure (R : in Raster_Images.Array_Type))
is
begin
Query (Source.Pixels);
@ -10,7 +10,7 @@ package body Video.Images.Raster.Generic_Fixed is
overriding procedure Process_Raster (
Target : in out Image;
Process : not null access procedure (R : in out Raster_Images.Raster_Type))
Process : not null access procedure (R : in out Raster_Images.Array_Type))
is
begin
Process (Target.Pixels);

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

@ -10,7 +10,7 @@ package Video.Images.Raster.Generic_Fixed is
type Image (X_First, X_Last, Y_First, Y_Last : Integer)
is abstract new Parent and Raster_Images.Image with record
Pixels : Raster_Images.Raster_Type (Y_First .. Y_Last, X_First .. Y_Last);
Pixels : Raster_Images.Array_Type (Y_First .. Y_Last, X_First .. Y_Last);
end record;
overriding function Bounding_Box (Source : Image) return Box
@ -30,10 +30,10 @@ package Video.Images.Raster.Generic_Fixed is
overriding procedure Query_Raster (
Source : in Image;
Query : not null access procedure (R : in Raster_Images.Raster_Type));
Query : not null access procedure (R : in Raster_Images.Array_Type));
overriding procedure Process_Raster (
Target : in out Image;
Process : not null access procedure (R : in out Raster_Images.Raster_Type));
Process : not null access procedure (R : in out Raster_Images.Array_Type));
end Video.Images.Raster.Generic_Fixed;

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

@ -2,8 +2,8 @@ package body Video.Images.Raster.Generic_Unbounded is
overriding function Bounding_Box (Source : Image) return Box
is
Data : access Raster_Images.Raster_Type := Source.Pixels.Reference;
R : Raster_Images.Raster_Type renames Data.all;
Data : access Raster_Images.Array_Type := Source.Pixels.Reference;
R : Raster_Images.Array_Type renames Data.all;
begin
return (X => (R'First (2), R'Last (2) - 1),
Y => (R'First (1), R'Last (1) - 1));
@ -14,7 +14,7 @@ package body Video.Images.Raster.Generic_Unbounded is
A : Point)
return Raster_Images.Pixel_Type
is
Data : access Raster_Images.Raster_Type := Source.Pixels.Reference;
Data : access Raster_Images.Array_Type := Source.Pixels.Reference;
begin
return Data.all (A.Y, A.X);
end Pixel;
@ -24,25 +24,25 @@ package body Video.Images.Raster.Generic_Unbounded is
A : Point)
return Color
is
Data : access Raster_Images.Raster_Type := Source.Pixels.Reference;
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.Raster_Type))
Query : not null access procedure (R : in Raster_Images.Array_Type))
is
Data : access Raster_Images.Raster_Type := Source.Pixels.Reference;
Data : access Raster_Images.Array_Type := Source.Pixels.Reference;
begin
Query (Data.all);
end Query_Raster;
overriding procedure Process_Raster (
Target : in out Image;
Process : not null access procedure (R : in out Raster_Images.Raster_Type))
Process : not null access procedure (R : in out Raster_Images.Array_Type))
is
Data : access Raster_Images.Raster_Type := Target.Pixels.Reference;
Data : access Raster_Images.Array_Type := Target.Pixels.Reference;
begin
Process (Data.all);
end Process_Raster;

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

@ -2,7 +2,7 @@
-- Images with raster that can be changed in runtime
--
with Ada.Containers.Indefinite_Holders;
with Video.Rasters.Generic_Holders;
with Video.Pixels.Generic_Holders;
generic
with package Raster_Images is new Generic_Raster_Images (<>);
@ -26,18 +26,18 @@ package Video.Images.Raster.Generic_Unbounded is
overriding procedure Query_Raster (
Source : in Image;
Query : not null access procedure (R : in Raster_Images.Raster_Type));
Query : not null access procedure (R : in Raster_Images.Array_Type));
overriding procedure Process_Raster (
Target : in out Image;
Process : not null access procedure (R : in out Raster_Images.Raster_Type));
Process : not null access procedure (R : in out Raster_Images.Array_Type));
private
type Raster_Access is access Raster_Images.Raster_Type;
package Raster_Holders is new Video.Rasters.Generic_Holders (
Pixel_Type => Raster_Images.Pixel_Type,
Raster_Type => Raster_Images.Raster_Type,
Raster_Access => Raster_Access);
type Array_Access is access Raster_Images.Array_Type;
package Raster_Holders is new Video.Pixels.Generic_Holders (
Pixel => Raster_Images.Pixel_Type,
Pixel_Array => Raster_Images.Array_Type,
Pixel_Array_Access => Array_Access);
type Image is abstract new Parent and Raster_Images.Image with record
Pixels : Raster_Holders.Holder;

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

@ -3,18 +3,18 @@ with Video.Images.Raster.Indexed.Generic_Fixed;
package Video.Images.Raster.Indexed.Fixed is
-- package Fixed_Index_1 is new Fixed_Indexed (
-- Pixel_Type => Index_1_Pixel,
-- Raster_Type => Index_1_Raster);
-- Pixel_Type => Index_1_Pixel,
-- Array_Type => Index_1_Array);
-- package Fixed_Index_4 is new Fixed_Indexed (
-- Pixel_Type => Index_4_Pixel,
-- Raster_Type => Index_4_Raster);
-- Pixel_Type => Index_4_Pixel,
-- Array_Type => Index_4_Array);
-- note: Due to bug in current GNAT above won't compile
package Fixed_Index_8 is new Generic_Fixed (
Pixel_Type => Index_8_Pixel,
Raster_Type => Index_8_Raster,
Pixel_Type => Index_8_Pixel,
Array_Type => Index_8_Array,
Raster_Images => Index_8);
end Video.Images.Raster.Indexed.Fixed;

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

@ -7,11 +7,11 @@ with Video.Colors.Maps.Shared_Palettes;
generic
type Pixel_Type is mod <>;
type Raster_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
type Array_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
with package Raster_Images is new Generic_Raster_Images (
Pixel_Type => Pixel_Type,
Raster_Type => Raster_Type,
Parent => Indexed_Raster_Image);
Pixel_Type => Pixel_Type,
Array_Type => Array_Type,
Parent => Indexed_Raster_Image);
package Video.Images.Raster.Indexed.Generic_Fixed is
Last_Color_Index : constant Color_Index := Color_Index (Pixel_Type'Modulus - 1);

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

@ -6,11 +6,11 @@ with Video.Images.Raster.Generic_Unbounded;
generic
type Pixel_Type is mod <>;
type Raster_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
type Array_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
with package Raster_Images is new Generic_Raster_Images (
Pixel_Type => Pixel_Type,
Raster_Type => Raster_Type,
Parent => Indexed_Raster_Image);
Pixel_Type => Pixel_Type,
Array_Type => Array_Type,
Parent => Indexed_Raster_Image);
package Video.Images.Raster.Indexed.Generic_Unbounded is
Last_Color_Index : constant Color_Index := Color_Index (Pixel_Type'Modulus - 1);

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

@ -3,18 +3,18 @@ with Video.Images.Raster.Indexed.Generic_Unbounded;
package Video.Images.Raster.Indexed.Unbounded is
package Unbounded_Index_1 is new Generic_Unbounded (
Pixel_Type => Index_1_Pixel,
Raster_Type => Index_1_Raster,
Pixel_Type => Index_1_Pixel,
Array_Type => Index_1_Array,
Raster_Images => Index_1);
package Unbounded_Index_4 is new Generic_Unbounded (
Pixel_Type => Index_4_Pixel,
Raster_Type => Index_4_Raster,
Pixel_Type => Index_4_Pixel,
Array_Type => Index_4_Array,
Raster_Images => Index_4);
package Unbounded_Index_8 is new Generic_Unbounded (
Pixel_Type => Index_8_Pixel,
Raster_Type => Index_8_Raster,
Pixel_Type => Index_8_Pixel,
Array_Type => Index_8_Array,
Raster_Images => Index_8);
end Video.Images.Raster.Indexed.Unbounded;

22
source/base/video-images-raster-indexed.ads
View File

@ -1,7 +1,7 @@
with Ada.Finalization;
use Ada.Finalization;
with Video.Rasters.Indexed, Video.Colors.Palettes, Video.Colors.Maps;
use Video.Rasters.Indexed, Video.Colors.Palettes, Video.Colors.Maps;
with Video.Pixels.Indexed, Video.Colors.Palettes, Video.Colors.Maps;
use Video.Pixels.Indexed, Video.Colors.Palettes, Video.Colors.Maps;
package Video.Images.Raster.Indexed is
@ -33,19 +33,19 @@ package Video.Images.Raster.Indexed is
--
package Index_1 is new Generic_Raster_Images (
Pixel_Type => Index_1_Pixel,
Raster_Type => Index_1_Raster,
Parent => Indexed_Raster_Image);
Pixel_Type => Index_1_Pixel,
Array_Type => Index_1_Array,
Parent => Indexed_Raster_Image);
package Index_4 is new Generic_Raster_Images (
Pixel_Type => Index_4_Pixel,
Raster_Type => Index_4_Raster,
Parent => Indexed_Raster_Image);
Pixel_Type => Index_4_Pixel,
Array_Type => Index_4_Array,
Parent => Indexed_Raster_Image);
package Index_8 is new Generic_Raster_Images (
Pixel_Type => Index_8_Pixel,
Raster_Type => Index_8_Raster,
Parent => Indexed_Raster_Image);
Pixel_Type => Index_8_Pixel,
Array_Type => Index_8_Array,
Parent => Indexed_Raster_Image);
private

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

@ -4,7 +4,7 @@ package Video.Images.Raster.RGB.Fixed is
package Fixed_RGB888 is new Generic_Fixed (
Pixel_Type => RGB888_Pixel,
Raster_Type => RGB888_Raster,
Array_Type => RGB888_Array,
Raster_Images => RGB888);
end Video.Images.Raster.RGB.Fixed;

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

@ -5,12 +5,12 @@ with Video.Images.Raster.Generic_Fixed;
generic
type Pixel_Type is private;
type Raster_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
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_Images (
Pixel_Type => Pixel_Type,
Raster_Type => Raster_Type,
Parent => RGB_Raster_Image);
Pixel_Type => Pixel_Type,
Array_Type => Array_Type,
Parent => RGB_Raster_Image);
package Video.Images.Raster.RGB.Generic_Fixed is
type Raster_Image_Base is abstract tagged null record;

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

@ -5,11 +5,11 @@ with Video.Images.Raster.Generic_Unbounded;
generic
type Pixel_Type is private;
type Raster_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
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_Images (
Pixel_Type => Pixel_Type,
Raster_Type => Raster_Type,
Array_Type => Array_Type,
Parent => RGB_Raster_Image);
package Video.Images.Raster.RGB.Generic_Unbounded is

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

@ -4,12 +4,12 @@ package Video.Images.Raster.RGB.Unbounded is
package Unbounded_RGB565 is new Generic_Unbounded (
Pixel_Type => RGB565_Pixel,
Raster_Type => RGB565_Raster,
Array_Type => RGB565_Array,
Raster_Images => RGB565);
package Unbounded_RGB888 is new Generic_Unbounded (
Pixel_Type => RGB888_Pixel,
Raster_Type => RGB888_Raster,
Array_Type => RGB888_Array,
Raster_Images => RGB888);
end Video.Images.Raster.RGB.Unbounded;

16
source/base/video-images-raster-rgb.ads
View File

@ -1,21 +1,21 @@
--
-- Instantiations of Generic_Raster_Images with RGB types
--
with Video.Rasters.RGB;
use Video.Rasters.RGB;
with Video.Pixels.RGB;
use Video.Pixels.RGB;
package Video.Images.Raster.RGB is
type RGB_Raster_Image is limited interface and Raster_Image;
package RGB565 is new Generic_Raster_Images (
Pixel_Type => RGB565_Pixel,
Raster_Type => RGB565_Raster,
Parent => RGB_Raster_Image);
Pixel_Type => RGB565_Pixel,
Array_Type => RGB565_Array,
Parent => RGB_Raster_Image);
package RGB888 is new Generic_Raster_Images (
Pixel_Type => RGB888_Pixel,
Raster_Type => RGB888_Raster,
Parent => RGB_Raster_Image);
Pixel_Type => RGB888_Pixel,
Array_Type => RGB888_Array,
Parent => RGB_Raster_Image);
end Video.Images.Raster.RGB;

10
source/base/video-images-raster.ads
View File

@ -24,9 +24,9 @@ package Video.Images.Raster is
-- A helper generic package to keep types with the same format togeter
generic
type Pixel_Type is private;
type Raster_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
type Parent is limited interface and Raster_Image;
type Pixel_Type is private;
type Array_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
type Parent is limited interface and Raster_Image;
package Generic_Raster_Images is
-- Alias them so external code can use them
@ -45,12 +45,12 @@ package Video.Images.Raster is
procedure Query_Raster (
Source : in Image;
Query : not null access procedure (R : in Raster_Type)) is abstract;
Query : not null access procedure (R : in Array_Type)) is abstract;
-- Query actual raster (maybe by chunks, seee below)
procedure Process_Raster (
Target : in out Image;
Process : not null access procedure (R : in out Raster_Type)) is null;
Process : not null access procedure (R : in out Array_Type)) is null;
-- Modify actual raster. Might be null for images that are not modifiable.
-- Non modifiable image could be declared constant so this call will not compile

12
source/base/video-rasters-argb.ads → source/base/video-pixels-argb.ads
View File

@ -2,9 +2,9 @@ with Video.Colors;
use Video.Colors;
--
-- RGB rasters with Alpha
-- RGB pixels and arrays with Alpha
--
package Video.Rasters.ARGB is
package Video.Pixels.ARGB is
-- Pixel formats
-- 1 1 1 1 1 1
@ -48,7 +48,7 @@ package Video.Rasters.ARGB is
B => From_5_Bit (Pixel.B),
A => From_1_Bit (Pixel.A)) with Inline;
type ARGB1555_Raster is array (Integer range <>, Integer range <>) of ARGB1555_Pixel;
type ARGB1555_Array is array (Integer range <>, Integer range <>) of ARGB1555_Pixel;
-- ARGB4444
@ -77,7 +77,7 @@ package Video.Rasters.ARGB is
B => From_4_Bit (Pixel.B),
A => From_4_Bit (Pixel.A)) with Inline;
type ARGB4444_Raster is array (Integer range <>, Integer range <>) of ARGB4444_Pixel;
type ARGB4444_Array is array (Integer range <>, Integer range <>) of ARGB4444_Pixel;
-- ARGB8888
@ -106,6 +106,6 @@ package Video.Rasters.ARGB is
B => From_8_Bit (Pixel.B),
A => From_8_Bit (Pixel.A)) with Inline;
type ARGB8888_Raster is array (Integer range <>, Integer range <>) of ARGB8888_Pixel;
type ARGB8888_Array is array (Integer range <>, Integer range <>) of ARGB8888_Pixel;
end Video.Rasters.ARGB;
end Video.Pixels.ARGB;

15
source/base/video-rasters-formats.ads → source/base/video-pixels-formats.ads
View File

@ -1,4 +1,4 @@
package Video.Rasters.Formats with Pure is
package Video.Pixels.Formats with Pure is
subtype Component_Offset is Integer range 0 .. 2**8 - 1;
type Component_Range is record
@ -8,17 +8,12 @@ package Video.Rasters.Formats with Pure is
No_Component : constant Component_Range := (1, 0);
type ARGB_Pixel_Format is record
R, G, B : Component_Range;
A : Component_Range := No_Component;
end record;
type Color_Mode is (
Index,
ARGB);
type Raster_Format (Mode : Color_Mode) is record
Size : Component_Offset;
type Pixel_Format (Mode : Color_Mode) is record
Pitch : Component_Offset;
case Mode is
when Index =>
null;
@ -28,6 +23,6 @@ package Video.Rasters.Formats with Pure is
end case;
end record;
No_Format : constant Raster_Format := (Mode => Index, Size => 0);
No_Format : constant Pixel_Format := (Mode => Index, Pitch => 0);
end Video.Rasters.Formats;
end Video.Pixels.Formats;

8
source/base/video-rasters-generic_blits-masked.adb → source/base/video-pixels-generic_blits-masked.adb
View File

@ -1,9 +1,9 @@
package body Video.Rasters.Generic_Blits.Masked is
package body Video.Pixels.Generic_Blits.Masked is
procedure Fill_Masked (
Color : in Pixel;
Mask : in Mask_Raster;
Mask : in Mask_Pixel_Array;
Offset : in Video.Integer_Geometry.Point;
Target : in out Raster;
Target : in out Pixel_Array;
Bounds : in Video.Integer_Geometry.Box)
is
begin
@ -16,4 +16,4 @@ package body Video.Rasters.Generic_Blits.Masked is
end loop;
end Fill_Masked;
end Video.Rasters.Generic_Blits.Masked;
end Video.Pixels.Generic_Blits.Masked;

10
source/base/video-rasters-generic_blits-masked.ads → source/base/video-pixels-generic_blits-masked.ads
View File

@ -3,15 +3,15 @@
--
generic
type Mask_Pixel is (<>);
type Mask_Raster is array (Integer range <>, Integer range <>) of Mask_Pixel;
type Mask_Pixel_Array is array (Integer range <>, Integer range <>) of Mask_Pixel;
Mask_Value : in Mask_Pixel := Mask_Pixel'First; -- Masking value (typically 0)
package Video.Rasters.Generic_Blits.Masked is
package Video.Pixels.Generic_Blits.Masked is
procedure Fill_Masked (
Color : in Pixel;
Mask : in Mask_Raster;
Mask : in Mask_Pixel_Array;
Offset : in Video.Integer_Geometry.Point; -- Mask coordinate offset
Target : in out Raster;
Target : in out Pixel_Array;
Bounds : in Video.Integer_Geometry.Box); -- Boundary rectangle in Target coords
end Video.Rasters.Generic_Blits.Masked;
end Video.Pixels.Generic_Blits.Masked;

24
source/base/video-rasters-generic_blits.adb → source/base/video-pixels-generic_blits.adb
View File

@ -1,16 +1,16 @@
with Video.Integer_Geometry;
use Video.Integer_Geometry;
with Ada.Text_IO;
use Ada.Text_IO;
with Ada.Integer_Text_IO;
use Ada.Integer_Text_IO;
--with Ada.Text_IO;
--use Ada.Text_IO;
--with Ada.Integer_Text_IO;
--use Ada.Integer_Text_IO;
package body Video.Rasters.Generic_Blits is
package body Video.Pixels.Generic_Blits is
procedure Fill_Rectangle (
Color : in Pixel;
Target : in out Raster;
Target : in out Pixel_Array;
Bounds : in Video.Integer_Geometry.Box)
is
begin
@ -22,8 +22,8 @@ package body Video.Rasters.Generic_Blits is
end;
procedure Line (
Color : in Pixel;
Target : in out Raster;
Color : in Pixel;
Target : in out Pixel_Array;
A, B : Integer_Geometry.Point)
is
D : constant Integer_Geometry.Point := B - A;
@ -65,7 +65,7 @@ package body Video.Rasters.Generic_Blits is
procedure Circle (
Color : in Pixel;
Target : in out Raster;
Target : in out Pixel_Array;
Center : in Integer_Geometry.Point;
Radius : in Natural)
is
@ -100,8 +100,8 @@ package body Video.Rasters.Generic_Blits is
end Circle;
procedure Ellipse (
Color : in Pixel;
Target : in out Raster;
Color : in Pixel;
Target : in out Pixel_Array;
Bounds : in Integer_Geometry.Box)
is
subtype Prod is Coordinate_Product;
@ -191,4 +191,4 @@ package body Video.Rasters.Generic_Blits is
-- in integers:
-- (X - Xc)² B² + (Y - Yc)² A² = A² B²
end Video.Rasters.Generic_Blits;
end Video.Pixels.Generic_Blits;

16
source/base/video-rasters-generic_blits.ads → source/base/video-pixels-generic_blits.ads
View File

@ -4,29 +4,29 @@ with Video.Integer_Geometry;
--
generic
type Pixel is private;
type Raster is array (Integer range <>, Integer range <>) of Pixel;
package Video.Rasters.Generic_Blits is
type Pixel_Array is array (Integer range <>, Integer range <>) of Pixel;
package Video.Pixels.Generic_Blits is
procedure Fill_Rectangle (
Color : in Pixel;
Target : in out Raster;
Target : in out Pixel_Array;
Bounds : in Integer_Geometry.Box);
procedure Line (
Color : in Pixel;
Target : in out Raster;
Target : in out Pixel_Array;
A, B : Integer_Geometry.Point);
procedure Circle (
Color : in Pixel;
Target : in out Raster;
Target : in out Pixel_Array;
Center : in Integer_Geometry.Point;
Radius : in Natural);
procedure Ellipse (
Color : in Pixel;
Target : in out Raster;
Color : in Pixel;
Target : in out Pixel_Array;
Bounds : in Integer_Geometry.Box);
-- Note: Ellipse is actually drawn one pixel off Bounds, because it defines zero-thickness ellipse.
end Video.Rasters.Generic_Blits;
end Video.Pixels.Generic_Blits;

18
source/base/video-rasters-generic_holders.adb → source/base/video-pixels-generic_holders.adb
View File

@ -1,6 +1,6 @@
with Ada.Unchecked_Deallocation;
package body Video.Rasters.Generic_Holders is
package body Video.Pixels.Generic_Holders is
function Bounding_Box (Source : Holder) return Box is (
if Source.Data /= null then (
@ -9,12 +9,12 @@ package body Video.Rasters.Generic_Holders is
else
Empty_Box);
function Reference (Source : Holder) return access Raster_Type
function Reference (Source : Holder) return access Pixel_Array
is (Source.Data);
procedure Query_Raster (
Source : in Holder;
Query : not null access procedure (R : in Raster_Type))
Query : not null access procedure (R : in Pixel_Array))
is
begin
if Source.Data /= null then
@ -24,7 +24,7 @@ package body Video.Rasters.Generic_Holders is
procedure Process_Raster (
Target : in out Holder;
Process : not null access procedure (R : in out Raster_Type))
Process : not null access procedure (R : in out Pixel_Array))
is
begin
if Target.Data /= null then
@ -35,8 +35,8 @@ package body Video.Rasters.Generic_Holders is
--
procedure Deallocate is new Ada.Unchecked_Deallocation (
Object => Raster_Type,
Name => Raster_Access);
Object => Pixel_Array,
Name => Pixel_Array_Access);
procedure Allocate (
Target : in out Holder;
@ -45,7 +45,7 @@ package body Video.Rasters.Generic_Holders is
is
begin
if not Is_Empty (Bounds) then
Target.Data := new Raster_Type (
Target.Data := new Pixel_Array (
Bounds.Y.First .. Bounds.Y.Last - 1,
Bounds.X.First .. Bounds.X.Last - 1);
end if;
@ -63,7 +63,7 @@ package body Video.Rasters.Generic_Holders is
overriding procedure Adjust (Object : in out Holder) is
begin
if Object.Data /= null then
Object.Data := new Raster_Type'(Object.Data.all); -- make a copy
Object.Data := new Pixel_Array'(Object.Data.all); -- make a copy
end if;
end Adjust;
@ -72,4 +72,4 @@ package body Video.Rasters.Generic_Holders is
Deallocate (Object.Data);
end Finalize;
end Video.Rasters.Generic_Holders;
end Video.Pixels.Generic_Holders;

18
source/base/video-rasters-generic_holders.ads → source/base/video-pixels-generic_holders.ads
View File

@ -6,10 +6,10 @@ with Video.Integer_Geometry;
use Video.Integer_Geometry;
generic
type Pixel_Type is private;
type Raster_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
type Raster_Access is access Raster_Type;
package Video.Rasters.Generic_Holders is
type Pixel is private;
type Pixel_Array is array (Integer range <>, Integer range <>) of Pixel;
type Pixel_Array_Access is access Pixel_Array;
package Video.Pixels.Generic_Holders is
type Holder is new Ada.Finalization.Controlled with private;
@ -19,22 +19,22 @@ package Video.Rasters.Generic_Holders is
Target : in out Holder;
Bounds : in Box);
function Reference (Source : Holder) return access Raster_Type;
function Reference (Source : Holder) return access Pixel_Array;
procedure Query_Raster (
Source : in Holder;
Query : not null access procedure (R : in Raster_Type));
Query : not null access procedure (R : in Pixel_Array));
procedure Process_Raster (
Target : in out Holder;
Process : not null access procedure (R : in out Raster_Type));
Process : not null access procedure (R : in out Pixel_Array));
overriding procedure Adjust (Object : in out Holder);
overriding procedure Finalize (Object : in out Holder);
private
type Holder is new Ada.Finalization.Controlled with record
Data : Raster_Access;
Data : Pixel_Array_Access;
end record;
end Video.Rasters.Generic_Holders;
end Video.Pixels.Generic_Holders;

4
source/base/video-rasters-generic_renderers-color.adb → source/base/video-pixels-generic_renderers-color.adb
View File

@ -1,4 +1,4 @@
package body Video.Rasters.Generic_Renderers.Color is
package body Video.Pixels.Generic_Renderers.Color is
procedure Clear (
Target : in out Color_Renderer;
@ -54,4 +54,4 @@ package body Video.Rasters.Generic_Renderers.Color is
Target.Ellipse (Bounds, From_Color (Color));
end Ellipse;
end Video.Rasters.Generic_Renderers.Color;
end Video.Pixels.Generic_Renderers.Color;

4
source/base/video-rasters-generic_renderers-color.ads → source/base/video-pixels-generic_renderers-color.ads
View File

@ -2,7 +2,7 @@ with Video.Colors;
with Video.Renderables.Color;
generic
with function From_Color (Color : Colors.Color) return Pixel is <>;
package Video.Rasters.Generic_Renderers.Color is
package Video.Pixels.Generic_Renderers.Color is
type Color_Renderer is limited new Renderer and Renderables.Color.Renderable with null record;
@ -36,4 +36,4 @@ package Video.Rasters.Generic_Renderers.Color is
Bounds : in Integer_Geometry.Box;
Color : in Colors.Color);
end Video.Rasters.Generic_Renderers.Color;
end Video.Pixels.Generic_Renderers.Color;

8
source/base/video-rasters-generic_renderers.adb → source/base/video-pixels-generic_renderers.adb
View File

@ -1,10 +1,10 @@
with Video.Rasters.Generic_Blits;
with Video.Pixels.Generic_Blits;
package body Video.Rasters.Generic_Renderers is
package body Video.Pixels.Generic_Renderers is
package Blits is new Generic_Blits (
Pixel => Pixel,
Raster => Raster);
Pixel_Array => Pixel_Array);
procedure Clear (
Target : in out Renderer;
@ -68,4 +68,4 @@ package body Video.Rasters.Generic_Renderers is
Blits.Ellipse (Paint, Target.Target.all, Bounds);
end Ellipse;
end Video.Rasters.Generic_Renderers;
end Video.Pixels.Generic_Renderers;

8
source/base/video-rasters-generic_renderers.ads → source/base/video-pixels-generic_renderers.ads
View File

@ -3,11 +3,11 @@ with Video.Integer_Geometry;
generic
type Pixel is private;
type Raster is array (Integer range <>, Integer range <>) of Pixel;
type Pixel_Array is array (Integer range <>, Integer range <>) of Pixel;
with package Pixel_Renderables is new Video.Renderables.Paint_Renderables (Pixel);
package Video.Rasters.Generic_Renderers is
package Video.Pixels.Generic_Renderers is
type Renderer (Target : access Raster) is limited new Pixel_Renderables.Renderable with null record;
type Renderer (Target : access Pixel_Array) is limited new Pixel_Renderables.Renderable with null record;
overriding function Bounding_Box (S : Renderer) return Integer_Geometry.Box
is (X => (S.Target'First (2), S.Target'Last (2) - 1), Y => (S.Target'First (1), S.Target'Last (1) - 1));
@ -42,4 +42,4 @@ package Video.Rasters.Generic_Renderers is
Bounds : in Integer_Geometry.Box;
Paint : in Pixel);
end Video.Rasters.Generic_Renderers;
end Video.Pixels.Generic_Renderers;

13
source/base/video-pixels-indexed.ads Normal file
View File

@ -0,0 +1,13 @@
package Video.Pixels.Indexed with Pure is
type Index_1_Pixel is mod 2;
type Index_2_Pixel is mod 4;
type Index_4_Pixel is mod 16;
type Index_8_Pixel is mod 256;
type Index_1_Array is array (Integer range <>, Integer range <>) of Index_1_Pixel with Pack;
type Index_2_Array is array (Integer range <>, Integer range <>) of Index_2_Pixel with Pack;
type Index_4_Array is array (Integer range <>, Integer range <>) of Index_4_Pixel with Pack;
type Index_8_Array is array (Integer range <>, Integer range <>) of Index_8_Pixel with Pack;
end Video.Pixels.Indexed;

15
source/base/video-pixels-rgb-renderers.ads Normal file
View File

@ -0,0 +1,15 @@
with Video.Pixels.Generic_Renderers.Color;
with Video.Renderables;
package Video.Pixels.RGB.Renderers is
package RGB565_Renderables is new Renderables.Paint_Renderables (RGB565_Pixel);
package RGB565_Renderers is new Pixels.Generic_Renderers (
RGB565_Pixel, RGB565_Array, RGB565_Renderables);
package RGB565_Color_Renderers is new RGB565_Renderers.Color;
package RGB888_Renderables is new Renderables.Paint_Renderables (RGB888_Pixel);
package RGB888_Renderers is new Pixels.Generic_Renderers (
RGB888_Pixel, RGB888_Array, RGB888_Renderables);
end Video.Pixels.RGB.Renderers;

8
source/base/video-rasters-rgb.ads → source/base/video-pixels-rgb.ads
View File

@ -4,7 +4,7 @@ use Video.Colors;
--
-- RGB rasters
--
package Video.Rasters.RGB is
package Video.Pixels.RGB is
-- Pixel formats
-- 1 1 1 1 1 1
@ -42,7 +42,7 @@ package Video.Rasters.RGB is
B => From_5_Bit (Pixel.B),
others => <>) with Inline;
type RGB565_Raster is array (Integer range <>, Integer range <>) of RGB565_Pixel;
type RGB565_Array is array (Integer range <>, Integer range <>) of RGB565_Pixel;
-- RGB888
@ -65,6 +65,6 @@ package Video.Rasters.RGB is
function To_Color (Pixel : RGB888_Pixel) return Color
is (RGB_8 (R => Pixel.R, G => Pixel.G, B => Pixel.B)) with Inline;
type RGB888_Raster is array (Integer range <>, Integer range <>) of RGB888_Pixel;
type RGB888_Array is array (Integer range <>, Integer range <>) of RGB888_Pixel;
end Video.Rasters.RGB;
end Video.Pixels.RGB;

5
source/base/video-pixels.ads Normal file
View File

@ -0,0 +1,5 @@
--
-- Low level raster graphics
--
package Video.Pixels with Pure is
end Video.Pixels;

13
source/base/video-rasters-indexed.ads
View File

@ -1,13 +0,0 @@
package Video.Rasters.Indexed with Pure is
type Index_1_Pixel is mod 2;
type Index_2_Pixel is mod 4;
type Index_4_Pixel is mod 16;
type Index_8_Pixel is mod 256;
type Index_1_Raster is array (Integer range <>, Integer range <>) of Index_1_Pixel with Pack;
type Index_2_Raster is array (Integer range <>, Integer range <>) of Index_2_Pixel with Pack;
type Index_4_Raster is array (Integer range <>, Integer range <>) of Index_4_Pixel with Pack;
type Index_8_Raster is array (Integer range <>, Integer range <>) of Index_8_Pixel with Pack;
end Video.Rasters.Indexed;

15
source/base/video-rasters-rgb-renderers.ads
View File

@ -1,15 +0,0 @@
with Video.Rasters.Generic_Renderers.Color;
with Video.Renderables;
package Video.Rasters.RGB.Renderers is
package RGB565_Renderables is new Renderables.Paint_Renderables (RGB565_Pixel);
package RGB565_Renderers is new Rasters.Generic_Renderers (
RGB565_Pixel, RGB565_Raster, RGB565_Renderables);
package RGB565_Color_Renderers is new RGB565_Renderers.Color;
package RGB888_Renderables is new Renderables.Paint_Renderables (RGB888_Pixel);
package RGB888_Renderers is new Rasters.Generic_Renderers (
RGB888_Pixel, RGB888_Raster, RGB888_Renderables);
end Video.Rasters.RGB.Renderers;

5
source/base/video-rasters.ads
View File

@ -1,5 +0,0 @@
--
-- Low level raster graphics
--
package Video.Rasters with Pure is
end Video.Rasters;

6
source/base/video-texts-fonts-raster.ads
View File

@ -15,13 +15,13 @@ package Video.Texts.Fonts.Raster is
generic
type Pixel is private;
type Raster is array (Integer range <>, Integer range <>) of Pixel;
type Pixel_Array is array (Integer range <>, Integer range <>) of Pixel;
package Mapped is
type Constant_Raster_Access is access constant Raster;
type Constant_Pixel_Array_Access is access constant Pixel_Array;
type Mapped_Raster_Font is record
Map : Constant_Mapped_Glyph_Array_Access;
Image : Constant_Raster_Access;
Image : Constant_Pixel_Array_Access;
end record;
end Mapped;

22
source/examples/example_save_bmp.adb
View File

@ -1,13 +1,13 @@
with Video.Rasters.Indexed, Video.Rasters.RGB, Video.Colors.Palettes;
use Video.Rasters.Indexed, Video.Rasters.RGB, Video.Colors.Palettes;
with Video.Pixels.Indexed, Video.Pixels.RGB, Video.Colors.Palettes;
use Video.Pixels.Indexed, Video.Pixels.RGB, Video.Colors.Palettes;
use Video.Colors;
with Video.IO.BMP.Rasters.Indexed, Video.IO.BMP.Rasters.RGB;
use Video.IO.BMP.Rasters.Indexed, Video.IO.BMP.Rasters.RGB;
with Video.IO.BMP.Arrays.Indexed, Video.IO.BMP.Arrays.RGB;
use Video.IO.BMP.Arrays.Indexed, Video.IO.BMP.Arrays.RGB;
with Ada.Streams.Stream_IO;
use Ada.Streams.Stream_IO;
procedure Example_Save_BMP is
Img_Raster : constant Index_1_Raster (0 .. 7, 0 .. 15) := (
Img_Array : constant Index_1_Array (0 .. 7, 0 .. 15) := (
(0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0),
(0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0),
(0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 0),
@ -19,21 +19,21 @@ procedure Example_Save_BMP is
Img_Palette : constant Palette (0 .. 1) := (
Hex_6 (16#909090#),
Hex_6 (16#000000#));
Img24_Raster : RGB888_Raster (0 .. 255, 0 .. 255);
Img24_Array : RGB888_Array (0 .. 255, 0 .. 255);
F : File_Type;
S : Stream_Access;
begin
Create (F, Out_File, "example.bmp");
S := Stream (F);
Output (S, Img_Raster, Img_Palette);
Output (S, Img_Array, Img_Palette);
for Y in Img24_Raster'Range (1) loop
for X in Img24_Raster'Range (2) loop
Img24_Raster (Y, X) := From_Color (RGB_8 (X, Y, 0));
for Y in Img24_Array'Range (1) loop
for X in Img24_Array'Range (2) loop
Img24_Array (Y, X) := From_Color (RGB_8 (X, Y, 0));
end loop;
end loop;
Close (F);
Create (F, Out_File, "examp24.bmp");
S := Stream (F);
Output (S, Img24_Raster);
Output (S, Img24_Array);
end Example_Save_BMP;

10
source/examples/example_sdl_raster.adb
View File

@ -8,20 +8,20 @@ with SDL.Images.IO;
with Video.Colors;
with Video.Integer_Geometry;
with Video.SDL2.Surfaces;
with Video.Rasters.RGB.Renderers;
with Video.Pixels.RGB.Renderers;
with Example_Scene;
procedure Example_SDL_Raster is
procedure Create_From_Array is new SDL.Video.Surfaces.Makers.Create_From_Array (
Element => Video.Rasters.RGB.RGB565_Pixel,
Element => Video.Pixels.RGB.RGB565_Pixel,
Index => Integer,
Element_Array => Video.Rasters.RGB.RGB565_Raster);
Element_Array => Video.Pixels.RGB.RGB565_Array);
Screen_Width : constant := 640;
Screen_Height : constant := 480;
Wnd : aliased SDL.Video.Windows.Window;
Screen : aliased Video.Rasters.RGB.RGB565_Raster := (0 .. Screen_Height - 1 => (0 .. Screen_Width - 1 => <>));
Screen : aliased Video.Pixels.RGB.RGB565_Array := (0 .. Screen_Height - 1 => (0 .. Screen_Width - 1 => <>));
Img : Video.SDL2.Surfaces.SDL_Surface;
Ev : SDL.Events.Events.Events;
@ -45,7 +45,7 @@ begin
Red_Mask => 16#F800#, Green_Mask => 16#07E0#, Blue_Mask => 16#001F#, Alpha_Mask => 0);
declare
Rend : Video.Rasters.RGB.Renderers.RGB565_Color_Renderers.Color_Renderer (Screen'Access);
Rend : Video.Pixels.RGB.Renderers.RGB565_Color_Renderers.Color_Renderer (Screen'Access);
begin
Example_Scene (Rend);

22
source/io/video-io-bmp-rasters-argb.adb → source/io/video-io-bmp-arrays-argb.adb
View File

@ -1,24 +1,24 @@
with Interfaces;
use Interfaces;
package body Video.IO.BMP.Rasters.ARGB is
package body Video.IO.BMP.Arrays.ARGB is
type Buf_Array is array (Natural range <>) of Unsigned_8;
procedure ARGB8888_Write_Row (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : Video.Rasters.ARGB.ARGB8888_Raster;
Data : Video.Pixels.ARGB.ARGB8888_Array;
Y : Integer;
Bytes : Positive)
is
Pos : Natural := 0;
Buf : Buf_Array (0 .. Bytes - 1) := (others => 0);
begin
for X in Raster'Range (2) loop
Buf (Pos) := Unsigned_8 (Raster (Y, X).B);
Buf (Pos + 1) := Unsigned_8 (Raster (Y, X).G);
Buf (Pos + 2) := Unsigned_8 (Raster (Y, X).R);
Buf (Pos + 3) := Unsigned_8 (Raster (Y, X).A);
for X in Data'Range (2) loop
Buf (Pos) := Unsigned_8 (Data (Y, X).B);
Buf (Pos + 1) := Unsigned_8 (Data (Y, X).G);
Buf (Pos + 2) := Unsigned_8 (Data (Y, X).R);
Buf (Pos + 3) := Unsigned_8 (Data (Y, X).A);
Pos := Pos + 4;
end loop;
Buf_Array'Write (Stream, Buf);
@ -27,15 +27,15 @@ package body Video.IO.BMP.Rasters.ARGB is
-- Note: we need (nominally) pixel transcoding because bit order may not match
procedure ARGB8888_Output is new Generic_Output (
Pixel_Type => Video.Rasters.ARGB.ARGB8888_Pixel,
Raster_Type => Video.Rasters.ARGB.ARGB8888_Raster,
Pixel_Type => Video.Pixels.ARGB.ARGB8888_Pixel,
Array_Type => Video.Pixels.ARGB.ARGB8888_Array,
Bits_Per_Pixel => 32,
Write_Row => ARGB8888_Write_Row);
procedure Output (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : in Video.Rasters.ARGB.ARGB8888_Raster;
Data : in Video.Pixels.ARGB.ARGB8888_Array;
Palette : in Colors.Palettes.Palette := Colors.Palettes.Empty_Palette)
renames ARGB8888_Output;
end Video.IO.BMP.Rasters.ARGB;
end Video.IO.BMP.Arrays.ARGB;

8
source/io/video-io-bmp-rasters-argb.ads → source/io/video-io-bmp-arrays-argb.ads
View File

@ -1,10 +1,10 @@
with Video.Rasters.ARGB;
with Video.Pixels.ARGB;
package Video.IO.BMP.Rasters.ARGB is
package Video.IO.BMP.Arrays.ARGB is
procedure Output (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : in Video.Rasters.ARGB.ARGB8888_Raster;
Data : in Video.Pixels.ARGB.ARGB8888_Array;
Palette : in Colors.Palettes.Palette := Colors.Palettes.Empty_Palette);
end Video.IO.BMP.Rasters.ARGB;
end Video.IO.BMP.Arrays.ARGB;

24
source/io/video-io-bmp-rasters-indexed.adb → source/io/video-io-bmp-arrays-indexed.adb
View File

@ -1,20 +1,20 @@
with Interfaces;
use Interfaces;
package body Video.IO.BMP.Rasters.Indexed is
package body Video.IO.BMP.Arrays.Indexed is
generic
type Pixel_Type is mod <>;
type Raster_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
type Array_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
procedure Generic_Write_Row (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : Raster_Type;
Data : Array_Type;
Y : Integer;
Bytes : Positive);
procedure Generic_Write_Row (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : Raster_Type;
Data : Array_Type;
Y : Integer;
Bytes : Positive)
is
@ -23,9 +23,9 @@ package body Video.IO.BMP.Rasters.Indexed is
Pos : Natural := 0;
Buf : Buf_Array (0 .. Bytes - 1) := (others => 0);
begin
for X in Raster'Range (2) loop
for X in Data'Range (2) loop
Bits := Bits - Pixel_Type'Size;
Buf (Pos) := Buf (Pos) or Shift_Left (Unsigned_8 (Raster (Y, X)), Bits);
Buf (Pos) := Buf (Pos) or Shift_Left (Unsigned_8 (Data (Y, X)), Bits);
if Bits <= 0 then
Bits := 8;
Pos := Pos + 1;
@ -36,20 +36,20 @@ package body Video.IO.BMP.Rasters.Indexed is
end Generic_Write_Row;
procedure Index_1_Write_Row is new Generic_Write_Row (
Pixel_Type => Video.Rasters.Indexed.Index_1_Pixel,
Raster_Type => Video.Rasters.Indexed.Index_1_Raster);
Pixel_Type => Video.Pixels.Indexed.Index_1_Pixel,
Array_Type => Video.Pixels.Indexed.Index_1_Array);
procedure Index_1_Output is new Generic_Output (
Pixel_Type => Video.Rasters.Indexed.Index_1_Pixel,
Raster_Type => Video.Rasters.Indexed.Index_1_Raster,
Pixel_Type => Video.Pixels.Indexed.Index_1_Pixel,
Array_Type => Video.Pixels.Indexed.Index_1_Array,
Bits_Per_Pixel => 1,
Write_Row => Index_1_Write_Row);
procedure Output (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : in Video.Rasters.Indexed.Index_1_Raster;
Data : in Video.Pixels.Indexed.Index_1_Array;
Palette : in Colors.Palettes.Palette := Colors.Palettes.Empty_Palette)
renames Index_1_Output;
end Video.IO.BMP.Rasters.Indexed;
end Video.IO.BMP.Arrays.Indexed;

10
source/io/video-io-bmp-arrays-indexed.ads Normal file
View File

@ -0,0 +1,10 @@
with Video.Pixels.Indexed;
package Video.IO.BMP.Arrays.Indexed is
procedure Output (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Data : in Video.Pixels.Indexed.Index_1_Array;
Palette : in Colors.Palettes.Palette := Colors.Palettes.Empty_Palette);
end Video.IO.BMP.Arrays.Indexed;

22
source/io/video-io-bmp-rasters-rgb.adb → source/io/video-io-bmp-arrays-rgb.adb
View File

@ -1,23 +1,23 @@
with Interfaces;
use Interfaces;
package body Video.IO.BMP.Rasters.RGB is
package body Video.IO.BMP.Arrays.RGB is
type Buf_Array is array (Natural range <>) of Unsigned_8;
procedure RGB888_Write_Row (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : Video.Rasters.RGB.RGB888_Raster;
Data : Video.Pixels.RGB.RGB888_Array;
Y : Integer;
Bytes : Positive)
is
Pos : Natural := 0;
Buf : Buf_Array (0 .. Bytes - 1) := (others => 0);
begin
for X in Raster'Range (2) loop
Buf (Pos) := Unsigned_8 (Raster (Y, X).B);
Buf (Pos + 1) := Unsigned_8 (Raster (Y, X).G);
Buf (Pos + 2) := Unsigned_8 (Raster (Y, X).R);
for X in Data'Range (2) loop
Buf (Pos) := Unsigned_8 (Data (Y, X).B);
Buf (Pos + 1) := Unsigned_8 (Data (Y, X).G);
Buf (Pos + 2) := Unsigned_8 (Data (Y, X).R);
Pos := Pos + 3;
end loop;
Buf_Array'Write (Stream, Buf);
@ -26,15 +26,15 @@ package body Video.IO.BMP.Rasters.RGB is
-- Note: we need (nominally) pixel transcoding because bit order may not match
procedure RGB888_Output is new Generic_Output (
Pixel_Type => Video.Rasters.RGB.RGB888_Pixel,
Raster_Type => Video.Rasters.RGB.RGB888_Raster,
Pixel_Type => Video.Pixels.RGB.RGB888_Pixel,
Array_Type => Video.Pixels.RGB.RGB888_Array,
Bits_Per_Pixel => 24,
Write_Row => RGB888_Write_Row);
Write_Row => RGB888_Write_Row);
procedure Output (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : in Video.Rasters.RGB.RGB888_Raster;
Data : in Video.Pixels.RGB.RGB888_Array;
Palette : in Colors.Palettes.Palette := Colors.Palettes.Empty_Palette)
renames RGB888_Output;
end Video.IO.BMP.Rasters.RGB;
end Video.IO.BMP.Arrays.RGB;

8
source/io/video-io-bmp-rasters-rgb.ads → source/io/video-io-bmp-arrays-rgb.ads
View File

@ -1,10 +1,10 @@
with Video.Rasters.RGB;
with Video.Pixels.RGB;
package Video.IO.BMP.Rasters.RGB is
package Video.IO.BMP.Arrays.RGB is
procedure Output (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : in Video.Rasters.RGB.RGB888_Raster;
Data : in Video.Pixels.RGB.RGB888_Array;
Palette : in Colors.Palettes.Palette := Colors.Palettes.Empty_Palette);
end Video.IO.BMP.Rasters.RGB;
end Video.IO.BMP.Arrays.RGB;

32
source/io/video-io-bmp-rasters.adb → source/io/video-io-bmp-arrays.adb
View File

@ -1,37 +1,37 @@
with Interfaces;
use Interfaces;
with Video.Rasters.Formats;
use type Video.Rasters.Formats.Color_Mode;
use type Video.Rasters.Formats.Component_Offset;
with Video.Pixels.Formats;
use type Video.Pixels.Formats.Color_Mode;
use type Video.Pixels.Formats.Component_Offset;
with Video.IO.Writers.LE;
package body Video.IO.BMP.Rasters is
package body Video.IO.BMP.Arrays is
type Unsigned_8_Array is array (Integer range <>) of Unsigned_8;
procedure Generic_Output (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : in Raster_Type;
Data : in Array_Type;
Palette : in Colors.Palettes.Palette := Colors.Palettes.Empty_Palette)
is
BF_Size : constant Positive := 14;
BI_Size : constant Positive := (
if Format.Mode /= Video.Rasters.Formats.ARGB then 56
if Format.Mode /= Video.Pixels.Formats.ARGB then 56
else 40);
CT_Size : constant Natural := Palette'Length * 4;
BM_Offset : constant Natural := BF_Size + BI_Size + CT_Size;
Row_Size_Prec : constant Natural := Bits_Per_Pixel * Raster'Length (2) / 8;
Row_Size_Prec : constant Natural := Bits_Per_Pixel * Data'Length (2) / 8;
Row_Size : constant Natural := (Row_Size_Prec + 3) / 4 * 4; -- round up
BM_Size : constant Natural := Raster'Length (1) * Row_Size;
BM_Size : constant Natural := Data'Length (1) * Row_Size;
File_Size : constant Positive := BM_Offset + BM_Size;
Writer : Writers.LE.LE_Writer := (Stream => Stream, Pos => 0);
function To_Mask (R : Video.Rasters.Formats.Component_Range) return Unsigned_32
function To_Mask (R : Video.Pixels.Formats.Component_Range) return Unsigned_32
is (Shift_Left (Unsigned_32'(1), Natural (R.Last + 1))
- Shift_Left (Unsigned_32'(1), Natural (R.First)));
begin
@ -44,8 +44,8 @@ package body Video.IO.BMP.Rasters is
-- DIB Header
Writer.Write (Unsigned_32 (BI_Size));
if BI_Size >= 16 then
Writer.Write (Integer_32 (Raster'Length (2)));
Writer.Write (Integer_32 (Raster'Length (1)));
Writer.Write (Integer_32 (Data'Length (2)));
Writer.Write (Integer_32 (Data'Length (1)));
Writer.Write (Unsigned_16 (1)); -- Number of planes
Writer.Write (Unsigned_16 (Bits_Per_Pixel));
end if;
@ -60,7 +60,7 @@ package body Video.IO.BMP.Rasters is
end if;
if BI_Size >= 52 then
if Format.Mode = Video.Rasters.Formats.ARGB then
if Format.Mode = Video.Pixels.Formats.ARGB then
Writer.Write (To_Mask (Format.R));
Writer.Write (To_Mask (Format.G));
Writer.Write (To_Mask (Format.B));
@ -72,7 +72,7 @@ package body Video.IO.BMP.Rasters is
end if;
if BI_Size >= 56 then
if Format.Mode = Video.Rasters.Formats.ARGB then
if Format.Mode = Video.Pixels.Formats.ARGB then
Writer.Write (To_Mask (Format.A));
else
Writer.Write (Unsigned_32 (0));
@ -92,12 +92,12 @@ package body Video.IO.BMP.Rasters is
pragma Assert (Writer.Pos = BM_Offset);
-- Pixels
for Y in reverse Raster'Range (1) loop
Write_Row (Stream, Raster, Y, Row_Size);
for Y in reverse Data'Range (1) loop
Write_Row (Stream, Data, Y, Row_Size);
Writer.Pos := Writer.Pos + Row_Size;
end loop;
pragma Assert (Writer.Pos = File_Size);
end Generic_Output;
end Video.IO.BMP.Rasters;
end Video.IO.BMP.Arrays;

16
source/io/video-io-bmp-rasters.ads → source/io/video-io-bmp-arrays.ads
View File

@ -1,20 +1,20 @@
with Video.Colors.Palettes;
with Video.Rasters.Formats;
with Video.Pixels.Formats;
package Video.IO.BMP.Rasters is
package Video.IO.BMP.Arrays is
generic
type Pixel_Type is private;
type Raster_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
type Array_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
Bits_Per_Pixel : Positive;
with procedure Write_Row (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : Raster_Type;
Data : Array_Type;
Y : Integer;
Bytes : Positive);
Format : Video.Rasters.Formats.Raster_Format
:= Video.Rasters.Formats.No_Format;
Format : Video.Pixels.Formats.Pixel_Format
:= Video.Pixels.Formats.No_Format;
procedure Generic_Output (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : in Raster_Type;
Data : in Array_Type;
Palette : in Colors.Palettes.Palette := Colors.Palettes.Empty_Palette);
end Video.IO.BMP.Rasters;
end Video.IO.BMP.Arrays;

10
source/io/video-io-bmp-rasters-indexed.ads
View File

@ -1,10 +0,0 @@
with Video.Rasters.Indexed;
package Video.IO.BMP.Rasters.Indexed is
procedure Output (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : in Video.Rasters.Indexed.Index_1_Raster;
Palette : in Colors.Palettes.Palette := Colors.Palettes.Empty_Palette);
end Video.IO.BMP.Rasters.Indexed;