-- $Date: 2004/01/09 14:09:09 $
-- $Revision: 1.7 $
-- $Author: jcrocholl $

with Pipes; use Pipes;
with PBM; use PBM;
with Real_Numbers; use Real_Numbers;
with Real_Strings; use Real_Strings;
with Integer_Strings; use Integer_Strings;
with Messages; use Messages;
with Lines; use Lines;
with Straights; use Straights;
with Outlines; use Outlines;
with Lists;

package body Read_PBM is

   -- One end of an outline while it is created.
   type End_Record is record
      O : Outline-- Pointer to the outline.
      X : Integer-- Horizontal coordinate.
   end record;

   -- Lists of ends of outlines.
   package End_Lists is new Lists(End_Record);
   use End_Lists;
   subtype End_List is End_Lists.List;

   -- Lists of changes from white to black pixels and back.
   package Change_Lists is new Lists(Integer);
   use Change_Lists;
   subtype Change_List is Change_Lists.List;

   -- Find a list of changes from white to black pixels and back.
   procedure Find_Changes
     (Bits   : in Bit_Buffer;      -- Read pixels from this bit buffer.
      Width  : in Positive;        -- Number of pixels to read.
      Result : in out Change_List-- The resulting list of changes.
   is
      Bit      : Boolean-- The current pixel value.
      Previous : Boolean-- The previous pixel value.
   begin
      Previous := False;
      for X in 1 .. Width loop
         Bit := Read_Pixel(Bits);
         if Bit /= Previous then
            Change_Lists.Push(Result, X - 1);
            Previous := Bit;
         end if;
      end loop;
      if Previous then
         Change_Lists.Push(Result, Width);
      end if;
   end Find_Changes;

   -- Create a new straight line.
   function Create
     (X, Y : in Integer-- Coordinates.
     return Line is
   begin
      return Create(((Real(X), Real(Y))));
   end Create;

   -- Start a new outline.
   procedure Create_Outline
     (White_To_Black : in Boolean;         -- Inside or outside.
      Changes        : in out Change_List-- From white to black and back.
      Y              : in Integer;         -- Vertical coordinate.
      Ends           : in out End_List)    -- Insert two new ends here.
   is
      X1, X2      : Integer;
      New_Outline : Outline;
   begin
      X1 := Current(Changes);
      Remove_Current(Changes);
      X2 := Current(Changes);
      Remove_Current(Changes);

      -- Debug("creating outline");
      if White_To_Black then
         Line_Lists.Push(New_Outline, Create(X1, Y));
         Line_Lists.Push(New_Outline, Create(X2, Y));
      else
         Line_Lists.Push(New_Outline, Create(X2, Y));
         Line_Lists.Push(New_Outline, Create(X1, Y));
      end if;

      Insert_Before_Current(Ends, (O => New_Outline, X => X1));
      Insert_Before_Current(Ends, (O => New_Outline, X => X2));
   end Create_Outline;

   -- Replace one outline with another.
   procedure Replace_Outline
     (Ends : in out End_List-- Replace in this list of ends.
      A, B : in Outline)      -- Replace first occurence of A with B.
   is
      use type Outline;
      Current : End_Lists.Item := First_Item(Ends);
      E       : End_Record := Item_Content(Current);
   begin
      E := Item_Content(Current);
      while E.O /= A loop
         Next_Item(Current);
         E := Item_Content(Current);
      end loop;
      E.O := B;
      Update_Item(Current, E);
   end Replace_Outline;

   -- Join two outline ends. This either produces a closed outline,
   -- which is then added to the result glyph, or one longer outline
   -- which is still open.
   procedure Close_Outline
     (White_To_Black : in Boolean;      -- Inside or outside?
      Y              : in Integer;      -- Vertical coordinate?
      Ends           : in out End_List-- Remove two from ends list.
      Result         : in out Glyph)    -- Add outline to this glyph.
   is
      use type Outline;
      End1, End2 : End_Record;
      O1, O2     : Outline;
   begin
      End1 := Current(Ends);
      Remove_Current(Ends);
      O1 := End1.O;

      End2 := Current(Ends);
      Remove_Current(Ends);
      O2 := End2.O;

      -- Debug("closing outline");
      if White_To_Black then
         Line_Lists.Unshift(O1, Create(End1.X, Y));
         Line_Lists.Push (O2, Create(End2.X, Y));
      else
         Line_Lists.Push (O1, Create(End1.X, Y));
         Line_Lists.Unshift(O2, Create(End2.X, Y));
      end if;
      if O1 = O2 then
         -- Debug("pushing outline");
         Add_Outline(Result, O1);
      else
         if White_To_Black then
            Line_Lists.Append(O2, O1);
            Replace_Outline(Ends, O1, O2);
         else
            Line_Lists.Append(O1, O2);
            Replace_Outline(Ends, O2, O1);
         end if;
      end if;
   end Close_Outline;

   -- Remove on change from change list and append two new lines to
   -- the corresponding end of an open outline
   procedure Append
     (White_To_Black : in out Boolean;     -- Inside or outside?
      Changes        : in out Change_List-- Remove from changes list.
      Y              : in Integer;         -- Vertical coordinate.
      Ends           : in out End_List)    -- Append to ends list.
   is
      X : Integer := Current(Changes);
      E : End_Record;
      O : Outline;
   begin
      Remove_Current(Changes);
      if X /= Current(Ends).X then
         if White_To_Black then
            -- Debug("appending white to black");
            O := Current(Ends).O;
            Line_Lists.Unshift(O, Create(Current(Ends).X, Y));
            Line_Lists.Unshift(O, Create(X, Y));
         else
            -- Debug("appending black to white");
            O := Current(Ends).O;
            Line_Lists.Push(O, Create(Current(Ends).X, Y));
            Line_Lists.Push(O, Create(X, Y));
         end if;
         E := Current(Ends);
         E.X := X;
         Update_Current(Ends, E);
      end if;
      White_To_Black := not White_To_Black;
      End_Lists.Next(Ends);
   end Append;

   -- Read one line of changes and add lines the result glyph.
   procedure Read_Line
     (Changes : in out Change_List-- Read this line of changes.
      Y       : in Integer;         -- Vertical coordinate of this line.
      Ends    : in out End_List;    -- The open ends from previous lines.
      Result  : in out Glyph)       -- Add lines to this glyph.
   is
      White_To_Black : Boolean := True;

      procedure Debug is
      begin
         Debug2(To_String(End_Lists.Count(Ends)) & " ends");
         End_Lists.Reset(Ends);
         while End_Lists.Next(Ends) loop
            Debug2(" " & To_String(Current(Ends).X));
         end loop;
         Debug2(", ");

         Debug2(To_String(Change_Lists.Count(Changes)) & " changes");
         Change_Lists.Reset(Changes);
         while Change_Lists.Next(Changes) loop
            Debug2(" " & To_String(Current(Changes)));
         end loop;
         Debug("");
      end Debug;

   begin
      -- Debug;

      Reset(Ends);
      Next(Ends);

      Reset(Changes);
      Next(Changes);

      while not Empty(Ends)
        and then not End_Of_List(Ends)
        and then not Empty(Changes)
        and then not End_Of_List(Changes)
      loop
         if not End_Of_List(Changes)
           and then Next_Available(Changes)
           and then Next_Content(Changes) < Current(Ends).X
         then
            -- two changes before next end
            -- Debug("two changes before next end");
            Create_Outline(White_To_Black, Changes, Y, Ends);
         elsif not End_Of_List(Ends)
           and then Next_Available(Ends)
           and then Next_Content(Ends).X < Current(Changes)
         then
            -- two ends before next change
            -- Debug("two ends before next change");
            Close_Outline(White_To_Black, Y, Ends, Result);
         else
            -- first change and end belong together
            Append(White_To_Black, Changes, Y, Ends);
         end if;
      end loop;

      -- changes or ends or both are now empty
      while not Empty(Changes)
        and then not End_Of_List(Changes)
      loop
         -- two changes alone
         -- Debug2("two changes alone, ");
         Create_Outline(White_To_Black, Changes, Y, Ends);
      end loop;

      while not Empty(Ends)
        and then not End_Of_List(Ends)
      loop
         -- two ends alone
         -- Debug2("two ends alone, ");
         Close_Outline(White_To_Black, Y, Ends, Result);
      end loop;
   end Read_Line;

   -- Read a glyph from a PBM stream.
   function Read_Stream
     (Stream : in Stream_Access-- Read from this stream.
     return Glyph                -- The newly created glyph.
   is
      Width   : Positive;
      Height  : Positive;
      Bits    : PBM.Bit_Buffer;
      Ends    : End_List;
      Changes : Change_List;
      Result  : Glyph;
   begin
      PBM.Read_Header(Stream, Width, Height);
      Result := Create("");
      Set_Bounds(Result, 0.0, 0.0, Real(Width), Real(Height));
      Bits := Create((Width + 7) / 8);
      for Y in reverse 1 .. Height loop
         -- Debug2(Character'Val(13) & "read line " & To_String(Y) & "... ");
         Read_Row(Stream, Bits);
         Find_Changes(Bits, Width, Changes);
         Read_Line(Changes, Y, Ends, Result);
         -- Change_Lists.Destroy(Changes);
      end loop;
      -- Debug2(Character'Val(13) & "clear line 0... ");
      Clear(Bits);
      -- Changes := null;
      Read_Line(Changes, 0, Ends, Result);
      Deallocate(Bits);
      -- Debug(Character'Val(13) &"read done. ");
      return Result;
   end Read_Stream;

   -- Read a glyph from a PBM on current input.
   -- Useful to read from a pipe.
   function Read_Current_Input
     return Glyph -- The newly created glyph.
   is
      Input : Stream_Access := Stream_Access(Pipes.Std_In);
   begin
      return Read_Stream(Input);
   end Read_Current_Input;

   -- Read a glyph from a PBM file.
   function Read_File
     (Filename : in String-- Read from this file.
     return Glyph           -- The newly created glyph.
   is
      File   : File_Type;
      Result : Glyph;
   begin
      Open(File, In_File, Filename);
      Result := Read_Stream(Stream(File));
      Close(File);
      return Result;
   end Read_File;

end Read_PBM;