Hosted by
 |
with Ada.Text_IO; use Ada.Text_IO;
with Parsers; use Parsers;
with Messages; use Messages;
with Real_Strings; use Real_Strings;
with Real_Vectors; use Real_Vectors;
with Lines; use Lines;
with Outlines; use Outlines;
with Glyphs; use Glyphs;
package body EPS is
function Read
(This : in Parser)
return Outline is
begin
return Read(This);
end Read;
function Read
(From : in Parser)
return Glyph
is
Result : Glyph := Create("");
begin
while Next_Line(From) loop
exit when not Found(From, "%");
Debug(Rest_Of_Line(From));
end loop;
return Result;
end Read;
function Read
(Filename : in String)
return Glyph
is
From : Parser;
Result : Glyph;
begin
From := Open(Filename);
Result := Read(From);
Close(From);
return Result;
end Read;
function Read
return Glyph is
begin
return Read(Current_Input);
end Read;
procedure Write
(This : in Outline;
File : in File_Type;
Debug : in Boolean := False)
is
use Outlines.Line_Lists;
begin
Put_Line(File, Postscript(Last(This).To) & " moveto");
Reset(This);
while Line_Lists.Next(This) loop
Put_Line(File, Postscript(Current(This)));
if Debug then
Put_Line(File, Postscript(Current(This).To - (2.0, 2.0)) & " 4 4 rectfill");
end if;
end loop;
end Write;
procedure Write
(This : in Glyph;
File : in File_Type;
Debug : in Boolean := False)
is
use Glyphs.Outline_Lists;
Outlines : Outline_List;
Current_Outline : Outline;
Bounds : Box := Get_Bounds(This);
begin
Put_Line(File, "%!PS-Adobe-2.0 EPSF-2.0");
Put_Line(File, "%%BoundingBox: " &
Postscript(Get_Bottom_Left(Bounds)) & " " &
Postscript(Get_Top_Right(Bounds)));
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
Current_Outline := Current(Outlines);
Write(Current_Outline, File, Debug);
end loop;
Put_Line(File, "0 0 0 setrgbcolor");
if Debug
then Put_Line(File, "stroke");
else Put_Line(File, "fill");
end if;
end Write;
procedure Write
(This : in Glyph;
Filename : in String;
Debug : in Boolean := False)
is
File : File_Type;
begin
Create(File, Out_File, Filename);
Write(This, File, Debug);
Close(File);
end Write;
procedure Write
(This : in Glyph;
Debug : in Boolean := False) is
begin
Write(This, Current_Output, Debug);
end Write;
end EPS;
|