{---------------------------------------------------}  
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';