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

+ project for IO, BMP saver started

Browse source
This commit is contained in:
Vovanium 2022-11-25 02:06:55 +03:00
parent 56b5412b41
commit 0f77839dd6
3 changed files with 50 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
source/io/video-io-bmp.adb Normal file
View file

@ -0,0 +1,18 @@
package body Video.IO.BMP is
procedure Generic_Output (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : in Raster_Type)
is
BF_Size : constant Natural := 14;
BI_Size : constant Natural := 16;
Row_Size_Prec : constant Natural := Pixel_Type'Size / 8 * Raster'Length (2);
Row_Size : constant Natural := (Row_Size_Prec + 3) / 4 * 4; -- round up
BM_Size : constant Natural := Raster'Length (1) * Row_Size;
BFH_File_Size : constant Format.Unsigned_32 := Format.Unsigned_32 (BF_Size + BI_Size + BM_Size);
begin
String'Write (Stream, "BM");
Format.Unsigned_32'Write (Stream, BFH_File_Size);
end Generic_Output;
end Video.IO.BMP;

34
source/io/video-io-bmp.ads
View file

@ -1,12 +1,14 @@
with Ada.Streams;
package Video.IO.BMP is
package Format is
type Header_Tag is String (1 .. 2);
subtype Header_Tag is String (1 .. 2);
type Unsigned_8 is mod 2**8 with Size => 8, Bit_Order => Low_Order_First;
type Unsigned_16 is mod 2**16 with Size => 16, Bit_Order => Low_Order_First;
type Unsigned_32 is mod 2**32 with Size => 32, Bit_Order => Low_Order_First;
type Signed_32 is range -2**31 .. 2**31 - 1 with Size => 32, Bit_Order => Low_Order_First;
type Unsigned_8 is mod 2**8 with Size => 8;
type Unsigned_16 is mod 2**16 with Size => 16;
type Unsigned_32 is mod 2**32 with Size => 32;
type Signed_32 is range -2**31 .. 2**31 - 1 with Size => 32;
type File_Header is record
Tag : Header_Tag := "BM"; -- BM, BA, CI, CP, IC or PT is suitable
@ -36,7 +38,7 @@ package Video.IO.BMP is
-- BI_Size = 12: Windows 2.0, OS/2 1.x
type Core_Header is record
Width, -- Pixel width of the image
Height : Unsigned_16 -- Pixel height of the image (Windows 2.0 treats them as signed)
Height : Unsigned_16; -- Pixel height of the image (Windows 2.0 treats them as signed)
Planes : Unsigned_16 := 1; -- Number of planes (must be one)
Bit_Count : Unsigned_16; -- Bits per pixel (1, 2, 4 or 8)
end record with Pack;
@ -44,10 +46,10 @@ package Video.IO.BMP is
type Color_Space is new Unsigned_32;
LCS_Calibrated_RGB : constant Color_Space := 0;
type Fixed_2_30 is range -2 .. 2 delta 2**(-30) with Size => 32, Bit_Order => Low_Order_First;
type Fixed_2_30 is delta 2.0**(-30) range -2.0 .. 2.0 with Size => 32;
type CIE_XYZ is record
X, Y, Z : Fixed_2_30 := 0;
X, Y, Z : Fixed_2_30 := 0.0;
end record;
type CIE_XYZ_Triple is record
@ -56,7 +58,7 @@ package Video.IO.BMP is
Blue : CIE_XYZ := (0.15, 0.06, 0.79);
end record with Pack;
type UFixed_16_16 is range 0 .. 2**16-1 delta 2**(-16) with Size => 32, Bit_Order => Low_Order_First;
type UFixed_16_16 is delta 2.0**(-16) range 0.0 .. 2.0**16 with Size => 32;
type Rendering_Intent is new Unsigned_32;
RI_Perceptual : constant Rendering_Intent := 4;
@ -65,7 +67,7 @@ package Video.IO.BMP is
-- BI_Size = 40: Windows 3.1, NT
type Info_Header is record
Width, -- Pixel width
Height : Signed_32 -- Pixel height (Negative for top-down order)
Height : Signed_32; -- Pixel height (Negative for top-down order)
Planes : Unsigned_16 := 1; -- Number of color planes (must be one)
Bit_Count : Unsigned_16; -- Bits per pixel
-- when BI_Size = 16 data stops here
@ -98,7 +100,7 @@ package Video.IO.BMP is
BI_PPM : constant Resolution_Units := 0; -- resolution is in pixels per metre
type Fill_Direction is new Unsigned_16;
BI_LR_BU : constant Fill_Direction := 0; -- bitmap fill direction: left-to-right then bottom-up
BI_LR_BU : constant Fill_Direction := 0; -- bitmap fill direction: left-to-right then bottom-up
type Halftoning_Algorithm is new Unsigned_16;
BI_HT_None : constant Halftoning_Algorithm := 0; -- No halftoning
@ -107,12 +109,11 @@ package Video.IO.BMP is
type Color_Encoding is new Unsigned_16; -- Palette color encoding
BI_CE_RGB : constant Color_Encoding := 0; -- RGB
-- BI_Size = 64 : OS/2 2.x
type OS2_Header is record
Width, -- Pixel width
Height : Unsigned_32 -- Pixel height (Negative for top-down order)
Height : Unsigned_32; -- Pixel height (Negative for top-down order)
Planes : Unsigned_16 := 1; -- Number of color planes (must be one)
Bit_Count : Unsigned_16; -- Bits per pixel
Compression : Compression_Method := BI_RGB; -- Image data format
@ -132,4 +133,11 @@ package Video.IO.BMP is
end record with Pack;
end Format;
generic
type Pixel_Type is private;
type Raster_Type is array (Integer range <>, Integer range <>) of Pixel_Type;
procedure Generic_Output (
Stream : access Ada.Streams.Root_Stream_Type'Class;
Raster : in Raster_Type);
end Video.IO.BMP;

11
video_io.gpr Normal file
View file

@ -0,0 +1,11 @@
with "video_base";
project Video_IO extends "common" is
for Library_Name use "Video_IO";
for Source_Dirs use ("source/io");
for Object_Dir use "build/objects";
for Library_Kind use "static";
end Video_IO;