|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: T f
Length: 26888 (0x6908)
Types: TextFile
Names: »fig2ps.p«
└─⟦060c9c824⟧ Bits:30007080 DKUUG TeX 2/12/89
└─⟦this⟧ »./tex82/TeXgraphics/transfig/fig2ps/fig2ps.p«
program fig2ps (input, output);
{ Author: Igor Metz <metz@iam.unibe.ch> }
{ Created: Thu Jan 7 16:11:38 1988 }
{ Filename: /usr/u-gina/metz/work/fig2ps/fig2ps.p }
{ This program translates files, that were created with FIG 1.3.1, to
PostScript. The PostScript code generated can be incorporated into TeX
with psfig.
Current version: 1.13
Revision History:
Feb., 09. 88: (Igor Metz)
- in procedure read_object the linewidth and lineheight were read in
reversed order (for arcs). Same error below!!
- Reported by Andreas Ueltschi: the procedure calc_tangent calculated
wrong coordinates!
Feb., 08. 88: (Igor Metz)
- in procedure read_object the linewidth and lineheight were read in
reverse order (for lines and splines)!
Feb., 03. 88: (Igor Metz)
- the procedure write_string now prefixes '(' and ')' with a backslash
to prevent troubles, when strings to be printed contain '(' or ')'.
Jan., 27. 88: (Igor Metz)
- support for spline has been added.
Jan., 27. 88: (Igor Metz)
- the adaptation of linewidths for ellipses was a bit strange. The new
method is to save the CTM before scaling, and to restore be CTM before
stroking.
- the drawing had to be shifted to the left on the page, since printers
can't print on the entire page.
Jan., 26. 88: (Igor Metz)
- for dashed lines and arcs the arrow head was also dashed: bug is
fixed.
- the position of the drawing on the page has been corrected.
- the linewidth for ellipses and circles had to be adapted, since
we scale the coordinate system when we print them.
Feb. 18 88: (Micah Beck)
- increased resolution of spline rendering for 300 BPI printing.
the code taken from Fig assumes 80 BPI.
- fixed a bug in closed splines: there was no initial moveto command
Feb. 23 88: (Micah Beck)
- scale the figure by 72/pixels_per_inch to get correct size
- translate lower left corner of figure to PS origin
}
const
{ the following generic object codes are taken from fig/object.h }
ELLIPSE = 1;
POLYLINE = 2;
SPLINE = 3;
TEXT = 4;
ARC = 5;
COMPOUND = 6;
END_COMPOUND = -COMPOUND;
{ the following definitions are taken from fig/choices.h. They define }
{ the values the object component 'typ' can have. }
DRAW_ELLIPSE_BY_RAD = 1;
DRAW_ELLIPSE_BY_DIA = 2;
DRAW_CIRCLE_BY_RAD = 3;
DRAW_CIRCLE_BY_DIA = 4;
DRAW_CIRCULAR_ARC = 5;
DRAW_POLYLINE = 6;
DRAW_BOX = 7;
DRAW_POLYGON = 8;
DRAW_TEXT = 9;
DRAW_SPLINE = 10;
DRAW_CLOSEDSPLINE = 11;
DRAW_COMPOUND = 13;
SOLID_LINE = 0;
DASH_LINE = 1;
DOTTED_LINE = 2; { not use by FIG 1.3.1 }
MaxTextLength = 256; { max. length of texts in Fig-file (assumed!) }
pi = 3.141592654;
TOP_LEFT_Y = 820; { used for coordinate transformation FIG <-> PostScript }
TOP_LEFT_X = 10;
type
objtype = (ellipse, polyline, spline, txt, arc, compound, end_compound);
pPoint = ^tPoint;
tPoint = record
x,y : integer;
next: pPoint
end; {record}
tPosition = record x,y : integer end;
tEllipse = record
typ, style : integer;
thickness : integer;
dash_length : real;
direction : integer;
center,
radiuses,
start,
ending : tPosition;
end; {record}
tPolyline = record
typ, style : integer;
thickness : integer;
dash_length : real;
f_arrow : integer;
b_arrow : integer;
arrow_width,
arrow_height: integer;
start : pPoint;
end; {record}
tSpline = record
typ, style : integer;
thickness : integer;
dash_length : real;
f_arrow : integer;
b_arrow : integer;
arrow_width,
arrow_height: integer;
start : pPoint;
end; {record}
tText = record
font,
size,
style : integer;
height : integer;
length : integer;
corner : tPosition;
chars : packed array [1..MaxTextLength] of char;
end; {record}
tArc = record
typ, style : integer;
thickness : integer;
dash_length : real;
direction : integer;
f_arrow : integer;
b_arrow : integer;
arrow_width,
arrow_height: integer;
center_x,
center_y : real;
pos : array [1..3] of tPosition;
end; {record}
pObject = ^tObject;
tObject = record
next : pObject;
case objname : objtype of
ellipse : (ell : tEllipse);
polyline : (poly: tPolyline);
spline : (spl : tSpline);
txt : (tex : tText);
arc : (arq : tArc);
end;
var
filename : packed array[1..128] of char;
Objects : pObject; { list of objects found in the Fig-file }
{ the following 4 variables are in the Fig-file's header. They have }
{ always the same values, so we could define them as constants. }
pixels_per_inch : integer; { always = 80 }
origin : integer; { always = ? }
canvas_width, canvas_height : integer; { always = 600 and = 800 }
{ coordinates that determine the bounding box of a drawing }
llx, lly, urx, ury : real;
procedure read_string (var str : array [lb .. ub : integer] of char);
{ read all charcters from current position to end of line. Trailing }
{ blanks are also read, since they could be part of the string. }
var
i : integer;
ch : char;
begin
i:= lb;
read(ch); { the first character is always blank! skip it }
while not eoln(input) do begin
read( str[i]);
i:= i+1;
end {while};
str[i]:= chr(0); { terminate string with null character }
end { read_string };
procedure write_string (str : array [lb .. ub : integer] of char);
{ write all characters in str }
var
i : integer;
begin
i:= lb;
while str[i] <> chr(0) do begin
if (str[i]='(') or (str[i]=')') then write('\');
write(str[i]);
i:= i+1;
end {while};
end { write_string };
function min (a, b : real) : real;
begin
if a < b then min:= a else min:= b;
end { min };
function max (a,b : real) : real;
begin
if a < b then max:= b else max:= a;
end { max };
procedure read_file( var Objects : pObject);
{ read in the Fig-file from input, and build up a list of all object in }
{ the file. While reading keep track of the bounding box. }
var
obj_code : integer;
Object : pObject;
procedure read_object (obj : objtype; var Object : pObject);
{ read in the object 'obj' and store it's data in 'Object' }
var
tmp : integer;
procedure read_points (var point : pPoint);
{ read in all points (coordinate pairs). The end is marked by the }
{ (9999,9999). }
var
last : pPoint; { points to last point in the list }
aux : pPoint; { auxiliary }
x_tmp, y_tmp : integer;
begin
last:= point;
while not eoln(input) do begin
read(x_tmp, y_tmp);
if (x_tmp <> 9999) and (y_tmp <> 9999) then begin
new(aux); { create new node }
with aux^ do begin
next:= nil;
x:= x_tmp; y:= y_tmp;
end {with};
if last=nil then begin
{ the list is empty, aux becomes first node }
point:= aux;
last:= aux;
end
else begin
{ append aux at end of list }
last^.next:= aux;
last:= aux;
end { if };
end { if };
end {while};
end { read_points };
begin
new(Object);
with Object^ do begin
next:= nil;
objname:= obj;
case obj of
ellipse : with ell do begin
read(typ, style,thickness,dash_length,direction);
read(center.x, center.y);
read(radiuses.x , radiuses.y);
read(start.x, start.y);
read(ending.x, ending.y);
end {with};
polyline : with poly do begin
read(typ, style, thickness, dash_length);
read(f_arrow, b_arrow, arrow_height,arrow_width);
read_points(start);
end {with};
spline : with spl do begin
read(typ, style, thickness, dash_length);
read(f_arrow, b_arrow, arrow_height,arrow_width);
read_points(start);
end {with};
txt : with tex do begin
read(font, size, style, height, length);
read(corner.x, corner.y);
read_string(chars);
end {with};
arc : with arq do begin
read(typ, style, thickness, dash_length, direction);
read(f_arrow, b_arrow, arrow_height, arrow_width);
read(center_x, center_y);
read(pos[1].x, pos[1].y);
read(pos[2].x, pos[2].y);
read(pos[3].x, pos[3].y);
end {with};
compound : read(tmp, tmp, tmp, tmp); { we ignore this info }
end_compound : { do nothing }
end {case};
readln; { skip end-of-line character }
end {with};
if (obj=compound) or (obj=end_compound) then begin
{ since we ignore compounds, we can throw away this node }
dispose(Object);
Object:= nil;
end { if };
end { read_object };
procedure insert_object (Object : pObject; var Objects : pObject);
{ insert the new 'Object' into the list of 'Objects'. The new object }
{ is inserted at the front of the list. }
var
aux : pObject;
begin
if Object <> nil then begin
aux:= Objects;
Objects:= Object;
Object^.next:= aux;
end { if };
end { insert_object };
begin
Objects:= nil;
{ first read in the fileheader. }
readln( pixels_per_inch, origin, canvas_width, canvas_height );
while not eof(input) do begin
read(obj_code);
case obj_code of
ELLIPSE : read_object(ellipse, Object);
POLYLINE : read_object(polyline, Object);
SPLINE : read_object(spline, Object);
TEXT : read_object(txt, Object);
ARC : read_object(arc, Object);
COMPOUND : read_object(compound, Object);
END_COMPOUND : read_object(end_compound, Object);
end {case};
insert_object(Object, Objects);
end; {while}
end; {read_line}
procedure compute_bbox (Objects : pObject; var llx, lly, urx, ury : real);
{ compute the bounding box that surrounds the objects. }
{ If we want to compute the bounding box, we must never forget the following }
{ facts: }
{ Fig's coordinate system is : PostScript's (default) coordinate system is:}
{ (0,0) -------> (x,0) (0,y) ---------> (x,y)}
{ | | ^ ^ }
{ V V | | }
{ (0,y) -------> (x,y) (0,0) ---------> (x,0) }
var
p : pObject;
lx, ly, ux, uy : real;
tmp : real;
procedure bbox (Object : pObject; var llx, lly, urx, ury : real);
{ compute the bounding box of a single object }
var
p : pPoint;
delta : real;
begin
with Object^ do begin
case objname of
ellipse : with ell do begin
llx:= center.x - radiuses.x;
lly:= center.y - radiuses.y;
urx:= center.x + radiuses.x;
ury:= center.y + radiuses.y;
end {with};
polyline : with poly do begin
llx:= maxint; lly:= maxint;
urx:= minint; ury:= minint;
p:= start;
while p <> nil do begin
llx:= min(llx, p^.x); lly:= min(lly, p^.y);
urx:= max(urx, p^.x); ury:= max(ury, p^.y);
p:= p^.next;
end {while};
{ do not forget the arrow heads !}
delta:= 0.5*arrow_width;
llx:= llx - delta; lly:= lly - delta;
urx:= urx + delta; ury:= ury + delta;
end {with};
spline : with spl do begin
{ the same as for polyline }
llx:= maxint; lly:= maxint;
urx:= minint; ury:= minint;
p:= start;
while p <> nil do begin
llx:= min(llx, p^.x); lly:= min(lly, p^.y);
urx:= max(urx, p^.x); ury:= max(ury, p^.y);
p:= p^.next;
end {while};
{ do not forget the arrow heads !}
delta:= 0.5*arrow_width;
llx:= llx - delta; lly:= lly - delta;
urx:= urx + delta; ury:= ury + delta;
end {with};
txt : with tex do begin
llx:= corner.x;
lly:= corner.y - height;
urx:= corner.x + length;
ury:= corner.y;
end {with};
arc : with arq do begin
delta:= 0.5*arrow_width;
llx:= min(min(pos[1].x, pos[2].x), pos[3].x) - delta;
lly:= min(min(pos[1].y, pos[2].y), pos[3].y) - delta;
urx:= max(max(pos[1].x, pos[2].x), pos[3].x) + delta;
ury:= max(max(pos[1].y, pos[2].y), pos[3].y) + delta;
end {with};
otherwise { do nothing }
end {case};
end {with};
end { bbox };
begin
p:= Objects;
llx:= maxint; lly:= maxint;
urx:= minint; ury:= minint;
while p <> nil do begin
bbox(p, lx, ly, ux, uy);
llx:= min(llx, lx); lly:= min(lly, ly);
urx:= max(urx, ux); ury:= max(ury, uy);
p:= p^.next;
end {while};
{ now we transform from FIG coordinates to PostScript (default) coordinates}
tmp:= lly;
llx:= llx + TOP_LEFT_X;
lly:= TOP_LEFT_Y - ury;
urx:= urx + TOP_LEFT_X;
ury:= TOP_LEFT_Y - tmp;
end { compute_bbox };
procedure generate_postscript (Objects : pObject;
llx, lly, urx, ury : real);
{ Generate PostScript Code for the list of Objects. }
var
p : pObject;
current_dashlength : real;
current_thickness : integer;
procedure header;
{ Write header. }
begin
writeln('%!');
writeln('%%BoundingBox: 0 0 ',
((urx-llx) * 72/pixels_per_inch):6:4, ' ',
((ury-lly) * 72/pixels_per_inch):6:4);
{ the following text must be the same as in ./header.ps !!!! }
writeln('gsave');
writeln('/fig2psdict 20 dict def');
writeln('fig2psdict begin');
writeln('72 ', pixels_per_inch:6:0, ' div dup scale');
writeln(TOP_LEFT_X,TOP_LEFT_Y, ' translate');
writeln(-llx:6:0, -lly:6:0, ' translate');
writeln('/mtrx matrix currentmatrix def');
writeln('180 rotate');
writeln('[-1 0 0 1 0 0] concat');
writeln('/arrowhead');
writeln(' { /headlength exch def');
writeln(' /halfheadheight exch 2 div def');
writeln(' /tipy exch def');
writeln(' /tipx exch def');
writeln(' /taily exch def');
writeln(' /tailx exch def');
writeln(' /angle tipy taily sub tipx tailx sub atan def');
writeln(' /savematrix matrix currentmatrix def');
writeln(' tipx tipy translate');
writeln(' angle 90 add rotate');
writeln(' halfheadheight headlength moveto');
writeln(' 0 0 lineto');
writeln(' halfheadheight neg headlength lineto');
writeln(' savematrix setmatrix');
writeln('} def');
writeln('/printtext ');
writeln(' { /txt exch def');
writeln(' /width exch def');
writeln(' /height exch def');
writeln(' /y exch def');
writeln(' /x exch def');
writeln(' gsave');
writeln(' /Courier findfont height scalefont setfont');
writeln(' /Courier findfont ');
writeln(' [ width txt stringwidth pop div height mul 0 0 height 0 0] makefont');
writeln(' setfont');
writeln(' x y moveto');
writeln(' mtrx setmatrix');
writeln(' txt show');
writeln(' grestore');
writeln('} def');
writeln;
end { header };
procedure generate (Object : pObject);
{ Generate PostScript Code for a single Object. }
var
p, { points to actual point }
q, { points to last point }
r : pPoint; { points to before last point }
x0, y0 : integer; { point of contact of arc and tangent }
x, y : real; { point on tangent }
radius : real; { of an arc }
procedure calc_tangent (var x,y : real; { point on tangent }
x0, y0 : integer; { point of contact }
xc, yc : real; { center of arc }
x2, y2 : integer); { point on arc }
{ calculates a point (x,y) on the tangent which touches the arc in }
{ point (x0,y0). }
var
l : real; { length of direction vector }
xn, yn : real; { components of direction vector }
s : real; { scalar product }
dx, dy : real;
begin
dx:= (x0-xc); dy:= - (y0-yc);
l:= sqrt(dx*dx + dy*dy);
xn:= dy / l;
yn:= dx / l;
s:= (x2-x0)*xn + (y2-y0)*yn;
x:= s*xn + x0;
y:= s*yn + y0;
end { calc_tangent };
procedure chaikin_spline (x1, y1, x2, y2, x3, y3, x4, y4 : real);
{ The following spline drawing routine is from
"An Algorithm for High-Speed Curve Generation"
by George Merrill Chaikin,
Computer Graphics and Image Processing, 3, Academic Press,
1974, 346-349.
and
"On Chaikin's Algorithm" by R. F. Riesenfeld,
Computer Graphics and Image Processing, 4, Academic Press,
1975, 304-310.
but I took it from fig/splsub.c
}
var
xmid, ymid : real;
begin
xmid := (x2 + x3) * 0.5; ymid := (y2 + y3) * 0.5;
if (abs(x1 - xmid) < 1) and (abs(y1 - ymid) < 1) then begin
writeln(xmid:6:4, ' ', ymid:6:4, ' lineto');
end
else begin
chaikin_spline(x1, y1, ((x1 + x2) * 0.5), ((y1 + y2) * 0.5),
((3.0*x2 + x3) * 0.25), ((3.0*y2 + y3) * 0.25),
xmid, ymid);
end; {if}
if (abs(xmid - x4) < 1) and (abs(ymid - y4) < 1) then begin
writeln(x4:6:4, ' ', y4:6:4, ' lineto');
end
else begin
chaikin_spline(xmid, ymid,
((x2 + 3*x3) / 4), ((y2 + 3*y3) / 4),
((x3 + x4) / 2), ((y3 + y4) / 2), x4, y4);
end { if };
end { chaikin_spline };
procedure draw_openspline (spl : tSpline);
var
cx1, cy1, cx2, cy2, cx3, cy3, cx4, cy4 : real;
x1, y1, x2, y2 : real;
p : pPoint;
begin
with spl do begin
p:= start;
if current_thickness <> thickness then begin
writeln(thickness, ' setlinewidth');
current_thickness:= thickness;
end { if };
x1 := p^.x; y1 := p^.y;
p := p^.next;
x2 := p^.x; y2 := p^.y;
cx1 := (x1 + x2) * 0.5; cy1 := (y1 + y2) * 0.5;
cx2 := (x1 + 3 * x2) * 0.25; cy2 := (y1 + 3 * y2) * 0.25;
if b_arrow = 1 then begin
{ generate backward arrow }
writeln('newpath');
writeln(x2:6:4, ' ', y2:6:4, ' ', x1:6:4, ' ', y1:6:4, ' ',
arrow_width, arrow_height, ' arrowhead');
writeln('stroke');
end { if };
writeln('newpath');
if style <> SOLID_LINE then begin
writeln('[3] 0 setdash');
end { if };
writeln(x1:6:4, ' ', y1:6:4, ' moveto');
writeln(cx1:6:4, ' ', cy1:6:4, ' lineto');
p:= p^.next;
while p <> nil do begin
x1 := x2; y1 := y2;
x2 := p^.x; y2 := p^.y;
cx3 := (3 * x1 + x2) * 0.25; cy3 := (3 * y1 + y2) * 0.25;
cx4 := (x1 + x2) * 0.5; cy4 := (y1 + y2) * 0.5;
chaikin_spline(cx1, cy1, cx2, cy2, cx3, cy3, cx4, cy4);
cx1 := cx4; cy1 := cy4;
cx2 := (x1 + 3 * x2) * 0.25; cy2 := (y1 + 3 * y2) * 0.25;
p:= p^.next;
end {while};
writeln(cx1:6:4, ' ', cy1:6:4, ' moveto');
writeln(x2:6:4, ' ', y2:6:4, ' lineto');
writeln(' stroke');
if style <> SOLID_LINE then begin
writeln('[] 0 setdash');
end { if };
if f_arrow = 1 then begin
{ forward arrow }
writeln('newpath');
writeln(x1:6:4, ' ', y1:6:4, ' ', x2:6:4, ' ', y2:6:4, ' ',
arrow_width, arrow_height, ' arrowhead');
writeln('stroke');
end { if };
end {with};
end { draw_openspline };
procedure draw_closedspline (spl : tSpline);
var
cx1, cy1, cx2, cy2, cx3, cy3, cx4, cy4 : real;
x1, y1, x2, y2 : real;
p : pPoint;
begin
with spl do begin
writeln('newpath');
if style <> SOLID_LINE then begin
writeln('[3] 0 setdash');
end { if };
p:= start;
x1 := p^.x; y1 := p^.y;
p := p^.next;
x2 := p^.x; y2 := p^.y;
cx1 := (x1 + x2) * 0.5; cy1 := (y1 + y2) * 0.5;
cx2 := (x1 + 3 * x2) * 0.25; cy2 := (y1 + 3 * y2) * 0.25;
writeln(cx1:6:4, ' ', cy1:6:4, ' moveto');
p:= p^.next;
while p <> nil do begin
x1 := x2; y1 := y2;
x2 := p^.x; y2 := p^.y;
cx3 := (3 * x1 + x2) * 0.25; cy3 := (3 * y1 + y2) * 0.25;
cx4 := (x1 + x2) * 0.5; cy4 := (y1 + y2) * 0.5;
chaikin_spline(cx1, cy1, cx2, cy2, cx3, cy3, cx4, cy4);
cx1 := cx4; cy1 := cy4;
cx2 := (x1 + 3 * x2) * 0.25; cy2 := (y1 + 3 * y2) * 0.25;
p:= p^.next;
end {while};
x1 := x2; y1 := y2;
p := start^.next;
x2 := p^.x; y2 := p^.y;
cx3 := (3 * x1 + x2) * 0.25; cy3 := (3 * y1 + y2) * 0.25;
cx4 := (x1 + x2) * 0.5; cy4 := (y1 + y2) * 0.5;
chaikin_spline(cx1, cy1, cx2, cy2, cx3, cy3, cx4, cy4);
writeln(' stroke');
if style <> SOLID_LINE then begin
writeln('[] 0 setdash');
end { if };
end {with};
end { draw_closedspline };
begin
with Object^ do begin
case objname of
ellipse : with ell do begin
writeln('gsave');
if current_thickness <> thickness then begin
writeln(thickness, ' setlinewidth');
current_thickness:= thickness;
end { if };
if style <> SOLID_LINE then begin
writeln('[3] 0 setdash');
end { if };
writeln('newpath');
writeln('/savematrix matrix currentmatrix def');
writeln(center.x, center.y,' translate');
writeln(radiuses.x, radiuses.y, ' scale');
writeln('0 0 1 0 360 arc');
writeln('savematrix setmatrix');
writeln('stroke');
writeln('grestore');
if style <> SOLID_LINE then begin
writeln('[] 0 setdash');
end { if };
end {with};
polyline : with poly do begin
if current_thickness <> thickness then begin
writeln(thickness, ' setlinewidth');
current_thickness:= thickness;
end { if };
p:= start;
q:= nil;
r:= nil;
if (b_arrow = 1) then begin
{ generate backward arrow }
if p <> nil then begin
{ at least 2 points available }
q:= p^.next;
writeln('newpath');
writeln(q^.x, q^.y, p^.x, p^.y, arrow_width,
arrow_height, ' arrowhead');
writeln('stroke');
end
else begin
{ line consists of only 1 point ! }
message('warning: line with only 1 point!');
end { if };
end { if };
writeln('newpath');
if style <> SOLID_LINE then begin
writeln('[3] 0 setdash');
end { if };
writeln(p^.x, p^.y,' moveto');
q:= p;
p:= p^.next;
while p <> nil do begin
writeln(p^.x, p^.y,' lineto');
r:= q;
q:= p;
p:= p^.next;
end {while};
writeln('stroke');
if style <> SOLID_LINE then begin
writeln('[] 0 setdash');
end { if };
if f_arrow = 1 then begin
{ forward arrow }
writeln('newpath');
writeln(r^.x, r^.y, q^.x, q^.y, arrow_width,
arrow_height, ' arrowhead');
writeln('stroke');
end { if };
end {with};
spline : begin
if spl.typ = DRAW_SPLINE then begin
draw_openspline(spl);
end
else begin
draw_closedspline(spl);
end { if };
end {begin};
txt : with tex do begin
write(corner.x, corner.y, height, length, ' (');
write_string(chars);
writeln(') printtext');
end {with};
arc : with arq do begin
if current_thickness <> thickness then begin
writeln(thickness, ' setlinewidth');
current_thickness:= thickness;
end { if };
if style <> SOLID_LINE then begin
writeln('[3] 0 setdash');
end { if };
writeln('newpath');
radius:= sqrt((pos[1].x -center_x)*(pos[1].x- center_x)+
(pos[1].y -center_y)*(pos[1].y- center_y));
if direction=0 then begin
{clockwise}
writeln(pos[1].x, pos[1].y, ' moveto');
writeln(center_x:6:4, ' ', center_y:6:4, ' ',
radius:6:4, ' ',
(pos[1].y - center_y):6:4, ' ',
(pos[1].x - center_x):6:4, ' atan ',
(pos[3].y - center_y):6:4, ' ',
(pos[3].x - center_x):6:4, ' atan arc');
end
else begin
{counter clockwise}
writeln(pos[3].x, pos[3].y, ' moveto');
writeln(center_x:6:4, ' ', center_y:6:4, ' ',
radius:6:4, ' ',
(pos[3].y - center_y):6:4, ' ',
(pos[3].x - center_x):6:4, ' atan ',
(pos[1].y - center_y):6:4, ' ',
(pos[1].x - center_x):6:4, ' atan arc');
end { if };
if style <> SOLID_LINE then begin
writeln('[] 0 setdash');
end { if };
writeln('stroke');
if f_arrow=1 then begin
if direction=0 then begin
{clockwise}
x0:= pos[3].x;
y0:= pos[3].y;
end
else begin
{counter clockwise}
x0:= pos[1].x;
y0:= pos[1].y;
end { if };
calc_tangent(x, y, x0, y0, center_x, center_y,
pos[2].x, pos[2].y);
writeln('newpath');
writeln(x:6:4, ' ', y:6:4, x0, y0, arrow_width,
arrow_height, ' arrowhead');
writeln('stroke');
end { if };
if b_arrow=1 then begin
if direction=0 then begin
{clockwise}
x0:= pos[1].x;
y0:= pos[1].y;
end
else begin
{counter clockwise}
x0:= pos[3].x;
y0:= pos[3].y;
end { if };
calc_tangent(x, y, x0, y0, center_x, center_y,
pos[2].x, pos[2].y);
writeln('newpath');
writeln(x:6:4,' ', y:6:4, x0, y0, arrow_width,
arrow_height, ' arrowhead');
writeln('stroke');
end { if };
end {with};
otherwise { do nothing }
end {case};
end {with};
end { generate };
procedure trailer;
{ Write Trailer. }
begin
writeln('showpage');
writeln('end % fig2psdict');
writeln('grestore');
end { trailer };
begin
p:= Objects;
current_dashlength:= maxint;
current_thickness:= maxint;
header;
while p <> nil do begin
generate(p);
p:= p^.next;
end {while};
trailer;
end { generate_postscript };
begin {fig2ps}
if argc <> 2 then
message('usage: fig2ps filename > filename')
else begin
{ get the filename, and open the file for reading }
argv(1,filename);
reset(input, filename);
read_file(Objects);
compute_bbox(Objects, llx, lly, urx, ury);
generate_postscript(Objects, llx, lly, urx, ury);
end; {if}
end. {fig2ps}