procedure tylBrokenLine (x0, y0, x1, y1, fontindex : integer;
line_type: LineStyle);
label 10;
var useXaxis: boolean;
a0, b0, a1, b1: integer;
a2, a3, b2, b3, K, gap, dot, dash: integer;
s, z, fit: real;
J, frame, T: integer;
Dotgap, Dotdot: integer;
Dashgap, Dashdash: integer;
DDotgap, DDotdot, DDotdash: integer;
a1ma0 : integer;
{.........................................................}
procedure spread (lt : LineStyle; extra, T : integer);
label 20;
begin
if (T = 0) then
begin { only partial frame fits }
if (useXaxis) then
diagonal (a0, b0, a1, b1, fontindex)
else
diagonal (b0, a0, b1, a1, fontindex);
goto 20; { exit }
end;
J := 0;
s := float (b1 - b0)/float(a1 - a0);
z := float (extra)/float(T);
case lt of
dotted : repeat a2 := a0 + J*frame;
if (extra > 0) then a2 := a2 + round(J*z);
a3 := a2 + dot;
b2 := round(s*(a2-a0) + b0);
b3 := round(s*(a3-a0) + b0);
if (a3 <= a1) then
begin
if (useXaxis) then
diagonal (a2, b2, a3, b3, fontindex)
else
diagonal (b2, a2, b3, a3, fontindex);
end;
J := J + 1;
until (a3 >= a1);
dashed : repeat a2 := a0 + J*frame;
if (extra > 0) then a2 := a2 + round(J*z);
a3 := a2 + dash;
b2 := round(s*(a2-a0) + b0);
b3 := round(s*(a3-a0) + b0);
if (a3 <= a1) then
begin
if (useXaxis) then
diagonal (a2, b2, a3, b3, fontindex)
else
diagonal (b2, a2, b3, a3, fontindex);
end;
J := J + 1;
until (a3 >= a1);
dotdash : repeat a2 := a0 + J*frame;
if (extra > 0) then a2 := a2 + round(J*z);
a3 := a2 + dash;
b2 := round(s*(a2-a0) + b0);
b3 := round(s*(a3-a0) + b0);
if (a3 <= a1) then
begin
if (useXaxis) then
diagonal (a2, b2, a3, b3, fontindex)
else
diagonal (b2, a2, b3, a3, fontindex);
a2 := a3 + gap;
if (extra > 0) then a2 := a2 + round(z*0.5);
a3 := a2 + dot;
b2 := round(s*(a2-a0) + b0);
b3 := round(s*(a3-a0) + b0);
if (a3 <= a1) then
begin
if (useXaxis) then
diagonal (a2, b2, a3, b3, fontindex)
else
diagonal (b2, a2, b3, a3, fontindex);
end;
end;
J := J + 1;
until (a3 >= a1);
end;
20:
end; { spread }
{......................................................}
procedure balance (lt : LineStyle; extra, T : integer);
label 30;
begin
if (T = 0) then
begin { only partial frame fits }
if (useXaxis) then
diagonal (a0, b0, a1, b1, fontindex)
else
diagonal (b0, a0, b1, a1, fontindex);
goto 30; { exit }
end;
J := 0;
s := float(b1 - b0)/float(a1 - a0);
case lt of
dashed : repeat a2 := a0 + J*frame - extra div 2;
a3 := a2 + dash;
if (J = 0) then a2 := a0;
if (a3 > a1) then a3 := a1;
b2 := round(s*(a2-a0) + b0);
b3 := round(s*(a3-a0) + b0);
if (a3 <= a1) then
begin
if (useXaxis) then
diagonal (a2, b2, a3, b3, fontindex)
else
diagonal (b2, a2, b3, a3, fontindex);
end;
J := J + 1;
until (a3 >= a1);
dotdash : repeat a2 := a0 + J*frame - extra div 2;
a3 := a2 + dash;
if (J = 0) then a2 := a0;
if (a3 > a1) then a3 := a1;
b2 := round(s*(a2-a0) + b0);
b3 := round(s*(a3-a0) + b0);
if (a3 <= a1) then
begin
if (useXaxis) then
diagonal (a2, b2, a3, b3, fontindex)
else
diagonal (b2, a2, b3, a3, fontindex);
a2 := a3 + gap;
a3 := a2 + dot;
b2 := round(s*(a2-a0) + b0);
b3 := round(s*(a3-a0) + b0);
if (a3 <= a1) then
begin
if (useXaxis) then
diagonal (a2, b2, a3, b3, fontindex)
else
diagonal (b2, a2, b3, a3, fontindex);
end;
end;
J := J + 1;
until (a3 >= a1);
end;
30:
end; { balance }
{......................................................}
function project (I : integer) : integer;
var K : integer; { gives the projection of lengths onto axes }
begin
K := round(I*float(abs(a1-a0))/s);
if K = 0 then K := 1;
project := K;
end;
{......................................................}
procedure setlengths (findex :integer);
(* sets the "optimal" sizes for textured lines *)
var penrad : integer;
siz : VThickness;
begin
penrad := VFontTable[findex]^.PenSize;
siz := VFontTable[findex]^.psize;
Dotdot := penrad div siz; Dotgap := 6 * penrad;
Dashdash := 6 * penrad; Dashgap := 6 * penrad;
DDotdash := 6 * penrad; DDotgap := 4 * penrad;
DDotdot := penrad div siz;
end;
{........................................}
procedure setframesize;
begin
case line_type of { length of frame depends on type of broken line }
solid : frame := 0;
dotted : frame := gap + dot;
dashed : frame := gap + dash;
dotdash : frame := 2*gap + dot + dash;
end;
end;
{.................................................}
begin (* TylBrokenLine *)
if ((x0 = x1) and (y0 = y1)) then
begin
diagonal (x0, y0, x1, y1, fontindex); { null line }
goto 10;
end;
setlengths (fontindex);
if (abs (y1-y0) > abs(x1-x0)) then { longer axis is used as base }
begin
useXaxis := false;
a0 := y0; b0 := x0;
a1 := y1; b1 := x1;
end
else
begin
useXaxis := true;
a0 := x0; b0 := y0;
a1 := x1; b1 := y1;
end;
{ the distance between a0 and a1 is now greater than that between b0 and b1. }
{ redefine distances as integral units along axes }
s := distance (float(a0),float(b0),float(a1),float(b1));
case line_type of
solid: ;
dotted:
begin
gap := project(Dotgap);
dot := project(Dotdot);
end;
dashed:
begin
gap := project(Dashgap);
dash := project(Dashdash);
end;
dotdash:
begin
gap := project(DDotgap);
dot := project(DDotdot);
dash := project(DDotdash);
end;
end;
{ ensure direction of line is from smaller to
larger along the longer axis }
if (a0 > a1) then
begin
J := a0; a0 := a1; a1 := J;
J := b0; b0 := b1; b1 := J;
end;
setframesize;
a1ma0 := a1 - a0;
{ fit is the number of frames that fit in line }
if (frame <> 0) then
begin
fit := (float(a1ma0) / float(frame));
end
else
fit := 1.0;
if (fit >= 1.0) then
T := round (fit)
else
begin
(* change frame elements (dot, dash, gap) since frame is too large *)
case line_type of
dotted : begin
gap := gap - (frame - a1ma0);
if (gap < dot) then
begin
goto 10; (* exit *)
end;
setframesize;
end;
dashed,
dotdash : begin
(* idea:decrease gap; if too small then shrink dash and refigure gap*)
if ((frame - a1ma0) > (gap div 2)) then
begin
dash := round (dash * fit * 0.80);
gap := round (gap * fit);
setframesize;
end;
gap := gap - (frame - a1ma0);
if (line_type = dotdash) then
gap := gap div 2;
if (gap < dot) then
begin
goto 10; (* exit *)
end;
setframesize;
end;
end; (* case *)
T := 1; (* NOW it will fit *)
end; (* else *)
case line_type of
solid : begin
if (useXaxis) then
diagonal (a0, b0, a1, b1, fontindex)
else
diagonal (b0, a0, b1, a1, fontindex);
end;
dotted : begin { dotted lines begin and end on a dot }
if ((T*frame + dot) = a1ma0) then
spread(dotted, 0, T)
else if ((T*frame + dot) > a1ma0) then
begin
{ gap := gap - ((T*frame+dot)-a1ma0);
{}
spread(dotted, a1ma0 - T*frame - dot, T);
{ spread(dotted, a1ma0 - (T-1)*frame - dot, T-1);
{}
end
else
spread(dotted, a1ma0 - T*frame - dot, T);
end;
dashed : begin
{ dashed lines begin and end on dash :
the beginning and ending dashes are at least half
the dash length long. }
if ((T*frame + dash) = a1ma0) then
spread(dashed, 0, T)
else if ((T*frame + dash) > a1ma0) then
balance(dashed, T*frame + dash - a1ma0, T)
else spread(dashed, a1ma0 - T*frame - dash, T);
end;
dotdash : begin { if ending on a dash then beginning and ending
dashes are half the dash length long - final
dots are full dot length }
if ((T*frame + dash) = a1ma0) then
spread(dotdash, 0, T)
else if ((T*frame + dash + gap + dot) = a1ma0) then
spread(dotdash, 0, T)
else if ((T*frame + dash) > a1ma0) then
balance(dotdash, T*frame + dash - a1ma0, T)
else if ((T*frame + dash + gap + dot) > a1ma0) then
spread(dotdash, a1ma0 - T*frame - dash, T)
else spread(dotdash, a1ma0 - T*frame - dash - gap - dot, T);
end;
end;
10:
end;
{-------------------------------------------------------}
procedure clampthickness (var thic : VThickness);
begin
(* #### this is just a simple clamp
really should be something like:
while not (thic in set_of_appropriate_thicknesses) do
modify thic and try again
*)
if (thic <= LoVThick ) then
thic := LoVThick + 1;
while ((not (thic in [1,2,3,4,5,6,7,8,9,10,11,12])) and
(thic <= HiVThick)) do
thic := thic + 1;
if (thic > HiVThick) then
thic := HiVThick;
end;
{----------------------------------------------------------}
procedure slurclamp (var thic : ThickAryType; totpts : integer);
(* this post-clamps the sampled thicknesses calculated over the
whole of the spline *)
var i : integer;
oneseventh : integer;
middle : integer;
startval, endval: integer;
deltaval, val, incrval, alpha, alphaincr: real;
begin
{ $$ NOTE:: How does the ttspline interpolation of thicknesses
compare to the below results?? Can we avoid having it done
elsewhere and concentrate on it here?? }
oneseventh := round (totpts / 7.0);
for i := 1 to oneseventh do
begin
thic[i] := thic[1];
end;
for i := 6*oneseventh to totpts do
begin
thic[i] := thic[totpts];
end;
middle := round (totpts / 2.0);
for i := 3*oneseventh to 4*oneseventh do
begin
thic[i] := thic[middle];
end;
startval := thic[oneseventh - 1];
endval := thic[3*oneseventh + 1];
deltaval := (2*(endval - startval))/(2*oneseventh);
alphaincr := PI / (2 * oneseventh + 1);
alpha := PI;
val := float(startval);
for i := oneseventh to (3*oneseventh - 1) do
begin (* interpolate: ease in from minthick to middlethickness *)
alpha := alpha + alphaincr;
incrval := ((cos (alpha) + 1.0) / 2.0) * deltaval;
val := val + incrval;
thic[i] := round(val);
end;
startval := thic[4*oneseventh - 1];
endval := thic[6*oneseventh + 1];
deltaval := (2*(endval - startval))/(2*oneseventh);
alphaincr := PI / (2 * oneseventh + 1);
alpha := 0.0;
val := float(startval);
for i := (4*oneseventh + 1) to 6*oneseventh do
begin (* ease out from middle thickness to min thick at far end *)
alpha := alpha + alphaincr;
incrval := ((cos (alpha) + 1.0) / 2.0) * deltaval;
val := val + incrval;
thic[i] := round(val);
end;
end;
{-------------------------------------------------------}
procedure layline (xl, yb, xr, yt, fontindex : integer;
pattern : LineStyle; useVecfontOnly : boolean);
var t: integer;
begin
if (xr < xl) then
begin
t := xr; xr := xl; xl := t;
t := yb; yb := yt; yt := t;
end;
isetfont (VFontTable[fontindex]^.DVIFontNum);
(* we may want to require using a vector font only,
instead of a combination of vectors and TeX-rules.
It may look better this way.
*)
if (useVecfontOnly) then
begin
tylBrokenLine (xl, yb, xr, yt, fontindex, pattern);
end
else
begin (* be smart about the lines *)
if ((xl = xr) and (yb = yt)) or
((xl <> xr) and (yb <> yt)) then (* Null or diagonal lines *)
begin
if (pattern = solid) then
diagonal (xl, yb, xr, yt, fontindex)
else
tylBrokenLine (xl, yb, xr, yt, fontindex, pattern);
end
else
begin
{ if (pattern = solid) then
hvline (xl, yb, xr, yt, fontindex) (* make use of rules *)
else
USENORULES }
tylBrokenLine (xl, yb, xr, yt, fontindex, pattern);
end
end;
end;
{------------------------------------------------------}
procedure layAspline (thetype : SplineKind;
isclosed : boolean;
isanArc: boolean;
domarks : integer;
var cpts : ControlPoints;
numpts : integer;
thick: VThickness;
vkind : VectKind;
patt : LineStyle);
const DontDoThicks = false;
VectorsOnly = true;
var pointList: SplineSegments;
i, xs, ys : integer;
tt1, tt2 : ThickAryType;
F: VecIndex;
begin
clampthickness (thick);
for i := 0 to (numpts + 3) do
tt1[i] := thick;
(* do any marks if necessary to show the control points *)
if (domarks > 0) then
begin
F := GetVectFont (domarks, VKCirc);
isetfont (VFontTable[F]^.DVIFontNum);
for i := 1 to numpts do
begin
Tyldot (cpts[i,1], cpts[i,2]);
end;
end;
drawSpline (thetype, isclosed, isanArc, patt,
numpts, cpts, pointList, DontDoThicks, tt1, tt2);
F := GetVectFont (thick, vkind);
xs := pointList[1, 1];
ys := pointList[1, 2];
for i := 2 to lastPoint do
begin
layline (xs, ys, pointList[i, 1], pointList[i, 2], F, patt, VectorsOnly);
xs := pointList[i, 1];
ys := pointList[i, 2];
end;
if (isclosed) then (* complete the motion *)
layline (pointList[lastPoint,1], pointList[lastPoint,2],
pointList[1,1], pointList[1,2], F, patt, VectorsOnly);
end;
{-----------------------------------------------------}
procedure layNspline (thetype : SplineKind;
isclosed : boolean;
isitaslur : boolean;
domarks : integer;
var cpts : ControlPoints;
numpts : integer;
var thickmatrix : ThickAryType;
vkind : VectKind;
patt : LineStyle);
const NotAnArc = false;
DoThicksToo = true;
VectorsOnly = true;
var pointList: SplineSegments;
i, xs, ys : integer;
ts : VThickness;
tt : ThickAryType;
F : VecIndex;
begin
(* do any marks if necessary to show the control points *)
if (domarks > 0) then
begin
F := GetVectFont (domarks, VKCirc);
isetfont (VFontTable[F]^.DVIFontNum);
for i := 1 to numpts do
begin
Tyldot (cpts[i,1], cpts[i,2]);
end;
end;
drawSpline (thetype, isclosed, NotAnArc, patt,
numpts, cpts, pointList,
DoThicksToo, thickmatrix, tt);
if ((isitaslur) and (not skiptsclamp)) then
begin
slurclamp(tt, lastPoint); (* which kind of clamping to use *)
end;
xs := pointList[1, 1];
ys := pointList[1, 2];
ts := tt[1];
for i := 2 to lastPoint do
begin
clampthickness (ts);
F := GetVectFont (ts, vkind);
layline (xs, ys, pointList[i, 1], pointList[i, 2], F, patt, VectorsOnly);
xs := pointList[i, 1];
ys := pointList[i, 2];
ts := tt[i];
end;
if (isclosed) then
begin
ts := tt[lastPoint];
clampthickness(ts);
F := GetVectFont (ts, vkind);
layline (pointList[lastPoint,1], pointList[lastPoint,2],
pointList[1,1], pointList[1,2], F, patt, VectorsOnly);
end;
end;
{-----------------------------------------------------}
procedure TylBeam (* fromx, fromy, tox, toy: ScaledPts;
staffsize : integer; kind : BeamKind *);
begin
end; (* TylBeam *)
{-------------------------------------------------------}
procedure TylLine (* xl, yb, xr, yt: ScaledPoints;
thickness: VThickness;
vec: VectKind; patt : LineStyle *);
const dontCare = false;
var findex: VecIndex;
begin
clampthickness (thickness);
findex := GetVectFont (thickness, vec);
layline (xl, yb, xr, yt, findex, patt, dontCare);
end;
{-----------------------------------------------------}
procedure TylThickThinSpline (* thetype : SplineKind; isclosed : boolean;
var KnotArray: ControlPoints;
var ThikThinAry: ThickAryType;
numknots: integer;
vec: VectKind;
patt : LineStyle; domarks : integer *);
const NotAnArc = false;
begin
layNspline (thetype, isclosed, NotAnArc, domarks, KnotArray, numknots,
ThikThinAry, vec, patt);
end;
{----------------------------------------------------}
procedure TylSpline (* thetype : SplineKind; isclosed : boolean;
var KnotArray: ControlPoints; numknots: integer;
thick: VThickness; vec: VectKind; patt : LineStyle; domarks : integer*);
const NotAnArc = false;
begin
layAspline (thetype, isclosed, NotAnArc, domarks, KnotArray, numknots,
thick, vec, patt);
end;
{-----------------------------------------------------}
procedure TylTieSlur (* KnotArray: ControlPoints;
numknots: integer;
minthick, maxthick: VThickness *);
const ItsASlur = true;
NotClosed = false;
var ourttarray : ThickAryType;
one7th : real;
val : VThickness;
begin
clampthickness (minthick);
clampthickness (maxthick);
if (numknots <> 5) then
writeln ('TieSlur needs 5 control points ');
one7th := 1.0/7.0;
val := round (one7th * (maxthick - minthick));
ourttarray[1] := minthick;
ourttarray[2] := minthick + val;
ourttarray[3] := maxthick;
ourttarray[4] := minthick + val;
ourttarray[5] := minthick;
layNspline (CATROM, NotClosed, ItsASlur, 0, KnotArray, numknots, ourttarray,
VKCirc, solid);
end;
{-------------------------------------------------------}
procedure doTylArc (* iscircle : boolean;
var apts : ControlPoints;
numknots : integer;
thick : VThickness;
vec : VectKind;
patt : LineStyle *);
const ItsAnArc = true;
begin
layAspline (BSPL, iscircle, ItsAnArc, 0, apts, numknots, thick, vec, patt);
end;
{-----------------------------------------------------------}
procedure TylArc (* radius : ScaledPts; centx, centy : ScaledPts;
firstangle, secondangle : integer;
thick : VThickness; vec : VectKind; patt : LineStyle *);
var apts : ControlPoints;
numknots : integer;
iscircle : boolean;
begin
iscircle := (firstangle = secondangle);
if iscircle then
begin
{ maxspan := round ((360.0 / 16.0) * DEGTORAD * radius);
{}
defineCircleCpts (radius, centx, centy, apts, numknots);
end
else
begin
{ maxspan := round ((abs (secondangle - firstangle) / 16.0) * DEGTORAD * radius);
{ }
definearcpts (radius, centx, centy,
firstangle, secondangle, apts, numknots);
end;
doTylArc (iscircle, apts, numknots, thick, vec, patt);
end;
{-----------------------------------------------------------}
procedure TylLabel (* xpos, ypos : ScaledPts;
fontstyle : integer;
phrase : charstring;
phraselen : integer *);
var findex : integer;
c : integer;
spaceover : integer;
begin
if ((fontstyle < 1) or (fontstyle > MAXLABELFONTS)) then
begin
complain (ERRREALBAD);
writeln(logfile,'Unexpected bad fontstyle in TylLabel: ',fontstyle:0,'?');
jumpout;
end;
findex := GetLabFont (fontstyle);
isetpos (xpos, ypos);
IPUSH;
isetfont (LFontTable[findex]^.DVIFontNum);
spaceover := LFontTable[findex]^.spacewidth;
for c := 1 to phraselen do
begin
if (phrase[c] <> xchr[32]) then
begin
cmd1byte (SET1);
cmd1byte (xord[ phrase[ c ]]);
end
else
begin (* move over *)
cmd1byte (RIGHTLEFT + 2); (* assume distance is less than 3 bytes *)
cmdSigned (spaceover, 3);
end;
end;
IPOP;
end;
(* && start dvidvi section *)
{-----------------------------------------------------}
procedure initialize;
var
i: integer;
begin
for i := 0 to 31 do
xchr[i] := '?';
xchr[32] := ' ';
xchr[33] := '!';
xchr[34] := '"';
xchr[35] := '#';
xchr[36] := '$';
xchr[37] := '%';
xchr[38] := '&';
xchr[39] := '''';
xchr[40] := '(';
xchr[41] := ')';
xchr[42] := '*';
xchr[43] := '+';
xchr[44] := ',';
xchr[45] := '-';
xchr[46] := '.';
xchr[47] := '/';
xchr[48] := '0';
xchr[49] := '1';
xchr[50] := '2';
xchr[51] := '3';
xchr[52] := '4';
xchr[53] := '5';
xchr[54] := '6';
xchr[55] := '7';
xchr[56] := '8';
xchr[57] := '9';
xchr[58] := ':';
xchr[59] := ';';
xchr[60] := '<';
xchr[61] := '=';
xchr[62] := '>';
xchr[63] := '?';
xchr[64] := '@';
xchr[65] := 'A';
xchr[66] := 'B';
xchr[67] := 'C';
xchr[68] := 'D';
xchr[69] := 'E';
xchr[70] := 'F';
xchr[71] := 'G';
xchr[72] := 'H';
xchr[73] := 'I';
xchr[74] := 'J';
xchr[75] := 'K';
xchr[76] := 'L';
xchr[77] := 'M';
xchr[78] := 'N';
xchr[79] := 'O';
xchr[80] := 'P';
xchr[81] := 'Q';
xchr[82] := 'R';
xchr[83] := 'S';
xchr[84] := 'T';
xchr[85] := 'U';
xchr[86] := 'V';
xchr[87] := 'W';
xchr[88] := 'X';
xchr[89] := 'Y';
xchr[90] := 'Z';
xchr[91] := '[';
xchr[92] := '\';
xchr[93] := ']';
xchr[94] := '^';
xchr[95] := '_';
xchr[96] := '`';
xchr[97] := 'a';
xchr[98] := 'b';
xchr[99] := 'c';
xchr[100] := 'd';
xchr[101] := 'e';
xchr[102] := 'f';
xchr[103] := 'g';
xchr[104] := 'h';
xchr[105] := 'i';
xchr[106] := 'j';
xchr[107] := 'k';
xchr[108] := 'l';
xchr[109] := 'm';
xchr[110] := 'n';
xchr[111] := 'o';
xchr[112] := 'p';
xchr[113] := 'q';
xchr[114] := 'r';
xchr[115] := 's';
xchr[116] := 't';
xchr[117] := 'u';
xchr[118] := 'v';
xchr[119] := 'w';
xchr[120] := 'x';
xchr[121] := 'y';
xchr[122] := 'z';
xchr[123] := '{';
xchr[124] := '|';
xchr[125] := '}';
xchr[126] := '~';
for i := 127 to 255 do
xchr[i] := '?';
for i := 0 to 127 do
xord[chr(i)] := 32;
for i := 32 to 126 do
xord[xchr[i]] := i;
initallspline;
initVnMnLtables;
multifigure := 0;
pgfigurenum := 0;
TotBytesWritten := 0;
ourq := 0;
specstart := 0;
currpagenum := 0;
newbackptr := (-1);
oldbackptr := (-1);
ourfontnum := (-1); (* undefined *)
origTexfont := (-1);
ourpushdepth := 0;
FTBDs := 0;
InitDVIBuf;
nf := 0;
inpostamble := false;
didnewfonts := false;
maxpages := 10000;
sysdependent;
s := 0;
skiptsclamp := false;
ErrorOccurred := false;
end;
procedure inputln (var buffer : strng);
var
k: 0..ARRLIMIT;
begin
flush(output);
if eoln(input) then
readln(input);
k := 1;
while (k < ARRLIMIT) and (not eoln(input)) do
begin
buffer.str[k] := input^;
k := k + 1;
get(input)
end;
buffer.str[k] := ' ';
buffer.len := k - 1;
end;
function revindex (st : strng; let : char) : integer;
label 2;
var posit,i : integer;
begin
posit := 0;
for i := st.len downto 1 do
begin
if (st.str[i] = let) then
begin
posit := i;
goto 2;
end;
end;
2:
revindex := posit;
end;
procedure stripblanks (var st : strng);
var i,j,k: integer;
temp : charstring;
begin
j := 1;
i := 1;
while ((i <= st.len) and
((st.str[i] = ' ') or (st.str[i] = xchr[HT]))) do
begin
j := j + 1;
i := i + 1;
end;
(* j now points to the first non-blank character in st.str *)
i := 1;
for k := j to st.len do
begin
if ((st.str[k] <> ' ') and (st.str[k] <> xchr[HT])) then
begin
temp[i] := st.str[k];
i := i + 1;
end;
end;
(* now copy it back *)
if (i <> 1) then
begin (* there was blankspace *)
for k := 1 to (i- 1) do
st.str[k] := temp[k];
st.len := i - 1;
st.str[i] := chr(32); (* end of string *)
end;
end;
{-----------------------------------------------------}
procedure AskandOpenFiles;
var isok : boolean;
i : integer;
rp : integer;
tempname : strng;
begin
isok := false;
while (not isok) do
begin
write (' DVI-input File Name: ');
inputln (dvifname);
stripblanks (dvifname);
rp := revindex (dvifname, '.');
if (rp = 0) then
begin
(* add a ".dvi" extension *)
i := dvifname.len;
dvifname.str[i + 1] := '.';
dvifname.str[i + 2] := 'd';
dvifname.str[i + 3] := 'v';
dvifname.str[i + 4] := 'i';
dvifname.len := i + 4;
end;
if (not opendvifile) then
begin
isok := false; (* it is empty *)
writestrng(dvifname,false);
writeln(': Empty File?? Try another name.');
end
else
isok := true;
end; (* while *)
(* and ask for the name of the output file *)
(* default it to be the same prefix, but with a ".tyl" suffix *)
strcopy (dvifname.str, outname.str, dvifname.len);
outname.len := dvifname.len;
rp := revindex (outname, '.');
i := rp - 1;
outname.str[i + 1] := '.';
outname.str[i + 2] := 't';
outname.str[i + 3] := 'y';
outname.str[i + 4] := 'l';
outname.len := i + 4;
writeln (' DVI-output File Name :');
write('(different than input name)[default of ');
writestrng (outname,false);
write(']');
inputln (tempname);
if (tempname.len > 1) then
begin (* a filename was typed in *)
strcopy (tempname.str, outname.str, tempname.len);
end;
openoutputfile;