Hosted by
 |
with Ada.Unchecked_Deallocation;
with Ada.Exceptions; use Ada.Exceptions;
with PNM; use PNM;
package body PBM is
PBM_Magic : constant String := "P4";
procedure Read_Header
(Stream : in Stream_Access;
Width : out Positive;
Height : out Positive)
is
Magic : String2;
begin
Read_Header(Stream, Magic, Width, Height);
if Magic /= PBM_Magic then
Raise_Exception(Expect_P4'Identity,
"not a PBM file: expected """ & PBM_Magic &
""" but found """ & Magic & """");
end if;
end Read_Header;
procedure Write_Header
(Stream : in Stream_Access;
Width : in Positive;
Height : in Positive) is
begin
Write_Header(Stream, PBM_Magic, Width, Height);
end Write_Header;
function Create
(Byte_Count : in Positive)
return Bit_Buffer is
begin
return new Bit_Buffer_Record(Byte_Count);
end Create;
procedure Free is
new Ada.Unchecked_Deallocation(Bit_Buffer_Record, Bit_Buffer);
procedure Deallocate
(This : in out Bit_Buffer) is
begin
Free(This);
This := null;
end Deallocate;
procedure Reset
(This : in Bit_Buffer) is
begin
This.Temp_Index := 0;
This.Temp_Bits := 0;
This.Temp := 0;
end Reset;
procedure Clear
(This : in Bit_Buffer) is
begin
for Index in This.Bytes'Range loop
This.Bytes(Index) := 0;
end loop;
Reset(This);
end Clear;
procedure Read_Row
(From : in Stream_Access;
This : in Bit_Buffer) is
begin
Byte_Array'Read(From, This.Bytes);
Reset(This);
end Read_Row;
function Read_Pixel
(This : in Bit_Buffer)
return Boolean
is
use type Byte;
begin
if This.Temp_Bits = 0 then
This.Temp_Index := This.Temp_Index + 1;
This.Temp := This.Bytes(This.Temp_Index);
This.Temp_Bits := 8;
end if;
This.Temp_Bits := This.Temp_Bits - 1;
This.Temp := Interfaces.Rotate_Left(This.Temp, 1);
return (This.Temp and 1) = 1;
end Read_Pixel;
end PBM;
|