Files
lace/3-mid/opengl/private/gid/gid-decoding_bmp.adb
2022-07-31 17:34:54 +10:00

123 lines
3.9 KiB
Ada

with GID.Buffering; use GID.Buffering;
package body GID.Decoding_BMP is
procedure Load (image: in out Image_descriptor) is
b01, b, br, bg, bb: U8:= 0;
x, x_max, y: Natural;
--
procedure Pixel_with_palette is
pragma Inline(Pixel_with_palette);
begin
case Primary_color_range'Modulus is
when 256 =>
Put_Pixel(
Primary_color_range(image.palette(Integer(b)).red),
Primary_color_range(image.palette(Integer(b)).green),
Primary_color_range(image.palette(Integer(b)).blue),
255
);
when 65_536 =>
Put_Pixel(
16#101# * Primary_color_range(image.palette(Integer(b)).red),
16#101# * Primary_color_range(image.palette(Integer(b)).green),
16#101# * Primary_color_range(image.palette(Integer(b)).blue),
65_535
-- 16#101# because max intensity FF goes to FFFF
);
when others =>
raise invalid_primary_color_range;
end case;
end Pixel_with_palette;
--
pair: Boolean;
bit: Natural range 0..7;
--
line_bits: constant Float:= Float(image.width * image.bits_per_pixel);
padded_line_size: constant Positive:= 4 * Integer(Float'Ceiling(line_bits / 32.0));
unpadded_line_size: constant Positive:= Integer(Float'Ceiling(line_bits / 8.0));
-- (in bytes)
begin
Attach_Stream(image.buffer, image.stream);
y:= 0;
while y <= image.height-1 loop
x:= 0;
x_max:= image.width-1;
case image.bits_per_pixel is
when 1 => -- B/W
bit:= 0;
Set_X_Y(x,y);
while x <= x_max loop
if bit=0 then
Get_Byte(image.buffer, b01);
end if;
b:= (b01 and 16#80#) / 16#80#;
Pixel_with_palette;
b01:= b01 * 2; -- cannot overflow.
if bit=7 then
bit:= 0;
else
bit:= bit + 1;
end if;
x:= x + 1;
end loop;
when 4 => -- 16 colour image
pair:= True;
Set_X_Y(x,y);
while x <= x_max loop
if pair then
Get_Byte(image.buffer, b01);
b:= (b01 and 16#F0#) / 16#10#;
else
b:= (b01 and 16#0F#);
end if;
pair:= not pair;
Pixel_with_palette;
x:= x + 1;
end loop;
when 8 => -- 256 colour image
Set_X_Y(x,y);
while x <= x_max loop
Get_Byte(image.buffer, b);
Pixel_with_palette;
x:= x + 1;
end loop;
when 24 => -- RGB, 256 colour per primary colour
Set_X_Y(x,y);
while x <= x_max loop
Get_Byte(image.buffer, bb);
Get_Byte(image.buffer, bg);
Get_Byte(image.buffer, br);
case Primary_color_range'Modulus is
when 256 =>
Put_Pixel(
Primary_color_range(br),
Primary_color_range(bg),
Primary_color_range(bb),
255
);
when 65_536 =>
Put_Pixel(
256 * Primary_color_range(br),
256 * Primary_color_range(bg),
256 * Primary_color_range(bb),
65_535
);
when others =>
raise invalid_primary_color_range;
end case;
x:= x + 1;
end loop;
when others =>
null;
end case;
for i in unpadded_line_size + 1 .. padded_line_size loop
Get_Byte(image.buffer, b);
end loop;
y:= y + 1;
Feedback((y*100)/image.height);
end loop;
end Load;
end GID.Decoding_BMP;