glyphs-eps
glyphs-eps.ads
glyphs-eps.adb
eps
glyphs-eps
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/02/02 08:56:22 $
-- $Revision: 1.16 $
-- $Author: jcrocholl $

with Ada.Text_IO; use Ada.Text_IO;

with Readers; use Readers;
with Token_Readers; use Token_Readers;
with Line_Readers; use Line_Readers;

with Real_Vectors; use Real_Vectors;
with Real_Strings; use Real_Strings;
with Integer_Strings; use Integer_Strings;

with Lines; use Lines;
with Outlines; use Outlines;
with Glyphs; use Glyphs;

package body EPS is

   function Read_Real
     (From : access Line_Reader)
     return Real
   is
      Word   : String := Read_Word(From);
      Result : Real;
   begin
      -- if Word = "" then Error(From, "expected number"); end if;
      Result := To_Number(Word);
      Skip_Whitespace(From);
      return Result;
   end Read_Real;

   -- Read an outline from a file.
   function Read_Outline
     (From : access Line_Reader) -- Read from this line reader.
     return Outline_Access       -- The newly created glyph.
   is
      XS, YS : Real;
      X1, Y1 : Real;
      X2, Y2 : Real;
      X3, Y3 : Real;
      XE, YE : Real;
      Result : Outline_Access := Create;
   begin
      XS := Read_Real(From);
      YS := Read_Real(From);
      XE := XS;
      YE := YS;

      if not Found(From, "moveto") then
         Error(From, "expected moveto");
      end if;

      while not End_Of_File(From) loop
         Read_Token(From);
         exit when Found(From, "fill");
         X1 := Read_Real(From); Y1 := Read_Real(From);
         if Found(From, "moveto") then
            if XS /= XE or YS /= YE then
               Error(From, "previous outline not closed");
            end if;
            exit;
         elsif Found(From, "lineto") then
            Add_Straight(Result, (X1, Y1));
            XE := X1; YE := Y1;
         else
            X2 := Read_Real(From); Y2 := Read_Real(From);
            X3 := Read_Real(From); Y3 := Read_Real(From);
            if Found(From, "curveto") then
               Add_Cubic(Result, (X1, Y1), (X2, Y2), (X3, Y3));
               XE := X3; YE := Y3;
            else
               Error(From, "expected curveto");
            end if;
         end if;
      end loop;

      return Result;
   end Read_Outline;

   -- Read a glyph from a file.
   function Read
     (From : access Line_Reader) -- Read from this line reader.
     return Glyph_Access         -- The newly created glyph.
   is
      Result : Glyph_Access;
      Left   : Real;
      Bottom : Real;
      Right  : Real;
      Top    : Real;

      procedure Find_Comment
        (Name : in String) is
      begin
         loop
            if not Next_Line(From) or else not Found(From, '%') then
               Error(From, "could not find %%" & Name);
            end if;
            Read_Token(From);
            exit when Found(From, "%%" & Name);
         end loop;
         Skip_Whitespace(From);
      end Find_Comment;

   begin
      Result := Create;

      Find_Comment("BoundingBox:");
      Left := Read_Real(From);
      Bottom := Read_Real(From);
      Right := Read_Real(From);
      Top := Read_Real(From);
      if not End_Of_Line(From) then
         Error(From, "no text permitted after bounding box");
      end if;
      Set_Bounds(Result, Left, Bottom, Right, Top);

      Find_Comment("EndComments");
      if not Next_Line(From) then Error(From, "expect at least one outline"); end if;
      loop
         Add_Outline(Result, Read_Outline(From));
         exit when Found(From, "fill");
         exit when Found(From, "stroke");
      end loop;

      return Result;
   end Read;

   -- Read a glyph from a file.
   function Read
     (Filename : in String) -- Read from this file.
     return Glyph_Access    -- The newly created glyph.
   is
      From   : Line_Reader_Access;
      Result : Glyph_Access;
   begin
      From := Open(Filename);
      Result := Read(From);
      Close(From);
      return Result;
   end Read;

   -- Read a glyph from current input.
   function Read
     return Glyph_Access is -- The newly created glyph.
   begin
      return Read(Current_Input);
   end Read;

   -- Write an outline to a file.
   procedure Write
     (This      : access Outline;      -- Write this outline.
      File      : in File_Type;        -- Write to this file.
      Tolerance : in Real;             -- Tolerance level.
      Debug     : in Boolean := False) -- Add red boxes?
   is
      use Outlines.Line_Lists;
   begin
      Put_Line(File, To_String(Last(This).To, Tolerance) & " moveto");
      Reset(This);
      while Line_Lists.Next(This) loop
         Put_Line(File, To_Postscript(Current(This), Tolerance));
         if Debug then
            Put_Line(File,
              To_String(Current(This).To - (2.0, 2.0), Tolerance) &
              " 4 4 rectfill");
         end if;
      end loop;
   end Write;

   -- Write a glyph to a file.
   procedure Write
     (This      : access Glyph;        -- Write this glyph.
      File      : in File_Type;        -- Write to this file.
      Tolerance : in Real;             -- Tolerance level.
      Debug     : in Boolean := False) -- Add red boxes?
   is
      use Glyphs.Outline_Lists;
      Outlines : Outline_List_Access;
      Outline  : Outline_Access;
      Bounds   : Rectangle := Get_Bounds(This);
   begin
      Put_Line(File, "%!PS-Adobe-2.0 EPSF-2.0");
      -- Put_Line(File, "%%Creator: roemer");
      -- Put_Line(File, "%%Pages: 1");
      -- Put_Line(File, "%%Name: " & Get_Name(This));
      Put_Line(File, "%%BoundingBox: " &
        To_String(Smaller_Or_Equal(Bounds.Left)) & " " &
        To_String(Smaller_Or_Equal(Bounds.Bottom)) & " " &
        To_String(Greater_Or_Equal(Bounds.Right)) & " " &
        To_String(Greater_Or_Equal(Bounds.Top)));
      Put_Line(File, "%%EndComments");

      if Debug then
         Put_Line(File, "1 0 0 setrgbcolor");
      end if;
      Outlines := Get_Outlines(This);
      Reset(Outlines);
      while Next(Outlines) loop
         Outline := Current(Outlines);
         Write(Outline, File, Tolerance, Debug);
      end loop;
      if Debug then
         Put_Line(File, "0 0 0 setrgbcolor");
         Put_Line(File, "stroke");
      else
         Put_Line(File, "fill");
      end if;
      Put_Line(File, "showpage");
   end Write;

   -- Write a glyph to a file.
   procedure Write
     (This      : access Glyph;        -- Write this glyph.
      Filename  : in String;           -- Write to this file.
      Tolerance : in Real;             -- Tolerance level.
      Debug     : in Boolean := False) -- Add red boxes?
   is
      File : File_Type;
   begin
      Create(File, Out_File, Filename);
      Write(This, File, Tolerance, Debug);
      Close(File);
   end Write;

   -- Write a glyph to current output.
   procedure Write
     (This      : access Glyph;           -- Write this glyph.
      Tolerance : in Real;                -- Tolerance level.
      Debug     : in Boolean := False) is -- Add red boxes?
   begin
      Write(This, Current_Output, Tolerance, Debug);
   end Write;

end EPS;