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

+ Typed writer interface

This commit is contained in:
Vovanium 2023-02-13 21:53:55 +03:00
parent 66c0baaf86
commit f6ca9c30d0
5 changed files with 100 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
source/io/video-io-bmp-rasters.adb
View File

@ -5,6 +5,8 @@ with Video.Rasters.Formats;
use type Video.Rasters.Formats.Color_Mode;
use type Video.Rasters.Formats.Component_Offset;
with Video.IO.Writers.LE;
package body Video.IO.BMP.Rasters is
type Unsigned_8_Array is array (Integer range <>) of Unsigned_8;
@ -26,107 +28,76 @@ package body Video.IO.BMP.Rasters is
BM_Size : constant Natural := Raster'Length (1) * Row_Size;
File_Size : constant Positive := BM_Offset + BM_Size;
Pos : Natural := 0;
procedure Write (Data : Unsigned_8_Array) is
begin
Unsigned_8_Array'Write (Stream, Data);
Pos := Pos + Data'Length;
end;
procedure Write (Data : in Unsigned_8) is
Tmp : Unsigned_8_Array (0 .. 0);
begin
Tmp (0) := Data;
Write (Tmp);
end;
procedure Write (Data : in Unsigned_16) is
Tmp : Unsigned_8_Array (0 .. 1);
begin
Tmp (0) := Unsigned_8 (Data mod 256);
Tmp (1) := Unsigned_8 (Data / 256 mod 256);
Write (Tmp);
end;
procedure Write (Data : in Unsigned_32) is
Tmp : Unsigned_8_Array (0 .. 3);
begin
Tmp (0) := Unsigned_8 (Data mod 256);
Tmp (1) := Unsigned_8 (Data / 256 mod 256);
Tmp (2) := Unsigned_8 (Data / 256**2 mod 256);
Tmp (3) := Unsigned_8 (Data / 256**3 mod 256);
Write (Tmp);
end;
procedure Write (Data : in Integer_32) is
begin
Write (Unsigned_32 (Data));
end;
Writer : Writers.LE.LE_Writer := (Stream => Stream, Pos => 0);
function To_Mask (R : Video.Rasters.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
-- File Header
Write (Unsigned_16 (Character'Pos ('B') + Character'Pos ('M') * 256));
Write (Unsigned_32 (File_Size));
Write (Unsigned_32 (0)); -- Reserved
Write (Unsigned_32 (BM_Offset));
Writer.Write (Unsigned_16 (Character'Pos ('B') + Character'Pos ('M') * 256));
Writer.Write (Unsigned_32 (File_Size));
Writer.Write (Unsigned_32 (0)); -- Reserved
Writer.Write (Unsigned_32 (BM_Offset));
-- DIB Header
Write (Unsigned_32 (BI_Size));
Writer.Write (Unsigned_32 (BI_Size));
if BI_Size >= 16 then
Write (Integer_32 (Raster'Length (2)));
Write (Integer_32 (Raster'Length (1)));
Write (Unsigned_16 (1)); -- Number of planes
Write (Unsigned_16 (Bits_Per_Pixel));
Writer.Write (Integer_32 (Raster'Length (2)));
Writer.Write (Integer_32 (Raster'Length (1)));
Writer.Write (Unsigned_16 (1)); -- Number of planes
Writer.Write (Unsigned_16 (Bits_Per_Pixel));
end if;
if BI_Size >= 40 then
Write (Unsigned_32 (0)); -- BI_RGB
Write (Unsigned_32 (BM_Size));
Write (Unsigned_32 (1000)); -- Horizontal resolution
Write (Unsigned_32 (1000)); -- Vertical resolution
Write (Unsigned_32 (Palette'Length));
Write (Unsigned_32 (0)); -- Important colors (0 means all)
Writer.Write (Unsigned_32 (0)); -- BI_RGB
Writer.Write (Unsigned_32 (BM_Size));
Writer.Write (Unsigned_32 (1000)); -- Horizontal resolution
Writer.Write (Unsigned_32 (1000)); -- Vertical resolution
Writer.Write (Unsigned_32 (Palette'Length));
Writer.Write (Unsigned_32 (0)); -- Important colors (0 means all)
end if;
if BI_Size >= 52 then
if Format.Mode = Video.Rasters.Formats.ARGB then
Write (To_Mask (Format.R));
Write (To_Mask (Format.G));
Write (To_Mask (Format.B));
Writer.Write (To_Mask (Format.R));
Writer.Write (To_Mask (Format.G));
Writer.Write (To_Mask (Format.B));
else
Write (Unsigned_32 (0));
Write (Unsigned_32 (0));
Write (Unsigned_32 (0));
Writer.Write (Unsigned_32 (0));
Writer.Write (Unsigned_32 (0));
Writer.Write (Unsigned_32 (0));
end if;
end if;
if BI_Size >= 56 then
if Format.Mode = Video.Rasters.Formats.ARGB then
Write (To_Mask (Format.A));
Writer.Write (To_Mask (Format.A));
else
Write (Unsigned_32 (0));
Writer.Write (Unsigned_32 (0));
end if;
end if;
-- Color Table
if BI_Size >= 16 then
for I in Palette'Range loop
Write (Unsigned_8 (Colors.To_8_Bit (Palette (I).R)));
Write (Unsigned_8 (Colors.To_8_Bit (Palette (I).G)));
Write (Unsigned_8 (Colors.To_8_Bit (Palette (I).B)));
Write (Unsigned_8 (Colors.To_8_Bit (Palette (I).A)));
Writer.Write (Unsigned_8 (Colors.To_8_Bit (Palette (I).R)));
Writer.Write (Unsigned_8 (Colors.To_8_Bit (Palette (I).G)));
Writer.Write (Unsigned_8 (Colors.To_8_Bit (Palette (I).B)));
Writer.Write (Unsigned_8 (Colors.To_8_Bit (Palette (I).A)));
end loop;
end if;
pragma Assert (Pos = BM_Offset);
pragma Assert (Writer.Pos = BM_Offset);
-- Pixels
for Y in reverse Raster'Range (1) loop
Write_Row (Stream, Raster, Y, Row_Size);
Pos := Pos + Row_Size;
Writer.Pos := Writer.Pos + Row_Size;
end loop;
pragma Assert (Pos = File_Size);
pragma Assert (Writer.Pos = File_Size);
end Generic_Output;
end Video.IO.BMP.Rasters;

26
source/io/video-io-writers-le.adb Normal file
View File

@ -0,0 +1,26 @@
package body Video.IO.Writers.LE is
procedure Write (Writer : in out LE_Writer; Data : in Unsigned_16) is
Buf : Unsigned_8_Array (0 .. 1);
begin
Buf (0) := Unsigned_8 (Data and (2**8 - 1));
Buf (1) := Unsigned_8 (Shift_Right (Data, 8) and (2**8 - 1));
Writer.Write (Buf);
end Write;
procedure Write (Writer : in out LE_Writer; Data : in Unsigned_32) is
Buf : Unsigned_8_Array (0 .. 3);
begin
Buf (0) := Unsigned_8 (Data and (2**8 - 1));
Buf (1) := Unsigned_8 (Shift_Right (Data, 8) and (2**8 - 1));
Buf (2) := Unsigned_8 (Shift_Right (Data, 16) and (2**8 - 1));
Buf (3) := Unsigned_8 (Shift_Right (Data, 24) and (2**8 - 1));
Writer.Write (Buf);
end Write;
procedure Write (Writer : in out LE_Writer; Data : in Integer_32) is
begin
Writer.Write (Unsigned_32 (Data));
end Write;
end Video.IO.Writers.LE;

10
source/io/video-io-writers-le.ads Normal file
View File

@ -0,0 +1,10 @@
package Video.IO.Writers.LE is
type LE_Writer is new Base_Writer with null record;
procedure Write (Writer : in out LE_Writer; Data : in Unsigned_16);
procedure Write (Writer : in out LE_Writer; Data : in Unsigned_32);
procedure Write (Writer : in out LE_Writer; Data : in Integer_32);
end Video.IO.Writers.LE;

15
source/io/video-io-writers.adb Normal file
View File

@ -0,0 +1,15 @@
package body Video.IO.Writers is
procedure Write (Writer : in out Base_Writer; Data : in Unsigned_8) is
begin
Unsigned_8'Write (Writer.Stream, Data);
Writer.Pos := Writer.Pos + 1;
end Write;
procedure Write (Writer : in out Base_Writer; Data : in Unsigned_8_Array) is
begin
Unsigned_8_Array'Write (Writer.Stream, Data);
Writer.Pos := Writer.Pos + Data'Length;
end Write;
end Video.IO.Writers;

16
source/io/video-io-writers.ads Normal file
View File

@ -0,0 +1,16 @@
with Interfaces;
use Interfaces;
package Video.IO.Writers is
type Unsigned_8_Array is array (Integer range <>) of Unsigned_8;
type Base_Writer is tagged limited record
Stream : access Ada.Streams.Root_Stream_Type'Class;
Pos : Integer := 0;
end record;
procedure Write (Writer : in out Base_Writer; Data : in Unsigned_8);
procedure Write (Writer : in out Base_Writer; Data : in Unsigned_8_Array);
end Video.IO.Writers;