-- $Date: 2004/01/02 09:54:39 $
-- $Revision: 1.2 $
-- $Author: jcrocholl $

with Ada.Unchecked_Deallocation;
with Ada.Exceptions; use Ada.Exceptions;

with PNM; use PNM;

package body PBM is

   PBM_Magic : constant String := "P4";

   -- Read a PBM header from a stream.
   procedure Read_Header
     (Stream : in Stream_Access-- Read from this stream.
      Width  : out Positive;     -- Width of image in pixels.
      Height : out Positive)     -- Height of image in pixels.
   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;

   -- Write a PBM header to a stream.
   procedure Write_Header
     (Stream : in Stream_Access-- Write to this stream.
      Width  : in Positive;      -- Width of image in pixels.
      Height : in Positive) is   -- Height of image in pixels.
   begin
      Write_Header(Stream, PBM_Magic, Width, Height);
   end Write_Header;

   -- Create a bit buffer with a capacity of 8 * Byte_Count pixels.
   function Create
     (Byte_Count : in Positive-- The number of bytes in the buffer.
     return Bit_Buffer is       -- The newly created bit buffer.
   begin
      return new Bit_Buffer_Record(Byte_Count);
   end Create;

   procedure Free is
     new Ada.Unchecked_Deallocation(Bit_Buffer_Record, Bit_Buffer);

   -- Free the bit buffer's memory and set the instance variable to
   -- null.
   procedure Deallocate
     (This : in out Bit_Buffer) is -- Free this bit buffer.
   begin
      Free(This);
      This := null;
   end Deallocate;

   -- Restart reading from the left of the bit buffer.
   procedure Reset
     (This : in Bit_Buffer) is -- Reset this bit buffer.
   begin
      This.Temp_Index := 0;
      This.Temp_Bits := 0;
      This.Temp := 0;
   end Reset;

   -- Set all bits in this bit buffer to False.
   procedure Clear
     (This : in Bit_Buffer) is -- Clear this bit buffer.
   begin
      for Index in This.Bytes'Range loop
         This.Bytes(Index) := 0;
      end loop;
      Reset(This);
   end Clear;

   -- Fill the bit buffer with data from a stream.
   procedure Read_Row
     (From : in Stream_Access-- Read from this stream.
      This : in Bit_Buffer) is -- Read data into this bit buffer.
   begin
      Byte_Array'Read(From, This.Bytes);
      Reset(This);
   end Read_Row;

   -- Read the next bit from the bit buffer and advance the bit pointer.
   function Read_Pixel
     (This : in Bit_Buffer-- Read from this bit buffer.
     return Boolean         -- The resulting bit value.
   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;