procedure gettransforms (var sc1, sc2, r : real;
var tr1, tr2 : integer);
label 22;
var i : integer;
dun : boolean;
begin
sc1 := 1.0; sc2 := 1.0;
tr1 := 0; tr2 := 0;
r := 0.0;
i := parsposit - 1;
if (i < 1) then
begin
goto 22; (* exit with defaults *)
end;
dun := false;
while ((i < parsmax) and not dun) do
begin
if (isaletter(parsearray[i])) then
begin
if ((parsearray[i] = xord['t']) or
(parsearray[i] = xord['T'])) then
begin
if (isdelimiter(parsearray[i+1]) and
isdelimiter(parsearray[i-1])) then
begin (* get transform parameters *)
sc1 := getnumber / 100.0;
sc2 := getnumber / 100.0;
tr1 := getnumber;
tr2 := getnumber;
r := float(getnumber); (* degrees about primitive center *)
if (r < 0.0) then
r := r + 360.0;
dun := true;
end;
end;
end;
i := i + 1;
end; (* while *)
22:
end; (* gettransforms *)
{__________________________________________________________________}
function findmarker (markset : charset) : integer;
label 1111;
var i, sym : integer;
dun : boolean;
begin
i := parsposit - 1;
sym := EMPTY;
if (i < 1) then
goto 1111;
dun := false;
while ((i < parsmax) and not dun) do
begin
if (isaletter(parsearray[i])) then
begin
if (xchr[ parsearray[i] ] in markset) then
begin
if (isdelimiter (parsearray[i+1]) and
isdelimiter (parsearray[i-1])) then
begin
sym := xord[tolowercase(xchr[parsearray[i]])];
dun := true;
end;
end;
end; (* if a letter *)
i := i + 1;
end; (* while *)
1111: findmarker := sym;
end;
function findscale : integer;
begin
findscale := findmarker(['s','S','p','P','m','M']);
end;
function findvectkind : integer;
begin
findvectkind := findmarker(['c','C','h','H','v','V']);
end;
function findlinestyle : integer;
begin
findlinestyle := findmarker(['l','L']);
end;
function findbeamkind : integer;
begin
findbeamkind := findmarker(['r','R','g','G']);
end;
function findsplinekind : integer;
begin
findsplinekind := findmarker(['b','B','i','I','k','K','d','D']);
end;
function findsplclosure : integer;
begin
findsplclosure := findmarker(['o','O','u','U']);
end;
function findatsign : integer;
begin
findatsign := findmarker(['@']);
end;
function finddotmark : integer;
begin
finddotmark := findmarker(['x','X']);
end;
function findfigdimens : integer;
begin
findfigdimens := findmarker(['w','W']);
end;
function findfitsizes : integer;
begin
findfitsizes := findmarker(['f','F']);
end;
{_________________________________________________}
function thescaleof (scal : integer) : real;
begin
if (scal = xord['s']) then
thescaleof := 1 * magfactor
else if (scal = xord['p']) then
thescaleof := SPPERPT * magfactor
else if (scal = xord['m']) then
thescaleof := SPPERMM * magfactor
else if (scal = EMPTY) then
thescaleof := SPPERPT * magfactor;
end;
function thevectorof (vkin : integer) : VectKind;
begin
if (vkin = xord['c']) then
thevectorof := VKCirc
else if (vkin = xord['v']) then
thevectorof := VKVert
else if (vkin = xord['h']) then
thevectorof := VKHort
else if (vkin = EMPTY) then
thevectorof := VKCirc;
end;
function thestyleof (linest : integer) : LineStyle;
begin
if ((linest > 3) or
(linest < 0)) then linest := 0;
case linest of
0 : thestyleof := solid;
1 : thestyleof := dotted;
2 : thestyleof := dashed;
3 : thestyleof := dotdash;
end;
end;
(* -----!!!!!!!!!!!! HandleSpecials !!!!!!!!!!!!!------ *)
begin
tylnam := 'tyl';
beginfigurenam := 'beginfigure';
endfigurenam := 'endfigure';
linenam := 'line';
splinenam := 'spline';
ttsplnam := 'ttspline';
beamnam := 'beam';
tieslurnam := 'tieslur';
arcnam := 'arc';
labelnam := 'label';
paramnam := 'param';
usingstream := true; (* getting bytes from dvifile *)
specstart := DVIMark - (specnum - 239 + 1) - 1;
ourxpos := h; ourypos := v; (* note the global DVI (h,v) coords *)
i := 1;
b := Dget1byte; (* prime the reading scheme *)
gotten := (specnum - 239 + 1);
while (isaspace(b)) do
b := nextpbyte;
let := getletter;
while (let <> ' ') do (* get the name of the system --- Hopefully 'tyl' *)
begin
sysnam.str[i] := tolowercase(let);
sysnam.len := i;
i := i + 1;
let := getletter;
end;
sysnam.str[i] := chr(32); (* end of string *)
if (not streq (sysnam.str, tylnam, 3)) then (* TeXtyl doesnt know about this special *)
begin
write (logfile,'The special: ');
writestrng(sysnam,true);
writeln(logfile,' is not tyl-able. Skipping...');
while (gotten < numpbytes) do
b := nextpbyte;
goto 888;
end;
(* OTHERWISE: all is okay. Lets look for a primitive to tyl *)
while (isdelimiter(b)) do
begin
b := nextpbyte;
end;
i := 1;
let := getletter; {xchr[b];}
while (not (isdelimiter(xord[let]))) do (* get the name of the primitive *)
begin
nam.str[i] := tolowercase(let);
nam.len := i;
i := i + 1;
let := getletter;
end;
nam.str[i] := chr(32); (* end of string *)
let := xchr[b];
(* Now, fill the parse array with bytes so that we can get
the given parameters, and infer the defaulted params *)
parsmax := min (PARSLEN, ((numpbytes - gotten) + 1));
if (parsmax > 1) then
begin
parsearray[1] := xord[' ']; (* we need this *)
parsearray[2] := b; (* start filling *)
for i := 3 to parsmax do
begin (* fill rest *)
parsearray[i] := nextpbyte;
end;
parsposit := 1;
usingstream := false; (* now we look at bytes in parse array *)
b := nextpbyte; (* start it *)
end
else
begin
usingstream := true;
parsposit := -1; (* undefined *)
end;
(* --- BEGINFIGURE ---- *)
if streq(nam.str, beginfigurenam, 3) then
begin
multifigure := multifigure + 1;
i := findscale;
SPscale := thescaleof (i);
gettransforms (sx100, sy100, rot, transx, transy);
(* store all the primitives on pageitems, and dont output
them until we get a endfigure. this way, we can take
care of dealing with all the primitives according to
some global tranformation for the whole figure *)
pi := NewItem (Afigure);
with pi^ do
begin
figtheta := rot;
fsx := sx100; fsy := sy100;
fdx := round (transx * SPscale);
fdy := round (transy * SPscale);
depthnumber := multifigure; (* we're at a new level *)
i := findfigdimens;
if (i <> EMPTY) then
begin
preWid := round (getnumber * SPscale);
preHt := round (getnumber * SPscale);
end;
i := findfitsizes;
if (i <> EMPTY) then
begin
postWid := round (getnumber * SPscale);
postHt := round (getnumber * SPscale);
end;
end; (* with *)
BackupInBuf (DVIMark - specstart);
pushItem (multifigure - 1, pi);
goto 888;
end;
(* ---- ENDFIGURE ---- *)
if streq(nam.str, endfigurenam, 3) then
begin
multifigure := multifigure - 1;
if (multifigure < 0) then
begin
complain (ERRBAD);
write(logfile,'Warning: Too many "endfigure"s !');
multifigure := 0;
end;
BackupInBuf (DVIMark - specstart);
if (multifigure = 0) then
begin
(* go do our set of figures (within figures...) *)
figurehandle (pageitems, pageitems, 1);
dispose (pageitems); (* ### should maybe garbage collect here *)
pageitems := nil;
end; (* if *)
goto 888;
end;
(* --- LINE --- *)
if streq(nam.str, linenam, 3) then
begin
i := findscale;
SPscale := thescaleof(i);
gettransforms (sx100, sy100, rot, transx, transy);
thk := getnumber; (* get the vector thickness *)
if (thk < 1) then
begin
complain (ERRBAD);
writeln(logfile,'?? Thickness not found. Setting to 1');
thk := 1;
end;
i := findvectkind;
vk := thevectorof (i);
i := findlinestyle;
if (i <> EMPTY) then
patt := thestyleof (getnumber)
else
patt := solid;
x1 := round (getnumber * SPscale);
y1 := round (getnumber * SPscale);
x2 := round (getnumber * SPscale);
y2 := round (getnumber * SPscale);
minx := min (x1, x2);
maxx := max (x1, x2);
miny := min (y1, y2);
maxy := max (y1, y2);
BackupInBuf (DVIMark - (specstart));
cmd1byte (OURFONTFLAG);
linehandle (multifigure, SPscale, x1, y1, x2, y2, 0, 0, thk, vk, patt,
minx, maxx, miny, maxy,
transx, transy, sx100, sy100, rot);
end (* line *)
(* ---- THE SPLINES ---- *)
else if (streq(nam.str, splinenam, 3) or
streq(nam.str, ttsplnam,3)) then
begin
i := findscale;
SPscale := thescaleof (i);
gettransforms (sx100, sy100, rot, transx, transy);
if streq(nam.str, splinenam, 3) then
begin
thk := getnumber;
if (thk < 1) then
begin
complain (ERRBAD);
writeln(logfile,'Spline Thickness not found. Setting to 1');
thk := 1;
end;
end;
i := findvectkind;
vk := thevectorof (i);
i := findlinestyle;
if (i <> EMPTY) then
patt := thestyleof (getnumber)
else
patt := solid;
i := findsplinekind;
if (i = xord['b']) then
splinetype := BSPL
else if (i = xord['i']) then
splinetype := INTBSPL
else if (i = xord['k']) then
splinetype := CATROM
else if (i = xord['d']) then
splinetype := CARD
else if (i = EMPTY) then
splinetype := CATROM;
i := findsplclosure;
if (i = xord['o']) then
isclosedspline := true
else if (i = xord['u']) then
isclosedspline := false
else if (i = EMPTY) then
isclosedspline := false;
i := finddotmark;
if (i = xord['x']) then
markdiam := getnumber
else if (i = EMPTY) then
markdiam := 0;
numknots := min (getnumber, MAXCTLPTS);
if (numknots < 1) then
begin
complain (ERRBAD);
writeln(logfile,'Number of spline/ttspline knot points not found. Setting to 1');
numknots := 1;
end;
minx := TWO24; miny := TWO24;
maxx := -TWO24; maxy := -TWO24;
for i := 0 to (numknots + 3) do
begin
cpts[i,1] := 0;
cpts[i,2] := 0;
end; (* for *)
for i := 1 to numknots do
begin
x1 := round (getnumber * SPscale);
cpts[i,1] := x1;
if (x1 < minx) then
minx := x1;
if (x1 > maxx) then
maxx := x1;
y1 := round (getnumber * SPscale);
cpts[i,2] := y1;
if (y1 < miny) then
miny := y1;
if (y1 > maxy) then
maxy := y1;
end; (* for *)
if streq(nam.str, ttsplnam, 3) then
begin
for i := 1 to numknots do
begin
TTary[i] := getnumber;
end;
end;
BackupInBuf (DVIMark - (specstart));
cmd1byte (OURFONTFLAG);
if streq(nam.str, splinenam, 3) then
splinehandle (multifigure, SPscale, splinetype, isclosedspline,
markdiam, cpts, numknots,
0, 0, thk, vk, patt, minx, maxx, miny, maxy,
transx, transy, sx100, sy100, rot)
else
ttsplhandle (multifigure, SPscale, splinetype, isclosedspline,
markdiam, cpts, TTary, numknots,
0, 0, vk, patt, minx, maxx, miny, maxy,
transx, transy, sx100, sy100, rot);
end (* splines *)
(* --- BEAMS ---- *)
else if streq(nam.str, beamnam, 4) then
begin
i := findscale;
SPscale := thescaleof (i);
(* no transforms *)
siz := getnumber; (* the staffsize *)
i := findbeamkind;
if (i = xord['g']) then
bk := grace
else if (i = xord['r']) then
bk := regular
else if (i = EMPTY) then
bk := regular;
x1 := round (getnumber * SPscale);
y1 := round (getnumber * SPscale);
x2 := round (getnumber * SPscale);
y2 := round (getnumber * SPscale);
BackupInBuf (DVIMark - (specstart));
cmd1byte (OURFONTFLAG);
beamhandle (multifigure, siz, bk, x1, y1, x2, y2);
end (* beam *)
(* ---- TIES AND SLURS ---- *)
else if streq(nam.str, tieslurnam, 3) then
begin
i := findscale;
SPscale := thescaleof (i);
minthk := getnumber;
if (minthk < 1) then
begin
complain (ERRBAD);
writeln(logfile,'Tie/Slur Min Thickness not found. Setting to 1');
minthk := 1;
end;
maxthk := getnumber;
if (maxthk < 1) then
begin
complain (ERRBAD);
writeln(logfile,'Tie/Slur MaxThickness not found. Setting to 1');
maxthk := 1;
end;
numknots := min (getnumber, MAXCTLPTS);
if (numknots < 1) then
begin
complain (ERRBAD);
writeln(logfile,'Tie/Slur Number of knot points not found. Setting to 1. Should be 5');
numknots := 1;
end;
for i := 1 to numknots do
begin
cpts[i,1] := round (getnumber * SPscale);
cpts[i,2] := round (getnumber * SPscale);
end; (* for *)
BackupInBuf (DVIMark - (specstart));
cmd1byte (OURFONTFLAG);
tieslurhandle (multifigure, cpts, numknots, minthk, maxthk);
end (* ties and slurs *)
(* --------- ARCS and CIRCLES --------- *)
else if streq (nam.str, arcnam, 3) then
begin
i := findscale;
SPscale := thescaleof (i);
gettransforms (sx100, sy100, rot, transx, transy);
thk := getnumber;
if (thk < 1) then
begin
complain (ERRBAD);
writeln(logfile,'Arc Thickness not found. Setting to 1');
thk := 1;
end;
i := findvectkind;
vk := thevectorof (i);
i := findlinestyle;
if (i <> EMPTY) then
patt := thestyleof (getnumber)
else
patt := solid;
radius := round (getnumber * SPscale);
if (radius = 0) then
radius := round(1 * SPscale);
i := findatsign;
if (i <> EMPTY) then
begin
x2 := round (getnumber * SPscale);
y2 := round (getnumber * SPscale);
end
else
begin
x2 := 0; y2 := 0; (* assume center at origin *)
end;
ang1 := getnumber;
if (abs(ang1) > 360) then
ang1 := ang1 mod 360;
ang2 := getnumber;
if (abs(ang2) > 360) then
ang2 := ang2 mod 360;
minx := TWO24; miny := TWO24;
maxx := -TWO24; maxy := -TWO24;
if (ang1 = ang2) then
begin (* a circle *)
defineCircleCpts (radius,x2,y2, cpts, numknots);
end
else
begin (* a real arc *)
definearcpts (radius, x2,y2, ang1, ang2, cpts, numknots);
end;
for i := 1 to numknots do
begin
x1 := cpts[i,1];
if (x1 < minx) then
minx := x1;
if (x1 > maxx) then
maxx := x1;
y1 := cpts[i,2];
if (y1 < miny) then
miny := y1;
if (y1 > maxy) then
maxy := y1;
end; (* for *)
BackupInBuf (DVIMark - (specstart));
cmd1byte (OURFONTFLAG);
arccirclehandle (multifigure, SPscale, x2, y2,
radius, ang1, ang2,
cpts, numknots,
0, 0, thk, vk, patt, minx, maxx, miny, maxy,
transx, transy, sx100, sy100, rot)
end (* arc and circle *)
(* ---------- LABELS --------------*)
else if streq (nam.str, labelnam, 3) then
begin
i := findscale;
SPscale := thescaleof (i);
style := getnumber; (* font style number *)
if ((style < 1) or (style > MAXLABELFONTS)) then
begin
complain (ERRBAD);
writeln(logfile,'Label style bad? Setting to Style 1');
style := 1;
end;
x1 := round (getnumber * SPscale);
y1 := round (getnumber * SPscale);
let := getletter;
while (let <> '"') do
begin
let := getletter;
end;
i := 0;
let := getanything; (* get next letter or whatever *)
while (let <> '"') do
begin (* get the label phrase *)
i := i + 1;
phrase.str[i] := let;
let := getanything; (* getletter;*)
end;
phrase.str[i+1] := chr(32);
phrase.len := i;
BackupInBuf (DVIMark - specstart);
cmd1byte (OURFONTFLAG);
labelhandle (multifigure, SPscale, x1, y1, 0, 0, style, phrase, 0, 0);
end (* label *)
(* --------- INTERNAL PARAM -------*)
else if streq (nam.str, paramnam, 3) then
begin
i := getnumber; (* addressable param number *)
begin
writeln (logfile,' I do not know what internal parameter #',i:0,' is');
end; (* else *)
BackupInBuf (DVIMark - (specstart));
end (* Internal param *)
(* ============== NONE OF THE ABOVE ============== *)
else
begin
complain (ERRNOTBAD);
write (logfile,'Sorry, I don''t know how to tyl ');
writestrng (nam,true);
while (gotten < numpbytes) do
begin
b := nextpbyte;
end;
end;
888:
(* make sure that we used up all the bytes in this special *)
if (gotten < numpbytes) then
begin
while (gotten < numpbytes) do
begin (* slurp up excess *)
b := Dgrabbyte;
gotten := gotten + 1;
end;
end; (* if *)
end; (* mainhandlespecials *)
(* ==================================================
The routines below assume coordinates are already in
4th Quadrant DVI-space
=====================================================*)
{-----------------------------------------------------}
(* returns 0 if dy.dx not in font
1 if ok
2 if ok and caller should use two of the "code"s
coding scheme requires 0<= [dx, dy] <= 16
AND that max(dx, abs(dy)) is in [0,1,2,4,8,16]
*)
function outvector (dx, dy : integer; var code : integer) : integer;
label 99;
var c : integer;
result : integer;
begin
if (dx < 0) then
begin
outvector := 0;
goto 99;
end;
result := 0; (* init for potential failure *)
code := (-1);
if (dy < 0) then
begin
c := 160 + dy + dx - 9*max (dx, -dy);
end
else
begin
c := 160 + dy - dx - 7*max (dx, dy);
end;
(* here translate to OUR coding scheme
and return the correct number
this is needed because "c" thinks the char range
is 0 to 160, while we have only 128 chars *)
if (c = 0) then (* special cases *)
begin
code := 63;
result := 2;
end
else if (c = 64) then
begin
code := 95;
result := 2;
end
else
begin (* regular ones *)
result := 1; (* just one char is fine *)
if (c in [1..63]) then
code := c - 1
else if (c in [80..112]) then
code := c - 17
else if (c in [120..136]) then
code := c - 24
else if (c in [140..148]) then
code := c - 27
else if (c in [150..154]) then
code := c - 28
else if (c = 160) then
code := 127; (* c - 33 *)
end;
99:
outvector := result;
end;
(* take care of a Manhattan (horizontal /vertical) line *)
{----------------------------------------------------------}
procedure hvline (lx, by, rx, ty, fontindex : integer);
var t, rth, x, y, width, height : integer;
begin
rth := VFontTable[fontindex]^.PenSize; (* thickness of vector in sp *)
if (lx = rx) then
begin (* Vertical line *)
if (ty > by) then
begin
t := by; by := ty; ty := t; (* swap *)
end;
x := round (lx - (rth / 2.0));
y := by;
width := rth;
height := by - ty;
end
else
begin (* Horizontal line *)
if (ty < by) then
begin
t := by; by := ty; ty := t; (* swap *)
end;
if (lx > rx) then
begin
t := lx; lx := rx; rx := t; (* swap *)
end;
x := lx;
y := (by + (rth div 2)); (* + rth for {h,v}-space *)
width := rx - lx;
height := rth;
end;
isetpos (x, y);
cmd1byte (PUTRULE);
cmd4byte (height);
cmd4byte (width);
(* output two dots on ends of the rules
at lx, by and rx, ty *)
(* the font has already been set before these calls *)
Tyldot (lx, by);
Tyldot (rx, ty);
isetpos (rx, ty);
end;
{------------------------------------------------------------}
procedure diagonal (xl, yb, xr, yt : ScaledPts; fontindex: integer);
var t, curx, cury, dx, dy, code : integer;
slope : real;
mxveclen : ScaledPts;
sptovecs : real;
rho : ScaledPts;
{......................................}
(* compute maximum length vector character that we can use *)
procedure getincr (var outdx, outdy : integer);
label 99;
var radius, x, y : integer;
sign : integer;
q : real;
begin (* getincr *)
radius := mxveclen; (* radius of semi-square *)
(* make sure the pt is outside of the semi-square,
scaling down radius if necessary *)
while ( ((xr - curx) < radius) and
(abs (yt - cury) < radius)) do
begin
radius := radius div 2;
end;
if (slope < 0.0) then (* <0 since in 4th quad by now*)
sign := -1
else
sign := +1;
if (xr = curx) then
begin
outdx := 0;
outdy := sign * radius;
goto 99;
end;
if (yt = cury) then
begin
outdx := abs (radius);
outdy := 0;
goto 99;
end;
(* compute the intersection with the semi-square,
choose whichever slope is best *)
if (abs (slope) < 1.0) then
begin (* mostly horizontal *)
outdx := abs (radius);
y := yb + round ((curx + abs(radius) - xl) * slope);
outdy := y - cury;
end
else
begin (* mostly vertical *)
x := xl + round ((cury + (sign * radius) - yb) / slope);
outdx := x - curx;
outdy := sign * radius;
end;
if (abs (outdy) > abs (yt - cury)) then
begin (* truncate *)
outdy := yt - cury;
end;
if (outdx > (xr - curx)) then
begin (* truncate *)
outdx := xr - curx;
end;
if (outdx < 0) then
begin
outdx := 0;
end;
(* method to find the exact intersection of the line segment
with the semi-circle, used
to determine the x and y values::
we do this by using the arctangent of the slope as
the angle 'a' from the x-axis. Then use the relation
y = r cos a, and x = r sin a
we can be smart about all this trig stuff by using
the relation :
sin (arctan a) = 1/sqrt(1 + a^2)
cos (arctan a) = a/sqrt(1 + a^2)
Thus:
q := (1.0 / sqrt (slope * slope + 1.0));
outdx := round (q * radius);
outdy := round (q * radius * slope);
Unfortunately, we cannot access the Vector Font
coding scheme because the outdx, outdy 's produced
here do no conform to the condition
max (dx, abs(dy)) in [0,1,2,4,8,16]
when converted to vector-font sizes with
sptovecs (see the 'diagonal' proc.).
*)
99:
end; (* getincr *)
{.......................................}
begin (* DIAGONAL *)
if (xr <> xl) then
slope := (yt - yb) / (xr - xl)
else
slope := BIGREAL; (* some illegal value *)
if (xl > xr) then
begin
t := xl; xl := xr; xr := t;
t := yb; yb := yt; yt := t;
end; (* swap *)
curx := xl;
cury := yb;
mxveclen := (VFontTable[fontindex]^.MaxVectLen);
rho := mxveclen div 16; (* minimum radius of vector fonts *)
if (rho = 0) then
begin
complain (ERRREALBAD);
writeln(logfile,'Diagonal: Min radius of vector font is zero. setting to 1');
rho := 1;
end;
if ((abs(xl - xr) <= rho) and
(abs(yb - yt) <= rho)) then
begin (* pretty much a null line *)
Tyldot (xl, yb);
end
else
begin
sptovecs := 1.0 / rho; (* conversion for scaled pts to vectorfont units *)
code := -1; (* initialize to a bogus number *)
(* this conditional really has to have "or"
instead of "and", because of lines that are
*nearly* horizontal or vertical
*)
while (((xr - curx) >= rho) or (abs(yt - cury) >= rho)) do
begin
(* Get the approximate incremental amount. We use this dy/dx
pair in order to index into our vector font coding scheme *)
getincr (dx, dy);
(* Get the vector character code corresponding to this
approximate incremental amount *)
t := outvector (round (dx * sptovecs),
round (dy * sptovecs),
code);
(* Now that we have the character code, go find out its actual
physical dimensions for the real dy/dx amounts *)
if (dy > 0) then
dy := VFontTable[fontindex]^.FontInfo[code].Cdp
else
dy := -(VFontTable[fontindex]^.FontInfo[code].Cht);
dx := VFontTable[fontindex]^.FontInfo[code].Cwd;
case (t) of
0: begin
complain (ERRREALBAD);
writeln (logfile,'Error in Diagonal:: bad dydx');
end;
1: begin
isetpos (curx, cury);
iputchar (code);
end;
2: begin
isetpos (curx, cury);
iputchar (code);
isetpos (curx + (dx div 2), cury + (dy div 2));
iputchar (code);
end;
end; (* case *)
curx := curx + dx;
cury := cury + dy;
end; (* while *)
if ((code >= 0) and
(((xr - curx) >= rho) and (abs(yt - cury) >= rho))) then
begin
iputchar (code);
end;
end; (* not null line *)
end;
{-------------------------------------------------------}