{---------------------------------------------------}
procedure Output4Byte (i : integer);
var tmp : integer;
begin
tmp := i;
if (tmp >= 0) then
begin
OutputByte (tmp div TWO24);
end
else
begin
tmp := tmp + TWO31 + 1; (* need the +1 *)
OutputByte (tmp div TWO24 + 128);
end;
tmp := tmp mod TWO24;
OutputByte (tmp div TWO16);
tmp := tmp mod TWO16;
OutputByte (tmp div 256);
OutputByte (tmp mod 256);
end;
{---------------------------------------------------}
function rtan (ang : real) : real;
var rads : real;
cosrads : real;
begin
rads := ang * DEGTORAD;
cosrads := cos (rads);
if (cosrads = 0.0) then { this happens at 90 and 270 }
cosrads := cos ((ang - 0.01) * DEGTORAD);
rtan := (sin (rads)) / (cosrads);
end;
{---------------------------------------------------}
function float (i : integer) : real;
begin
float := i + 0.00;
end;
{---------------------------------------------------}
function tolowercase (let: char) : char;
const Diff = 32; (* xord['a'] - xord['A'] *)
var olet : integer;
begin
olet := xord[let];
if (olet >= xord['A']) then
begin
if (olet <= xord['Z']) then
begin
let := xchr[olet + Diff];
end;
end;
tolowercase := let;
end;
{---------------------------------------------------}
(* decide if the first string is the same as the second --
* at least the first 'len' characters
* We need this since most Pascal impls. are brain-dead
* when it comes to string comparisons
*)
function streq (a, b : charstring; len : integer) : boolean;
label 1;
var i : integer;
same : boolean;
begin
same := true;
for i := 1 to len do
begin
if (a[i] <> b[i]) then
begin
same := false;
goto 1;
end; (* if *)
end; (* for *)
1:
streq := same;
end; (* streq *)
{-------------------------------------------------------}
procedure strcopy (* src : charstring; var dest : charstring; len : integer *);
var i : integer;
begin
for i := 1 to len do
dest[i] := src[i];
end;
{-------------------------------------------------------}
procedure writestrng (* s :strng; tologfile : boolean *);
var i : integer;
begin
if (tologfile) then
begin
for i := 1 to s.len do
write (logfile, s.str[i]);
end
else
begin
for i := 1 to s.len do
write (s.str[i]);
end;
end;
{---------------------------------------------------}
(* Move the current DVI position to posx, posy by
* moving relatively from our current position
* and store the new position
*)
procedure isetpos (posx, posy : integer);
var dy, dx: ScaledPts;
numbytes : integer;
begin
dx := posx - ourxpos;
dy := posy - ourypos;
numbytes := 1;
if ((dx < 128) and (dx >= -128)) then
numbytes := 1
else if ((dx < 32768) and (dx >= -32768)) then
numbytes := 2
else if ((dx < TWO23) and (dx >= - TWO23))then
numbytes := 3
else if ((dx < TWO31) and (dx >= - TWO31))then
numbytes := 4
else
begin
complain (ERRREALBAD);
writeln('Panic: dx is too big/small in isetpos: ',dx);
writeln(logfile,'Panic: dx is too big/small in isetpos: ',dx);
end;
cmd1byte (RIGHTLEFT + numbytes -1); (* number of bytes in its arg list *)
cmdSigned (dx, numbytes);
numbytes := 1;
if ((dy < 128) and (dy >= -128)) then
numbytes := 1
else if ((dy < 32768) and (dy >= -32768)) then
numbytes := 2
else if ((dy < TWO23) and (dy >= - TWO23))then
numbytes := 3
else if ((dy < TWO31) and (dy >= - TWO31))then
numbytes := 4
else
begin
complain (ERRREALBAD);
writeln('Panic: dy is too big/small in isetpos: ',dy);
writeln(logfile,'Panic: dy is too big/small in isetpos: ',dy);
end;
cmd1byte (DOWNUP + numbytes -1);
cmdSigned (dy, numbytes);
ourxpos := posx;
ourypos := posy;
end;
{---------------------------------------------------}
(* put out a character *)
procedure iputchar (charno : OctByt);
begin
cmd1byte (PUT1);
cmd1byte (charno);
end;
{---------------------------------------------------}
(* set the font number, but only if it is different than
* the last one we accessed.
*)
procedure isetfont (DVINum : integer);
begin
if (ourfontnum <> DVINum) then
begin
cmd1byte (USEFONT);
cmd2byte (DVINum);
ourfontnum := DVINum;
end;
end;
procedure IPUSH;
begin
if (ourpushdepth = 0) then
begin (* first push --> start tyling *)
origTexfont := font[curfont].num;
end
else
begin
prevfont := ourfontnum; (* store the internal font number in use at this time *)
end;
cmd1byte (NOP);
cmd1byte (NOP); (* our greeting *)
cmd1byte (PUSH);
ourpushdepth := ourpushdepth + 1;
end;
procedure IPOP;
begin
cmd1byte (POP);
cmd1byte(NOP);
cmd1byte(NOP); (* our signature *)
ourpushdepth := ourpushdepth - 1;
if (ourpushdepth < 0) then
begin
complain (ERRREALBAD);
writeln(logfile,'Error: too many internal pops');
end;
if (ourpushdepth = 0) then
begin (* we are totally done with tyling for now *)
if (nf > 0) then
isetfont (origTexfont); (* only if it is valid *)
end
else
begin
if (prevfont >= 0) then
isetfont(prevfont); (* restore that internal font previously in use *)
end;
end;
{---------------------------------------------------}
(* Assumes that the correct font is currently set *)
procedure Tyldot (dotx, doty : ScaledPts);
begin
if (dotx <> 0) and (doty <> 0) then
isetpos (dotx, doty);
iputchar (DOTCHAR);
end;
{---------------------------------------------------}
procedure InitDVIBuf;
var i: integer;
begin
with GDVIBuf do
begin
TotByteLen := 0;
Numstrings := 0;
for i := 1 to MAXDVISTRINGS do
Dstrings[i] := nil;
curstrindex := MAXOLEN + 1;
end;
end;
{---------------------------------------------------}
procedure ClearDVIBuf;
var i : integer;
begin
with GDVIBuf do
begin
for i := 1 to Numstrings do
begin
dispose (Dstrings[i]);
Dstrings[i] := nil;
end;
TotByteLen := 0;
Numstrings := 0;
curstrindex := MAXOLEN + 1;
end;
end;
{---------------------------------------------------}
procedure WriteDVIBuf;
var i: integer;
curstr: integer;
b : OctByt;
begin
curstr := 1;
with GDVIBuf do
begin
while (curstr < Numstrings) do
begin
for i := 1 to MAXOLEN do
begin
b := Dstrings[curstr]^[i];
OutputByte (b);
end;
curstr := curstr + 1;
end; (* while *)
(* now do the last string *)
for i := 1 to (curstrindex - 1) do
begin
b := Dstrings[Numstrings]^[i];
OutputByte(b);
end; (* for *)
end; (* with *)
ClearDVIBuf;
end;
{---------------------------------------------------}
procedure BackupInBuf (nbytes : integer);
var nstrs, rem : integer;
begin
with GDVIBuf do
begin
nstrs := (TotByteLen - nbytes) div MAXOLEN;
rem := (TotByteLen - nbytes) mod MAXOLEN;
Numstrings := nstrs + 1;
curstrindex := rem + 1; (* points to position to-be-filled *)
if (curstrindex = 0) then
curstrindex := MAXOLEN;
TotByteLen := TotByteLen - nbytes;
end;
end;
{-----------------------------------------------------}
function DVIMark : integer;
begin
DVIMark := GDVIBuf.TotByteLen;
end;
{---------------------------------------------}
function NewItem (what : Primitive): pItem;
var i : pItem;
f : figptr;
begin
new (i);
with i^ do
begin
nextitem := nil;
BBlx := 0;
BBby := 0;
BBrx := 0;
BBty := 0;
itemthick := LoVThick;
itemvec := VKCirc;
itempatt := solid;
kind := what;
case (what) of (* give defaults *)
Aline : ;
Aspline: begin
nsplknots := 0;
dosmarks := 0;
sclosed := false;
spltype := BSPL;
end;
Attspline: begin
nttknots := 0;
dottmarks := 0;
tspltype := BSPL;
tclosed := false;
end;
Abeam : ;
Atieslur: begin
ntknots := 0;
end;
Aarc: begin
narcknots := 0;
end;
Alabel: begin
fontstyle := -1; (* undefined *)
labeltext.len := 0;
end;
Afigure: begin
figtheta := 0.0;
fsx := 1.0; fsy := 1.0;
fdx := 0; fdy := 0;
preWid := 0; preHt := 0;
postWid := 0; postHt := 0;
depthnumber := 0; (* for now *)
new (f); (* a new figure *)
body := f;
body^.things := nil;
end;
end; (*case *)
end; (* with *)
NewItem := i;
end; (* NewItem *)
{ ### Note: "pageitems" could be extended to be a list
{ of macrodefinitions which contain primitives , and
{ then could be instanced. E.g., a library of common
{ figures callable from \special level }
{------------------------------------------------------}
procedure pushItem (depth : integer; newthing : pItem);
label 101;
var i, p : pItem;
dun : boolean;
begin
if (pageitems = nil) then
begin
if (newthing^.kind = Afigure) then
begin
pageitems := newthing;
goto 101;
end
else
begin
pageitems := NewItem (Afigure);
pageitems^.depthnumber := depth;
end;
end;
(* Assume that pageitems points to Afigure *)
(* traverse the list *)
i := pageitems; (* point to front of list for now *)
p := i^.body^.things;
dun := false;
while ((p <> nil) and not dun) do
begin
if (depth = i^.depthnumber) then
begin (* simple push *)
dun := true;
(* Note: this is the case when pushing another figure item
onto an already-existing list. We push the newfigure
with a depth of (fig^.depthnumber - 1) because it
really is part of the higer-level figure
*)
end
else if (depth > i^.depthnumber) then
begin
(* there MUST be a figure with a higher number deeper *)
while ((p^.kind <> Afigure) and (p^.nextitem <> nil)) do
begin
p := p^.nextitem;
end;
if (p^.kind = Afigure) then
begin
i := p;
p := i^.body^.things;
end
else
begin
complain (ERRREALBAD);
writeln(logfile,'OOPS p^.kind isnt a figure. It must be near endoflist');
end;
end;
end; (* while *)
(* we have the correct front of list-list,
and i points to Afigure item *)
newthing^.nextitem := p;
i^.body^.things := newthing;
101:
end; (* pushItem *)
{---------------------------------------------}
function Tgetfixword (k: integer) : real;
var a : 0 .. 4096;
f : integer;
begin
a := (tfm[k] * 16) + (tfm[k + 1] div 16);
f := ((((tfm[k + 1] mod 16) * 256)
+ tfm[k + 2]) * 256)
+ tfm[k + 3];
if (a > 2047) then
begin
a := 4096 - a;
if (f > 0) then
begin
f := TWO20 - f;
a := a - 1;
end;
end;
Tgetfixword := a + f / TWO20;
end;
{-----------------------------------------------------}
function TgetSigned (k: integer): integer;
var i: integer;
begin
i := tfm[k];
if (i < 128) then
i := i - 256;
TgetSigned := (((((i * 256) + tfm[k + 1]) * 256) +
tfm[k + 2]) * 256) + tfm[k + 3];
end;
{-----------------------------------------------------------}
(* open a .tfm file and return the parameters in it.
* Used only in conjuction with the vector and music fonts
*)
procedure gettfm (tfmfilnam: strng;
var dessize, p1, p2, p3, p4, p5, p6, p7 : ScaledPts;
var cksum : integer);
label 9999;
var tfmptr: integer;
lf, lh, bc, ec, nw, nh, nd, ni, nl, nk, ne, np: integer;
charbase, widthbase, heightbase, depthbase,
italicbase, ligkernbase, kernbase, extenbase,
parambase : integer;
tempdesignsize : ScaledPts;
begin
p1 := 0; p2 := 0; p3 := 0; p4 := 0;
p5 := 0; p6 := 0; p7 := 0;
cksum := -1;
strcopy(tfmfilnam.str, tfmname.str, tfmfilnam.len);
tfmname.len := tfmfilnam.len;
tfmname.str[tfmname.len + 1] := chr(32);
if (not opentfmfile) then
begin
complain (ERRREALBAD);
writestrng(tfmname,true);
writeln(logfile,'---not loaded, TFM file can''t be opened!');
writestrng(tfmname,false);
writeln(' cannot be opened. Aborting');
jumpout;
end;
tfm[0] := Tgetvaxbyte;
tfm[1] := Tgetvaxbyte;
lf := (tfm[0] * 256) + tfm[1];
if ((4 * lf - 1) > TFMSIZE) then
begin
complain (ERRREALBAD);
write(logfile,'The tfm file:');
writestrng(tfmfilnam, true);
writeln(logfile,' is bigger than I can handle!');
goto 9999;
end;
for tfmptr := 2 to (4 * lf) - 1 do
begin
tfm[tfmptr] := Tgetvaxbyte;
end; (* for *)
tfmptr := 2;
lh := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
tfmptr := tfmptr + 2;
bc := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
tfmptr := tfmptr + 2;
ec := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
tfmptr := tfmptr + 2;
nw := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
tfmptr := tfmptr + 2;
nh := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
tfmptr := tfmptr + 2;
nd := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
tfmptr := tfmptr + 2;
ni := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
tfmptr := tfmptr + 2;
nl := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
tfmptr := tfmptr + 2;
nk := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
tfmptr := tfmptr + 2;
ne := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
tfmptr := tfmptr + 2;
np := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
tfmptr := tfmptr + 2;
if (lf <> (6 + lh + ((ec - bc) + 1) + nw + nh
+ nd + ni + nl + nk + ne + np)) then
begin
complain (ERRREALBAD);
writestrng(tfmfilnam, true);
writeln(logfile,': subfile sizes don''t add up to the stated total!');
writeln(logfile,'Sorry, but I can''t go on; are you sure this is a TFM?');
goto 9999
end;
if (bc > (ec + 1)) or (ec > 255) then
begin
complain (ERRREALBAD);
writeln(logfile,'The character code range ', bc: 1, '..', ec: 1, 'is illegal!');
writeln(logfile,'Sorry, but I can''t go on; are you sure this is a TFM?');
goto 9999;
end;
charbase := (6 + lh) - bc;
widthbase := (charbase + ec) + 1;
heightbase := widthbase + nw;
depthbase := heightbase + nh;
italicbase := depthbase + nd;
ligkernbase := italicbase + ni;
kernbase := ligkernbase + nl;
extenbase := kernbase + nk;
parambase := (extenbase + ne) - 1;
dessize := round (Tgetfixword (28) * SPPERPT); (* now in ScaledPts *)
tempdesignsize := round (dessize * magfactor);
cksum := TgetSigned (24);
(* return the special 7 parameters for the font *)
p1 := round (Tgetfixword (4 * (parambase + 1)) * tempdesignsize);
p2 := round (Tgetfixword (4 * (parambase + 2)) * tempdesignsize);
p3 := round (Tgetfixword (4 * (parambase + 3)) * tempdesignsize);
p4 := round (Tgetfixword (4 * (parambase + 4)) * tempdesignsize);
p5 := round (Tgetfixword (4 * (parambase + 5)) * tempdesignsize);
p6 := round (Tgetfixword (4 * (parambase + 6)) * tempdesignsize);
p7 := round (Tgetfixword (4 * (parambase + 7)) * tempdesignsize);
9999:
end;
{---------------------------------------------------}
procedure initVnMnLtables;
var i: integer;
begin
for i := 1 to SizVFontTable do
VFontTable[i] := nil;
for i := 1 to SizMFontTable do
MFontTable[i] := nil;
for i := 1 to SizLFontTable do
LFontTable[i] := nil;
VFontsDefd := 0;
MFontsDefd := 0;
LFontsDefd := 0;
GDVIFN := 300; (* starting number for any new fonts that we define *)
end;
{-------------------------------------------------------}
procedure fonttobedefined (kind : char; findex : integer);
begin
FTBDs := FTBDs + 1;
(* reset this to zero after outputting
1. fontdefs
2. bop
3. contents of dvi page
4. eop
*)
TBD[FTBDs].which := kind;
TBD[FTBDs].indx := findex;
end;
{-----------------------------------------------------}
procedure enterfont (fontnum : integer; ck : integer;
scalefact, dessiz : ScaledPts;
nam : strng);
var n: integer;
len : integer;
begin
cmd1byte(FONTDEF);
cmd2byte(fontnum);
cmd4byte(ck);
cmd4byte(scalefact);
cmd4byte(dessiz);
cmd1byte(USESTDAREA);
len := nam.len;
cmd1byte(len - 4); (* skip the length of the .tfm suffix *)
for n := 1 to (nam.len - 4) do
begin (* skip the .tfm suffix *)
cmd1byte (xord [ nam.str[n] ]);
end;
end;
{-----------------------------------------------------}
procedure Outputfont (fontnum : integer; ck : integer;
scalefact, dessiz : ScaledPts;
nam : strng);
var n: integer;
len : integer;
begin
OutputByte(FONTDEF);
Output2Byte(fontnum);
Output4Byte(ck);
Output4Byte(scalefact);
Output4Byte(dessiz);
OutputByte(USESTDAREA);
len := nam.len;
OutputByte(len - 4);
for n := 1 to (nam.len - 4) do
begin (* dont output the default dir prefix, nor the .tfm suffix *)
OutputByte(xord [ nam.str[n] ]);
end;
end;
{-----------------------------------------------------}
procedure defineNewfonts;
(* this needs to be done before first access to a font on a page
later someone else will have to re-define all of them in the postamble *)
label 99;
var i, n : integer;
f : integer;
begin
for i := 1 to FTBDs do
begin
if (TBD[i].which = 'V') then
begin
f := TBD[i].indx;
with VFontTable[f]^ do
begin
if (Isdefined) then
goto 99;
Outputfont (DVIFontNum, Cksum, DesSize, DesSize,
FontName);
Isdefined := true;
end; (*with *)
end (* if *)
else if (TBD[i].which = 'M') then
begin (* music font *)
f := TBD[i].indx;
with MFontTable[f]^ do
begin
if (Isdefined) then
goto 99;
Outputfont (DVIFontNum, Cksum, DesSize, DesSize,
FontName);
Isdefined := true;
end; (* with *)
end (* else *)
else if (TBD[i].which = 'L') then
begin (* label font *)
f := TBD[i].indx;
with LFontTable[f]^ do
begin
if (Isdefined) then
goto 99;
Outputfont (DVIFontNum, Cksum, DesSize, DesSize, {### is this right?}
FontName);
Isdefined := true;
end; (* with *)
end
else
begin
complain (ERRREALBAD);
writeln(logfile,'Unknown type of font to be defined:"',TBD[i].which,'"');
end; (* else *)
99:
end; (* for *)
end;
{---------------------------------------------------}
function GetMusFont (stfsiz, fam : integer) : MusIndex;
label 20, 99;
var mustfmnam : strng;
found, i : MusIndex;
design, p1, p2, p3, p4, linesp, gwidth, p7 : ScaledPts;
cksm, r, k : integer;
begin
(* see if it already exists *)
found := 0;
for i := 1 to MFontsDefd do (* loop through since there are few *)
with MFontTable[i]^ do
begin
if (Staffsize = stfsiz) and
(Family = fam) then
begin
found := i;
goto 20;
end;
end; (* with *)
20: if (found <> 0) then
begin
GetMusFont := found;
goto 99;
end;
(* Not here already--go get it *)
for k := 1 to ARRLIMIT do
mustfmnam.str[k] := ' ';
r := 0;
mustfmnam.str[r+1] := 'm';
mustfmnam.str[r+2] := 'u';
mustfmnam.str[r+3] := 's';
mustfmnam.str[r+4] := xchr[stfsiz + xord['0']];
mustfmnam.str[r+5] := xchr[fam + xord['0']];
mustfmnam.str[r+6] := '.';
mustfmnam.str[r+7] := 't';
mustfmnam.str[r+8] := 'f';
mustfmnam.str[r+9] := 'm';
mustfmnam.str[r+10] := chr(32);
mustfmnam.len := 9 + r;
gettfm (mustfmnam, design, p1, p2, p3, p4, linesp, gwidth, p7, cksm);
MFontsDefd := MFontsDefd + 1;
if (MFontsDefd > SizMFontTable) then
begin
complain (ERRREALBAD);
writestrng(mustfmnam, true);
writeln(logfile,'---not loadable. Size of Music Font table too small');
writestrng(mustfmnam,false);
writeln(' cannot be loaded. Too many music fonts. Table too small.');
jumpout;
end;
i := MFontsDefd;
new (MFontTable[i]);
with MFontTable[i]^ do
begin
Staffsize := stfsiz;
Family := fam;
DesSize := design;
strcopy (mustfmnam.str, FontName.str, mustfmnam.len);
FontName.len := mustfmnam.len;
Cksum := cksm;
ghu := round (gwidth / QNOTEGHUS);
gvu := round (linesp / QNOTEGVUS);
DVIFontNum := GDVIFN + 1;
Isdefined := false;
end;
GDVIFN := GDVIFN + 1;
(* call someone to do the defns of cdp, cht, cwd foreach beam *)
definebeams (MFontTable[i]);
fonttobedefined ('M', i);
GetMusFont := i;
99:
end;
{---------------------------------------------------}
function GetVectFont (size : VThickness; vk : VectKind) : VecIndex;
label 20, 99;
var vectfmnam : strng;
found, i : VecIndex;
design, p1, p2, w0, w1, maxveclen, p6, p7 : ScaledPts;
cksm, r, k : integer;
begin
(* see if it already exists *)
found := 0;
for i := 1 to VFontsDefd do
with VFontTable[i]^ do
begin
if ((psize = size) and
(vkind = vk)) then
begin
found := i;
goto 20;
end;
end; (* with *)
20:
if (found <> 0) then
begin
GetVectFont := found;
goto 99;
end;
(* Not here--go get it *)
for k := 1 to ARRLIMIT do
vectfmnam.str[k] := ' ';
r := 0;
case (vk) of
VKCirc : vectfmnam.str[r+1] := 'c';
VKVert : vectfmnam.str[r+1] := 'v';
VKHort : vectfmnam.str[r+1] := 'h';
end; (*case *)
vectfmnam.str[r+2] := 'v';
vectfmnam.str[r+3] := 'e';
vectfmnam.str[r+4] := 'c';
if (size <= 9) then
begin
vectfmnam.str[r+5] := xchr[size + xord['0']];
vectfmnam.str[r+6] := '.';
vectfmnam.str[r+7] := 't';
vectfmnam.str[r+8] := 'f';
vectfmnam.str[r+9] := 'm';
vectfmnam.str[r+10] := chr(32);
vectfmnam.len := 9 + r;
end
else
begin
vectfmnam.str[r+5] := xchr[(size div 10) + xord['0']];
vectfmnam.str[r+6] := xchr[(size - ((size div 10)*10)) + xord['0']];
vectfmnam.str[r+7] := '.';
vectfmnam.str[r+8] := 't';
vectfmnam.str[r+9] := 'f';
vectfmnam.str[r+10] := 'm';
vectfmnam.str[r+11] := chr(32);
vectfmnam.len := 10 + r;
end;
gettfm (vectfmnam, design, p1, p2, w0, w1, maxveclen, p6, p7, cksm);
VFontsDefd := VFontsDefd + 1;
if (VFontsDefd > SizVFontTable) then
begin
complain (ERRREALBAD);
writestrng(vectfmnam, true);
writeln(logfile,'---not loadable. Size of Vector Font table too small');
writestrng(vectfmnam,false);
writeln(' cannot be loaded. Too many vector fonts. Table too small.');
jumpout;
end;
i := VFontsDefd;
new (VFontTable[i]);
with VFontTable[i]^ do
begin
vkind := vk;
psize := size;
DesSize := design;
if (vk = VKVert) then
PenSize := w1
else
PenSize := w0;
PenSize := round (size * (MAXVECLENsp / 16.0));
MaxVectLen := maxveclen;
strcopy (vectfmnam.str, FontName.str, vectfmnam.len);
FontName.len := vectfmnam.len;
Cksum := cksm;
Isdefined := false;
DVIFontNum := GDVIFN + 1;
end;
GDVIFN := GDVIFN + 1;
definevectors (VFontTable[i]);
(* someone asked for it, so they must want it, and we should fntdef it *)
fonttobedefined ('V', i);
GetVectFont := i;
99:
end;
{----------------------------------------------------------}
function GetLabFont (style : integer) : integer;
label 30, 99;
var labtfmnam : strng;
found, i : integer;
design, p1, space, p3, p4, p5, p6, p7 : ScaledPts;
cksm, r, k : integer;
begin
if (style > MAXLABELFONTS) then
style := 1;
found := 0;
for i := 1 to LFontsDefd do
with LFontTable[i]^ do
begin
if (internalnumber = style) then
begin
found := i;
goto 30;
end;
end;
30:
if (found <> 0) then
begin
GetLabFont := found;
goto 99;
end;
for k := 1 to ARRLIMIT do
labtfmnam.str[k] := ' ';
r := 0;
labtfmnam.str[r + 1] := 'c';
labtfmnam.str[r + 2] := 'm';
case style of
1: begin (* cmtt10 *)
labtfmnam.str[r + 3] := 't';
labtfmnam.str[r + 4] := 't';
labtfmnam.str[r + 5] := '1';
labtfmnam.str[r + 6] := '0';
k := r + 6;
end;
2: begin (* cmb10 *)
labtfmnam.str[r + 3] := 'b';
labtfmnam.str[r + 4] := '1';
labtfmnam.str[r + 5] := '0';