read_pbm
read_pbm.ads
read_pbm.adb
raster
glyph_images
intersec_heaps
intersections
read_pbm
render_glyphs
glyph2pgm.adb
pbm2glyph.adb
fonts
eps/
glyphs/
lines/
loaders/
raster/
svg/
ada
bin/
engine/
fonts/
internal/
text/
util/
Home
Showcase
Snapshots
Ada Source
PHP Source
Fonts
Sourceforge
Summary
Downloads
Browse CVS
Donate
Activity

Hosted by
SourceForge.net Logo

 -- $Date: 2004/03/05 08:59:10 $
-- $Revision: 1.15 $
-- $Author: jcrocholl $

with Pipes; use Pipes;
with PBM; use PBM;
with Depixel; use Depixel;
-- with Bit_Buffers; use Bit_Buffers;
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
      Outline : Outline_Access; -- 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;
   subtype End_List_Access is End_Lists.List_Access;

   -- 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;
   subtype Change_List_Access is Change_Lists.List_Access;

   -- Find a list of changes from white to black pixels and back.
   procedure Find_Changes
     (Bits   : access Bit_Buffer;  -- Read pixels from this bit buffer.
      Width  : in Positive;        -- Number of pixels to read.
      Result : access 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_Bit(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_Access 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        : access Change_List; -- From white to black and back.
      Y              : in Integer;         -- Vertical coordinate.
      Ends           : access End_List)    -- Insert two new ends here.
   is
      X1, X2      : Integer;
      New_Outline : Outline_Access := Create;
   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, (Outline => New_Outline, X => X1));
      Insert_Before_Current(Ends, (Outline => New_Outline, X => X2));
   end Create_Outline;

   -- Replace one outline with another.
   procedure Replace_Outline
     (Ends : access End_List;   -- Replace in this list of ends.
      A, B : in Outline_Access) -- Replace first occurence of A with B.
   is
      use type Outline_Access;
      Current : End_Lists.Item_Access := First_Item(Ends);
      E       : End_Record := Item_Content(Current);
   begin
      E := Item_Content(Current);
      while E.Outline /= A loop
         Next_Item(Current);
         if Item_Invalid(Current) then return; end if;
         E := Item_Content(Current);
      end loop;
      E.Outline := 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           : access End_List; -- Remove two from ends list.
      Result         : access Glyph)    -- Add outline to this glyph.
   is
      use type Outline_Access;
      End1, End2 : End_Record;
      Outline1   : Outline_Access;
      Outline2   : Outline_Access;
   begin
      End1 := Current(Ends);
      Remove_Current(Ends);
      Outline1 := End1.Outline;

      End2 := Current(Ends);
      Remove_Current(Ends);
      Outline2 := End2.Outline;

      -- Debug("closing outline");
      if White_To_Black then
         Line_Lists.Unshift(Outline1, Create(End1.X, Y));
         Line_Lists.Push (Outline2, Create(End2.X, Y));
      else
         Line_Lists.Push (Outline1, Create(End1.X, Y));
         Line_Lists.Unshift(Outline2, Create(End2.X, Y));
      end if;
      if Outline1 = Outline2 then
         -- Debug("pushing outline");
         Add_Outline(Result, Outline1);
      else
         if White_To_Black then
            Line_Lists.Append(Outline2, Outline1);
            Replace_Outline(Ends, Outline1, Outline2);
         else
            Line_Lists.Append(Outline1, Outline2);
            Replace_Outline(Ends, Outline2, Outline1);
         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        : access Change_List; -- Remove from changes list.
      Y              : in Integer;         -- Vertical coordinate.
      Ends           : access End_List)    -- Append to ends list.
   is
      use type End_Lists.Item_Access;
      X       : Integer := Current(Changes);
      E       : End_Record;
      Outline : Outline_Access;
   begin
      Remove_Current(Changes);
      if X /= Current(Ends).X then
         if White_To_Black then
            -- Debug("appending white to black");
            Outline := Current(Ends).Outline;
            Line_Lists.Unshift(Outline, Create(Current(Ends).X, Y));
            Line_Lists.Unshift(Outline, Create(X, Y));
         else
            -- Debug("appending black to white");
            Outline := Current(Ends).Outline;
            Line_Lists.Push(Outline, Create(Current(Ends).X, Y));
            Line_Lists.Push(Outline, Create(X, Y));
         end if;
         Current_Item(Ends).Content.X := X;
      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 : access Change_List; -- Read this line of changes.
      Y       : in Integer;         -- Vertical coordinate of this line.
      Ends    : access End_List;    -- The open ends from previous lines.
      Result  : access Glyph)       -- Add lines to this glyph.
   is
      White_To_Black : Boolean := True;