
(*$b0*)

program tyldvidvi(input,output);
(* ----------------------------------------------------------
        TeXtyl  line-drawing interface for TeX.
	      copyright (c) 1987 John S. Renner 
	      	All rights reserved.
        
ABSTRACT: TeXtyl reads in a DVI file, and processes 'specials'
        that refer to graphics capabilities that it knows about,
        like line, spline, ThickThinSpline, and musical 
        beams and slurs. TeXtyl then outputs a new DVI file, 
        with the special-macros expanded and converted to 
        DVI-commands for character setting.
        
DEPENDENCIES:  Few assumptions about Pascal are assumed. All
        identifiers are unique to eight characters. There are
        notes to indicate system-dependencies.
        I assume the standard definition of "READ(fil, x)" to be
        equivalent to "x := fil^; GET(fil)" , and
        "WRITE(fil, x)" == "fil^ := x; PUT(fil)" .
	Arrays are passed by reference (VAR) for efficiency.
        See also the "sysdependent"  procedure; 
        Problem areas, or areas for expansion are marked with ###

-------------------------------------------------------------*) 
(* Revision History:
    Jun. 1986  v1.0   Basic version of TeXtyl
    Dec. 1986  v1.1   Added adaptive subdivision for spline
    			interpolation. Added Cardinal basis.
    Mar. 1987  v1.2   Added F and W flags for beginfigure
			to allow required and/or actual dimensions
    			to interface with files output by the
			DP drawing program from Carnegie-Mellon
			also various fixes
    Apr. 1987  v1.3   Added linestyles (dotted, dashed, dotdashed)
			
*)

label
    666, 30; 
(*=====================CONST============================*)
#include "tylext.h"
#include "texpaths.h"

const
  TylVersion = 'This is TeXtyl, Version 1.30';
		    (* for dvi-commands *)
  PUT1		 = 133;
  SET1		 = 128;
  PUTRULE	 = 137;
  NOP		 = 138;
  PUSH		 = 141;
  POP		 = 142;
  RIGHTLEFT	 = 143;
  DOWNUP	 = 157;
  FONTDEF	 = 244;
  USEFONT	 = 236; 
  OURFONTFLAG	 = 256; (* our special 'byte' value flag *)

  USESTDAREA = 0;    (* flag to use the 'standard' area to find .tfm files *)

        (* some conversions and numbers *)
  SPPERPT	 = 65536;   (* scaled points per printers point *)
  SPPERMM	 = 186468;  (* scaled pts per millimetre *)

  RADTODEG	 = 57.29577952;	 (* degrees per radian *)
  DEGTORAD	 = 0.0174532925; (* radians per degree *)
  PI		 = 3.141592654;

  TWO16 =      65536; 	(* 2 ^ 16 *)
  TWO20 =    1048576;	(* 2 ^ 20 *)
  TWO23 =    8388608;
  TWO24 =   16777216;
  TWO27 =  134217728;
  TWO31 = 2147483647; (* 2^31 - 1 *)

  BIGREAL = 1.0e30;
  MAXVECLENsp	= 262144; (*  Normal maximum length of longest
  			   *  vector-font character in scaled points
			   *)
 (* Music Font dependent constants *)
  DOTCHAR   	= 127;   (* ascii number of char that is a dot *)
  QNOTEGHUS 	= 18.0;  (* MF: Global Horizontal Units for a Quarternote *)
  QNOTEGVUS 	= 16.0;  (* MF: Global Vertical units for a quarternote *)
  GBMGHUS   	= 12.0;  (* MF: horizontal units for a grace beam *)
  GBMGVUS   	= 9.0;

  BMSTART 	= 0;  BMEND = 69;  (* indices for start/end of the beam chars *)
  LOBM1   	= 0;	     (* indices for the regular beam chars that *)
  HIBM1   	= 34;	     (*   are 1 quarternote long, and *)
  LOBM1p5 	= 35;	     (*   for those that are 1.5 quarternotes long *)
  HIBM1p5 	= 69;
  
  GBMSTART 	= 70; GBMEND = 105;  (* indices for the grace beams *)
  LOGBMp5  	= 70;	        (* indices for grace beam chars that *)
  HIGBMp5  	= 87;		(* are 0.5 grace quarternote long, and *)
  LOGBMp66 	= 88;		(* 0.66 grace quarternotes long *)
  HIGBMp66 	= 105;

  LoVThick 	= 1;		(* Bounds for Vector char thicknesses *)
  HiVThick 	= 13;

  SizVFontTable	= 39; (* size of the Vector Font Table *) { 3*HiVThick }
  SizMFontTable	= 18;(* size of the Music Font Table *)
  MAXLABELFONTS	= 5;
  SizLFontTable = MAXLABELFONTS;  (* size of the Label Font Table *)

  MAXCTLPTS 	= 63; (* max number of control points *)
  MAXCTLPTSp3	= 66; (* max control points + 3 *)
  ARRLIMIT  	= 100;	(* limit for strings and other arrays *)
  MAXSPLINESEGS = 480;  (* max number of spline segments *)
  MAXOLEN  	= 128;	(* max length of Ostring that holds bytes of dvi cmds *)
  MAXTBDs   	= 50;	(* max number of Fonts-to-be-Defined *)

  MAXDVISTRINGS	= 600;	(* max number of DVI Ostrings per page *)
  TFMSIZE 	= 8000;	(* size of TFM array to hold .tfm file info *)
  
	  	(* Numeric names for the TeXtyl primitives *)
  Aline		 = 1; (* should be first *)
  Aspline	 = 2;
  Attspline	 = 3;
  Abeam		 = 4;
  Atieslur	 = 5;
  Aarc		 = 6;
  Alabel	 = 7;
  Afigure	 = 8; (* should be last one *)

  MAXFONTS 	= 60; 	(* number of TeX fonts to keep track of *)
  STACKSIZE 	= 50; 	(* size of stack for pushes and pops *)
  AREALENGTH 	= TYLPATHLEN;  (* see also "sysdependent" proc for this value*)

  CR 	= 13;	(* numbers of certain ascii characters  *)
  LF 	= 10;
  HT 	= 9;
  FF 	= 12;
  ERRSIGNAL 	= '?';
  ERRNOTBAD	= 0;
  ERRBAD 	= 1;
  ERRREALBAD	= 2;
    

  READACCESS	= 4;
  WRITEACCESS	= 2;
  NOPATH	= 0;
  FONTPATH	= 3;



(*===========================TYPES=============================*)
type
        (* ---- Bytes ---- *)

   Inbyt 	= -128 .. 127;

   OctByt 	= 0 .. 256;   (* DVI commands are 0..255, but we need
	                          one more for an internal flag *)
   bytefile = packed file of Inbyt;

        (* ---- Strings ---- *)
   asciicode 	= 32 .. 126; 
   charstring 	= packed array [1 .. ARRLIMIT] of char;
   ascstring 	= packed array [1 .. ARRLIMIT] of asciicode;
		(* rep for character strings *)
   strng 	= record 
	            len: 0 .. ARRLIMIT;
	            str:charstring;
	        end;
		(* rep for ascii strings *)
   astrng 	= record 
	            len: 0 .. ARRLIMIT;
	            str: ascstring;
	        end; 
		(* byte strings *)
   pOstring 	= ^Ostring;
   Ostring  	= packed array[1 .. MAXOLEN] of OctByt;

        (* ---- PUBLIC types ---- *)
   VThickness 	= LoVThick .. HiVThick;
   VectKind   	= (VKCirc, VKVert, VKHort);
   BeamKind   	= (regular, grace);
   SplineKind 	= (BSPL, INTBSPL, CATROM, CARD);
   LineStyle	= (solid, dotted, dashed, dotdash);
   ScaledPts  	= integer;
   MusIndex   	= integer;
   VecIndex   	= integer;

   ThickAryType		= array[0 .. MAXSPLINESEGS] of VThickness;
   SplineSegments 	= array[1  ..  MAXSPLINESEGS, 1 .. 2] of ScaledPts;
   ControlPoints  	= array [0 .. MAXCTLPTSp3, 1 .. 2] of ScaledPts;


        (* ----- Private Types ---- *)
   FontInfRec = record
                  Cht, Cdp, Cwd : ScaledPts;
                  Angle : real;
                  end;

   pVectFontInfRec	= ^VectFontInfRec;   (* vector font info *)
   VectFontInfRec	= record
			  vkind : VectKind;
			  DesSize : ScaledPts;
			  PenSize : ScaledPts;
			  psize : VThickness;
			  MaxVectLen : ScaledPts;
			  FontName : strng;
			  Cksum : integer;
			  Isdefined : boolean;
			  DVIFontNum: integer;
			  FontInfo : array [0 .. 127] of FontInfRec;
			  end;

   pMusFontInfRec 	= ^MusFontInfRec;	(* music font info *)
   MusFontInfRec  	= record
			  DesSize : ScaledPts;
			  Family : integer;
			  FontName : strng;
			  Cksum : integer;
			  Isdefined : boolean;
			  DVIFontNum: integer;
			  Staffsize : integer;
			  ghu : ScaledPts;
			  gvu : ScaledPts;
			  FontInfo : array [0 .. 127] of FontInfRec;
			  end;

   pLabFontInfRec	= ^LabFontInfRec;  (* label fonts info *)
   LabFontInfRec	= record
   			  DesSize : ScaledPts;
   			  FontName : strng;
			  Cksum : integer;
			  Isdefined : boolean;
			  DVIFontNum : integer;
			  internalnumber : integer;
			  spacewidth : ScaledPts;
			  end;


		(* list of dvi-strings *)
   dvistary 	= array[1 .. MAXDVISTRINGS] of pOstring;

   DVIBuftype 	= record
		  TotByteLen : integer;
		  Numstrings : integer;
		  curstrindex : integer;
		  Dstrings : dvistary;
		  end;

		(* representation of list of fonts that have to be defined
		 *	before we output the BOP of the page we
		 *	just scanned 
		 *)
   ToBeDefinedRec = record
                    which : char; 
                    indx : integer;
                    end;

   stackrec = record 
	      sh, sv, sw, sx, sy, sz: integer;
	      end;

   Stacktype	 = array [0 .. STACKSIZE] of stackrec;

   Oneby4Vector		= array[1 .. 4] of real;
   Fourby4Matrix	= array[1 .. 4, 1 .. 4] of real;
   Oneby5Vector		= array[1 .. 5] of real;
   
   Primitive = Aline .. Afigure;

   pItem	= ^Item;
   figptr	= ^Figure;

   Item = packed record
	   nextitem : pItem;
	   BBlx, BBby, BBrx, BBty : ScaledPts; (* Bounding box *)
	   itemthick : VThickness;
	   itemvec : VectKind;
	   itempatt : LineStyle;
	   case kind : Primitive of
	       Aline : (	lx1, ly1, lx2, ly2 : ScaledPts;
			);
	       Aspline : (	spltype : SplineKind;
				sclosed : boolean;
				dosmarks : integer;
				nsplknots : integer;
				spts : ControlPoints;
			  );
	       Attspline : (	tspltype : SplineKind;
				tclosed : boolean;
				dottmarks : integer;
				nttknots : integer;
				ttpts : ControlPoints;
				ttarry : ThickAryType;
			    );
	       Abeam : (	bx1, by1, bx2, by2 : ScaledPts;
				staf : integer;
				bkind : BeamKind;
			);
	       Atieslur : (	ntknots : integer;
				minth, maxth : VThickness;
				tspts : ControlPoints;
			   );
	       Aarc : (		acentx, acenty : ScaledPts;
				aradius : ScaledPts;
				firstang, lastang : integer;
				narcknots : integer;
				arcpts : ControlPoints;
		       );
	       Alabel : (	labx, laby : ScaledPts;
	       			fontstyle : integer;
				labeltext : strng;
			);
	       Afigure : (	figtheta : real;
				fsx, fsy : real;
				fdx, fdy : ScaledPts;
				preWid, preHt : ScaledPts;
				postWid, postHt : ScaledPts;
				depthnumber : integer;
				body : figptr;
			  );
	      end;

   
   Figure = record
	    things : pItem;
	    end;


(*==============================VARS============================*)
var
   (* ----- Private vars *)
    catrommtx : Fourby4Matrix;	(* basis matrix for catmul-rom splines*)
    bsplmtx : Fourby4Matrix;	(* basis matrix for B-splines *)
    cardmtx : Fourby4Matrix;	(* Cardinal spline matrix *)
    lastPoint : integer;	(* num of output points *)
    intervals : integer;	(* count of spline interval we are on *)
    ourxpos,			(* internal x-position on page *)
    ourypos, 			(* internal y-position on page *)
    ourfontnum : integer;	(* internal number of TeX font currently in use*)
    ourpushdepth : integer;	(* depth of internal pushes *)
    origTexfont : integer;	(* number of TeX font in use before tyling *)

    GDVIBuf : DVIBuftype;	(* Global DVI buffer that contains a list of
    				 * dvi commands for this page. All dvi-cmds
				 * parsed are put here and possibly modified
				 * before being written  to the output file
				 *)

    VFontTable : array [1 .. SizVFontTable] of pVectFontInfRec;
    MFontTable : array [1 .. SizMFontTable] of pMusFontInfRec;
    LFontTable : array [1 .. SizLFontTable] of pLabFontInfRec;
	(* the font tables, and the number of fonts defined in each *)
    VFontsDefd, 
    MFontsDefd,
    LFontsDefd : integer;

    GDVIFN : integer;		   (* dvi font number currently in use *)

			(* table of fonts yet  To-Be-Defined *)
    TBD : array[1 .. MAXTBDs] of  ToBeDefinedRec;
    FTBDs : integer;   		   (* number of fonts to be defined for current page *)

    pageitems : pItem;  (* list of primitives in current use in the current
    			 * figure on the current page
			 *)

    TotBytesWritten : integer; 
    ourq : integer; (* the 'q' for the postpost *)
    specstart: integer;		(* the place in the DVI buffer where the
    				 * start of the special begins.
				 * this is so that we know how far to back up
				 * and over-write the old \special macro string
				 * with the cmds of our 'macro-expansion'
				 *)

    multifigure : integer;	(* depth of definition recursion of figures *)
    didnewfonts : boolean;	(* did we define the new fonts for this page? *)
    prevfont : integer;		(* to keep track of prev font before the
    				 * PUSH and expansion of the special
				 *)
 
    pgfigurenum : integer;	(* figure number for this page *)
    currpagenum : integer;	(* number of page we are on *)
    skiptsclamp : boolean;	(* DEBUG: should we skip post-clamping ties *)
    dviBBlx, dviBBrx, 		(* Bounding box of figure in DVI space *)
    dviBBby, dviBBty : ScaledPts;
    ErrorOccurred : boolean;    (* global flag in case some error happened *)


    thefilename, realnameoffile : charstring; (* used externally *)

  (* ----- End private vars *)


    tfmbyte : Inbyt;

    vaxbyt : Inbyt;

    tfm: array[-100 .. TFMSIZE] of OctByt;

    xord: array [char] of asciicode;
    xchr: array [0 .. 255] of char;
    outname: strng;	(* name of output file *)
    tfmname : strng;	(* name of a .tfm file *)
    dvifname : strng;	(* name of the input dvi file *)
    logfilnam: strng;	(* name of the log file *)

    dvifile: bytefile;	
    tfmfile: bytefile;
    outputfil: bytefile;
    logfile : text;

    curfont: integer;
    s : 0 .. STACKSIZE;
    h, v, w, x, y, z: integer;
    stack: Stacktype;

    font: array [0 .. MAXFONTS] of 
        record 
            num: integer;
            name: astrng;
            checksum: integer;
            scaledsize: integer;
            designsize: integer;
            space: integer;
            bc: integer;
            ec: integer;
            widths: array [0 .. 127] of ScaledPts
        end;
    nf : 0 .. MAXFONTS; 

    MINREAL : real;     (* a system-dependent 'constant' *)
    b0, b1, b2, b3: OctByt; 
    inwidth: array [0 .. 255] of integer;
    tfmchecksum: integer; 
    conv: real;
    trueconv: real; 
    numerator, 
    denominator: integer;
    defaultdirectory: strng;
    mag, 
    magfactor: real; 
    maxv, maxh, maxs : integer;
    maxpages, 
    totalpages : integer;
    resolution: real;
    inpostamble : boolean;
    newbackptr, 
    oldbackptr : integer;    
    p, k : integer;
    waste : integer;
        

(* ==================forward declarations============================ *)

{  These hooks assume that the parameters are filled "correctly",
	and are already transformed into 4th Quadrant DVI-space    }


procedure TylTieSlur (var KnotArray: ControlPoints; 
                      numknots: integer;
                      minthick, maxthick: VThickness); forward;

procedure TylThickThinSpline (thetype : SplineKind; 
			  isclosed : boolean;
                          var KnotArray: ControlPoints; 
                          var ThikThinAry: ThickAryType;
                          numknots: integer;
                          vec: VectKind;
			  patt: LineStyle;
			  domarks : integer); forward;

procedure TylSpline (thetype : SplineKind; 
		      isclosed : boolean;
                      var KnotArray: ControlPoints; 
		      numknots: integer;
                      thick: VThickness; 
		      vec: VectKind;
		      patt: LineStyle;
		      domarks : integer); forward;

procedure TylLine (xl, yb, xr, yt: ScaledPts; 
                     thickness: VThickness; 
		     vec: VectKind;
		     patt: LineStyle); forward;

procedure TylBeam (fromx, fromy, tox, toy: ScaledPts;
	             staffsize : integer; 
		     kind : BeamKind); forward;

procedure TylArc (radius : ScaledPts; 
		  centx, centy : ScaledPts;
		  firstangle, secondangle : integer;
		  thick : VThickness; 
		  vec : VectKind;
		  patt: LineStyle); forward;

procedure TylLabel (xpos, ypos : ScaledPts;
		    fontstyle : integer;
		    phrase : charstring;
		    phraselen : integer); forward;

(*  private procedures *)
procedure definebeams (var M : pMusFontInfRec); forward;
procedure definevectors (var Vec: pVectFontInfRec); forward;
procedure defineNewfonts; forward;
procedure doTylArc (iscircle : boolean; var apts : ControlPoints;
		    numknots : integer; thick : VThickness; 
		    vec : VectKind; patt : LineStyle); forward;
procedure strcopy (src : charstring; var dest : charstring; 
			len : integer); forward;
procedure writestrng (s :strng; tologfile : boolean); forward;
(* end private procs *)

{------------------------------------------------------}
procedure jumpout;
begin
    goto 666; (* global label *)
end; 


(*-------------- System Dependent stuff ----------------------*)
(*  the default-directory should be where the .tfm files are 
 *  to be found. the string len should reflect this name.
 *  Check with the local site maintainer about any necessary
 *  additions to the reset and rewrite procedures for opening
 *  8-bit binary files.
 *)





procedure sysdependent;
 begin


    setpaths;

    defaultdirectory.str := TYLPATH;
    defaultdirectory.len := TYLPATHLEN; (* AREALENGTH const should be this, too *)
    writeln(TylVersion,' for Berkeley Unix');

    resolution := 300.0; (* just a number *)
    MINREAL := 1.0e-20;  (* so that we avoid some underflows *)
 end;

{------------------------------------------------------------}
procedure complain (severity :integer);
begin
 writeln(logfile,'Error in fig#',pgfigurenum:0,' on page ',currpagenum:0);
 case severity of
   ERRNOTBAD : begin
   		write (ERRSIGNAL);
   		end;
   ERRBAD : begin
   		write (ERRSIGNAL);
                ErrorOccurred := true;
   	    end;
   ERRREALBAD : begin
 	        write (ERRSIGNAL,'! ');
                ErrorOccurred := true;
   		end;
			  
  end; (* case *)
end;

function opendvifile : boolean;
begin

    strcopy (dvifname.str, thefilename, dvifname.len);
    thefilename[dvifname.len + 1] := ' ';
    if (testaccess (READACCESS, NOPATH)) then
      begin
      reset (dvifile, realnameoffile);
      opendvifile := true;
      end
    else
      begin
      writestrng(dvifname, false);
      writeln(' : DVI file not found/readable ');
      opendvifile := false;
      end;  

end;

function opentfmfile : boolean;
begin

  strcopy (tfmname.str, thefilename, tfmname.len);
  thefilename[tfmname.len + 1] := ' ';
  if (testaccess (READACCESS, FONTPATH)) then
    begin
    reset(tfmfile, realnameoffile);
    opentfmfile := true;
    end
  else
    begin
    writestrng(tfmname, false);
    writeln(' : TFM file not fount/readable ');
    opentfmfile := false;
    end;

end;

procedure openoutputfile;
begin

  strcopy (outname.str, thefilename, outname.len);
  thefilename[outname.len + 1] := ' ';
  if (testaccess (WRITEACCESS, NOPATH)) then
    rewrite (outputfil, realnameoffile)
  else
    begin
    writestrng(outname, false);
    writeln(' : Output file not writable');
    jumpout;
    end;

end;  

procedure openlogfile;
begin

  strcopy (logfilnam.str, thefilename, logfilnam.len);
  thefilename[logfilnam.len + 1] := ' ';
  if (testaccess (WRITEACCESS, NOPATH)) then
    rewrite (logfile, realnameoffile)
  else
    begin
    writestrng(logfilnam, false);
    writeln(' : Log file not writable');
    jumpout;
    end;

end;


(* &&Module Tylsupport *)


{---------------------------------------------------}
procedure ClearBufString (var s : pOstring);
(* clear a DVI buffer string  to contain no-ops*)
var i : integer;
begin
  for i := 1 to MAXOLEN do
    s^[i] := NOP;
end;

{---------------------------------------------------}
function NewBufString : pOstring;
var s : pOstring;
begin
 new (s);
 ClearBufString (s);
 NewBufString := s;
end;



(* NOTATION::
 *       All procedures that put a dvi-command into the
 *  temporary buffer are prefixed with "cmd"...
 *       Functions that deal with reading .tfm files are prefixed
 *  with "T" or have "tfm" in their names.       
 *       Functions that deal with reading DVI files are
 *  prefixed with a "D". 
 *)

{--------------------------------------------}
procedure cmd1byte (cmd : OctByt);
begin
  with GDVIBuf do
    begin
    if (Numstrings > MAXDVISTRINGS) then (* buffer full *)
      begin
      complain (ERRREALBAD);
      writeln (logfile,'error: too many dvistrings. Totbytes = ',TotByteLen);
      jumpout;
      end;
    if (curstrindex > MAXOLEN) then  (* current string full *)
      begin
      Numstrings := Numstrings + 1;
      if (Dstrings[Numstrings] <> nil) then
         dispose (Dstrings[Numstrings]);
      Dstrings[Numstrings] := NewBufString;
      ClearBufString(Dstrings[Numstrings]);
      curstrindex := 1;
      end;
    Dstrings[Numstrings]^[curstrindex] := cmd; (* insert command byte *)
    TotByteLen := TotByteLen + 1;
    curstrindex := curstrindex + 1;
    end;
end;
      

{---------------------------------------------------}
procedure cmd2byte (cmd : integer);
begin
  cmd1byte (cmd div 256);
  cmd1byte (cmd mod 256);
end;

{---------------------------------------------------}
procedure cmd3byte (cmd : integer);
begin
  cmd1byte (cmd div TWO16);
  cmd1byte ((cmd div 256) mod 256);
  cmd1byte (cmd mod 256);
end;  

{---------------------------------------------------}
procedure cmd4byte (cmd : integer);
var tmp : integer;
begin
  tmp := cmd;
  if (tmp >= 0) then
    begin
    cmd1byte (tmp div TWO24);
    end
  else
    begin
    tmp := tmp + TWO31 + 1; (* need the +1 *)
    cmd1byte (tmp div TWO24 + 128);
    end; 
  tmp := tmp mod TWO24;
  cmd1byte (tmp div TWO16);
  tmp := tmp mod TWO16;
  cmd1byte (tmp div 256);
  cmd1byte (tmp mod 256);
end;

{---------------------------------------------------}
(* ### may be system dependent as integers are assumed 
   to be signed 32-bits *)

procedure cmdSigned (i : integer; numbytes: integer);
var tmp : integer;
begin
  if (numbytes = 4) then
    cmd4byte (i)
  else
    begin	 (* <= 3 bytes *)
    tmp := i;
    if (numbytes = 3) then
      begin
      if (tmp < 0) then
        tmp := tmp + TWO24;
      cmd1byte (tmp div TWO16);
      tmp := tmp mod TWO16;
      cmd1byte (tmp div 256);
      end;
    if (numbytes = 2) then
      begin
      if (tmp < 0) then
	tmp := tmp + TWO16;
      cmd1byte (tmp div 256);
      end;  
    if (numbytes = 1) then
      begin
      if (tmp < 0) then
        tmp := tmp + 256;
      end;
    cmd1byte (tmp mod 256); (* for all *)
    end;
end;



{---------------------------------------------------}
function Tgetvaxbyte : OctByt;
label 9999;
begin
  tfmbyte := tfmfile^;
  if (tfmbyte < 0) then
    Tgetvaxbyte := tfmbyte + 256
  else 
    Tgetvaxbyte := tfmbyte;
  if (eof (tfmfile)) then
    begin
    complain (ERRREALBAD);
    writeln (logfile,' early EOF of tfm file! ');
    goto 9999;
    end;
  get (tfmfile);
9999:       
end;


{---------------------------------------------------}
procedure readtfmword;

begin

  b0 := Tgetvaxbyte;
  b1 := Tgetvaxbyte;
  b2 := Tgetvaxbyte;
  b3 := Tgetvaxbyte;

end; 


{---------------------------------------------------}
function DVaxByte : OctByt;
label 99;
begin
  vaxbyt := dvifile^;
  if (eof (dvifile)) then
    begin
    DVaxByte := 0;
    goto 99;
    end;
  if (vaxbyt < 0) then
    DVaxByte := vaxbyt + 256
  else  
    DVaxByte := vaxbyt;
  get (dvifile);
99:     
end;



{---------------------------------------------------}
(* get a byte from the DVI file, but do not copy it into the DVIbuffer *)
function Dgrabbyte : integer;
var
    b: OctByt;
begin
  if eof(dvifile) then 
    Dgrabbyte := 0
  else
     begin

     b := DVaxByte;

     Dgrabbyte := b;
     end;
end;


{---------------------------------------------------}
function Dget1byte : integer;
var
    b: OctByt;
begin
    if eof(dvifile) then 
	Dget1byte := 0
    else
     begin

     b := DVaxByte;

     Dget1byte := b
    end;
    cmd1byte(b);
end;

{---------------------------------------------------}
function Dsign1byte : integer;
var
    b: OctByt;
begin

    b := DVaxByte;

    if b < 128 then 
	Dsign1byte := b
    else 
	Dsign1byte := b - 256;
    cmd1byte(b);
end; 

{---------------------------------------------------}
function Dget2byte : integer;
var
    a, b: OctByt;
begin

    a := DVaxByte;
    b := DVaxByte;

    Dget2byte := a * 256 + b;
    cmd1byte(a);
    cmd1byte(b);
end;

{---------------------------------------------------}
function Dsign2byte : integer;
var
    a, b: OctByt;
begin

    a := DVaxByte;
    b := DVaxByte;

    if a < 128 then 
	Dsign2byte := a * 256 + b
    else 
	Dsign2byte := (a - 256) * 256 + b;
    cmd1byte(a);
    cmd1byte(b);
end;

{---------------------------------------------------}
function Dget3byte : integer;
var
    a, b, c: OctByt;
begin

    a := DVaxByte;
    b := DVaxByte;
    c := DVaxByte;

    Dget3byte := (a * 256 + b) * 256 + c;
    cmd1byte(a);
    cmd1byte(b);
    cmd1byte(c);
end;

{---------------------------------------------------}
function Dsign3byte : integer;
var
    a, b, c: OctByt;
begin

    a := DVaxByte;
    b := DVaxByte;
    c := DVaxByte;

    if a < 128 then 
	Dsign3byte := (a * 256 + b) * 256 + c
    else 
	Dsign3byte := ((a - 256) * 256 + b) * 256 + c;
    cmd1byte(a);
    cmd1byte(b);
    cmd1byte(c);    
end;

{---------------------------------------------------}
function Dsign4byte : integer;
var
    a, b, c, d: OctByt;
begin

    a := DVaxByte;
    b := DVaxByte;
    c := DVaxByte;
    d := DVaxByte;

    if a < 128 then 
	Dsign4byte := ((a * 256 + b) * 256 + c) * 256 + d
    else 
	Dsign4byte := (((a - 256) * 256 + b) * 256 + c) * 256 + d;
    cmd1byte(a);
    cmd1byte(b);
    cmd1byte(c);
    cmd1byte(d);    
end;


{---------------------------------------------------}
(* write a byte out to the ouput file, but if we
 * encounter the font flag, define the new fonts, and
 * continue
 *)
procedure OutputByte (b : OctByt);
var x : Inbyt;
    n : integer;
begin
   n := b;
   if (n = OURFONTFLAG) then
     begin    (* our special macro-flag *)
     n := NOP; (* nullify it *)
     if (not didnewfonts) then
       begin
       didnewfonts := true;       
       defineNewfonts; (* expand the defns in the outfile itself *)
       end;
     end;  (* if *)

	if (n > 127) then
	  begin
	  x := n - 256;
	  end
	else
	  x := n;
	outputfil^ := x;
	put (outputfil);

  TotBytesWritten := TotBytesWritten + 1;  (* keep count of all bytes *)
end;

{---------------------------------------------------} 
procedure Output2Byte (i : integer);
begin
  OutputByte (i div 256);
  OutputByte (i mod 256);
end;

{---------------------------------------------------}  
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';
	k := r + 5;
        end;
     3: begin		(* cmsl10 *)
        labtfmnam.str[r + 3] := 's';
        labtfmnam.str[r + 4] := 'l';
        labtfmnam.str[r + 5] := '1';
        labtfmnam.str[r + 6] := '0';
	k := r + 6;
        end;
     4: begin		(* cmtt8 *)
        labtfmnam.str[r + 3] := 't';
        labtfmnam.str[r + 4] := 't';
        labtfmnam.str[r + 5] := '8';
	k := r + 5;
        end;
     5: begin		(* cmsl8 *)
        labtfmnam.str[r + 3] := 's';
        labtfmnam.str[r + 4] := 'l';
        labtfmnam.str[r + 5] := '8';
	k := r + 5;
        end;
   end; (* case *)
  labtfmnam.str[k + 1] := '.';
  labtfmnam.str[k + 2] := 't';
  labtfmnam.str[k + 3] := 'f';
  labtfmnam.str[k + 4] := 'm';

  labtfmnam.str[k+5] := chr(32);

  labtfmnam.len := k + 4;

  gettfm (labtfmnam, design, p1, space, p3, p4, p5, p6, p7, cksm);

  LFontsDefd := LFontsDefd + 1;

  if (LFontsDefd > SizLFontTable) then
     begin
       complain (ERRREALBAD);
       writestrng(labtfmnam, true);
       writeln(logfile,'---not loadable. Size of Label Font table too small');
       writestrng(labtfmnam,false);
       writeln(' cannot be loaded. Too many label fonts. Table too small.');
       jumpout;
     end;

  i := LFontsDefd;
  new (LFontTable[i]);
  with LFontTable[i]^ do
    begin
    strcopy (labtfmnam.str, FontName.str, labtfmnam.len);
    FontName.len := labtfmnam.len;
    Cksum := cksm;
    DesSize := design;
    internalnumber := style;
    spacewidth := space;
    DVIFontNum := GDVIFN +1;
    Isdefined := false;
    end;  (* with *)

  GDVIFN := GDVIFN + 1;
  fonttobedefined ('L', i);
  GetLabFont := i;
99:
end;  
    

{------------------------------------------------}
function vectangle (dx, dy : integer) :real;
begin
  if (dx <> 0) then
    vectangle := arctan (dy / (dx * 1.0)) * RADTODEG
  else
    begin
    if (dy > 0) then 
      vectangle := 90.0
    else
      vectangle := -90.0;
    end;
end;


{-----------------------------------------------------------}
procedure definevectors (* var Vec: pVectFontInfRec *);
var  units : real;
begin
  units := Vec^.MaxVectLen / 16.0;
with Vec^.FontInfo[  0] do begin
    Cht := round( 15.9688 * units);
    Cdp := 0;
    Cwd := round(  0.9981 * units);
    Angle :=   86.4237;
end;

with Vec^.FontInfo[  1] do begin
    Cht := round( 15.8764 * units);
    Cdp := 0;
    Cwd := round(  1.9846 * units);
    Angle :=   82.8750;
end;

with Vec^.FontInfo[  2] do begin
    Cht := round( 15.7260 * units);
    Cdp := 0;
    Cwd := round(  2.9486 * units);
    Angle :=   79.3803;
end;

with Vec^.FontInfo[  3] do begin
    Cht := round( 15.5223 * units);
    Cdp := 0;
    Cwd := round(  3.8806 * units);
    Angle :=   75.9638;
end;

with Vec^.FontInfo[  4] do begin
    Cht := round( 15.2717 * units);
    Cdp := 0;
    Cwd := round(  4.7724 * units);
    Angle :=   72.6460;
end;

with Vec^.FontInfo[  5] do begin
    Cht := round( 14.9813 * units);
    Cdp := 0;
    Cwd := round(  5.6180 * units);
    Angle :=   69.4440;
end;

with Vec^.FontInfo[  6] do begin
    Cht := round( 14.6585 * units);
    Cdp := 0;
    Cwd := round(  6.4131 * units);
    Angle :=   66.3706;
end;

with Vec^.FontInfo[  7] do begin
    Cht := round( 14.3108 * units);
    Cdp := 0;
    Cwd := round(  7.1554 * units);
    Angle :=   63.4349;
end;

with Vec^.FontInfo[  8] do begin
    Cht := round( 13.9452 * units);
    Cdp := 0;
    Cwd := round(  7.8442 * units);
    Angle :=   60.6422;
end;

with Vec^.FontInfo[  9] do begin
    Cht := round( 13.5680 * units);
    Cdp := 0;
    Cwd := round(  8.4800 * units);
    Angle :=   57.9946;
end;

with Vec^.FontInfo[ 10] do begin
    Cht := round( 13.1847 * units);
    Cdp := 0;
    Cwd := round(  9.0645 * units);
    Angle :=   55.4915;
end;

with Vec^.FontInfo[ 11] do begin
    Cht := round( 12.8000 * units);
    Cdp := 0;
    Cwd := round(  9.6000 * units);
    Angle :=   53.1301;
end;

with Vec^.FontInfo[ 12] do begin
    Cht := round( 12.4178 * units);
    Cdp := 0;
    Cwd := round( 10.0895 * units);
    Angle :=   50.9061;
end;

with Vec^.FontInfo[ 13] do begin
    Cht := round( 12.0412 * units);
    Cdp := 0;
    Cwd := round( 10.5361 * units);
    Angle :=   48.8141;
end;

with Vec^.FontInfo[ 14] do begin
    Cht := round( 11.6726 * units);
    Cdp := 0;
    Cwd := round( 10.9431 * units);
    Angle :=   46.8476;
end;

with Vec^.FontInfo[ 15] do begin
    Cht := round( 11.3137 * units);
    Cdp := 0;
    Cwd := round( 11.3137 * units);
    Angle :=   45.0000;
end;

with Vec^.FontInfo[ 16] do begin
    Cht := round( 10.9431 * units);
    Cdp := 0;
    Cwd := round( 11.6726 * units);
    Angle :=   43.1524;
end;

with Vec^.FontInfo[ 17] do begin
    Cht := round( 10.5361 * units);
    Cdp := 0;
    Cwd := round( 12.0412 * units);
    Angle :=   41.1859;
end;

with Vec^.FontInfo[ 18] do begin
    Cht := round( 10.0895 * units);
    Cdp := 0;
    Cwd := round( 12.4178 * units);
    Angle :=   39.0939;
end;

with Vec^.FontInfo[ 19] do begin
    Cht := round(  9.6000 * units);
    Cdp := 0;
    Cwd := round( 12.8000 * units);
    Angle :=   36.8699;
end;

with Vec^.FontInfo[ 20] do begin
    Cht := round(  9.0645 * units);
    Cdp := 0;
    Cwd := round( 13.1847 * units);
    Angle :=   34.5085;
end;

with Vec^.FontInfo[ 21] do begin
    Cht := round(  8.4800 * units);
    Cdp := 0;
    Cwd := round( 13.5680 * units);
    Angle :=   32.0054;
end;

with Vec^.FontInfo[ 22] do begin
    Cht := round(  7.8442 * units);
    Cdp := 0;
    Cwd := round( 13.9452 * units);
    Angle :=   29.3578;
end;

with Vec^.FontInfo[ 23] do begin
    Cht := round(  7.1554 * units);
    Cdp := 0;
    Cwd := round( 14.3108 * units);
    Angle :=   26.5651;
end;

with Vec^.FontInfo[ 24] do begin
    Cht := round(  6.4131 * units);
    Cdp := 0;
    Cwd := round( 14.6585 * units);
    Angle :=   23.6294;
end;

with Vec^.FontInfo[ 25] do begin
    Cht := round(  5.6180 * units);
    Cdp := 0;
    Cwd := round( 14.9813 * units);
    Angle :=   20.5560;
end;

with Vec^.FontInfo[ 26] do begin
    Cht := round(  4.7724 * units);
    Cdp := 0;
    Cwd := round( 15.2717 * units);
    Angle :=   17.3540;
end;

with Vec^.FontInfo[ 27] do begin
    Cht := round(  3.8806 * units);
    Cdp := 0;
    Cwd := round( 15.5223 * units);
    Angle :=   14.0362;
end;

with Vec^.FontInfo[ 28] do begin
    Cht := round(  2.9486 * units);
    Cdp := 0;
    Cwd := round( 15.7260 * units);
    Angle :=   10.6197;
end;

with Vec^.FontInfo[ 29] do begin
    Cht := round(  1.9846 * units);
    Cdp := 0;
    Cwd := round( 15.8764 * units);
    Angle :=    7.1250;
end;

with Vec^.FontInfo[ 30] do begin
    Cht := round(  0.9981 * units);
    Cdp := 0;
    Cwd := round( 15.9688 * units);
    Angle :=    3.5763;
end;

with Vec^.FontInfo[ 31] do begin
    Cht := 0;
    Cdp := 0;
    Cwd := round( 16.0000 * units);
    Angle :=    0.0000;
end;

with Vec^.FontInfo[ 32] do begin
     Cdp := round(  0.9981 * units);
     Cht := 0;
    Cwd := round( 15.9688 * units);
    Angle :=   -3.5763;
end;

with Vec^.FontInfo[ 33] do begin
     Cdp := round(  1.9846 * units);
     Cht := 0;
    Cwd := round( 15.8764 * units);
    Angle :=   -7.1250;
end;

with Vec^.FontInfo[ 34] do begin
     Cdp := round(  2.9486 * units);
     Cht := 0;
    Cwd := round( 15.7260 * units);
    Angle :=  -10.6197;
end;

with Vec^.FontInfo[ 35] do begin
     Cdp := round(  3.8806 * units);
     Cht := 0;
    Cwd := round( 15.5223 * units);
    Angle :=  -14.0362;
end;

with Vec^.FontInfo[ 36] do begin
     Cdp := round(  4.7724 * units);
     Cht := 0;
    Cwd := round( 15.2717 * units);
    Angle :=  -17.3540;
end;

with Vec^.FontInfo[ 37] do begin
     Cdp := round(  5.6180 * units);
     Cht := 0;
    Cwd := round( 14.9813 * units);
    Angle :=  -20.5560;
end;

with Vec^.FontInfo[ 38] do begin
     Cdp := round(  6.4131 * units);
     Cht := 0;
    Cwd := round( 14.6585 * units);
    Angle :=  -23.6294;
end;

with Vec^.FontInfo[ 39] do begin
     Cdp := round(  7.1554 * units);
     Cht := 0;
    Cwd := round( 14.3108 * units);
    Angle :=  -26.5651;
end;

with Vec^.FontInfo[ 40] do begin
     Cdp := round(  7.8442 * units);
     Cht := 0;
    Cwd := round( 13.9452 * units);
    Angle :=  -29.3578;
end;

with Vec^.FontInfo[ 41] do begin
     Cdp := round(  8.4800 * units);
     Cht := 0;
    Cwd := round( 13.5680 * units);
    Angle :=  -32.0054;
end;

with Vec^.FontInfo[ 42] do begin
     Cdp := round(  9.0645 * units);
     Cht := 0;
    Cwd := round( 13.1847 * units);
    Angle :=  -34.5085;
end;

with Vec^.FontInfo[ 43] do begin
     Cdp := round(  9.6000 * units);
     Cht := 0;
    Cwd := round( 12.8000 * units);
    Angle :=  -36.8699;
end;

with Vec^.FontInfo[ 44] do begin
     Cdp := round( 10.0895 * units);
     Cht := 0;
    Cwd := round( 12.4178 * units);
    Angle :=  -39.0939;
end;

with Vec^.FontInfo[ 45] do begin
     Cdp := round( 10.5361 * units);
     Cht := 0;
    Cwd := round( 12.0412 * units);
    Angle :=  -41.1859;
end;

with Vec^.FontInfo[ 46] do begin
     Cdp := round( 10.9431 * units);
     Cht := 0;
    Cwd := round( 11.6726 * units);
    Angle :=  -43.1524;
end;

with Vec^.FontInfo[ 47] do begin
     Cdp := round( 11.3137 * units);
     Cht := 0;
    Cwd := round( 11.3137 * units);
    Angle :=  -45.0000;
end;

with Vec^.FontInfo[ 48] do begin
    Cdp := round ( 11.6726 * units);
    Cht := 0;
    Cwd := round( 10.9431 * units);
    Angle :=  -46.8476;
end;

with Vec^.FontInfo[ 49] do begin
    Cdp := round ( 12.0412 * units);
    Cht := 0;
    Cwd := round( 10.5361 * units);
    Angle :=  -48.8141;
end;

with Vec^.FontInfo[ 50] do begin
    Cdp := round ( 12.4178 * units);
    Cht := 0;
    Cwd := round( 10.0895 * units);
    Angle :=  -50.9061;
end;

with Vec^.FontInfo[ 51] do begin
    Cdp := round ( 12.8000 * units);
    Cht := 0;
    Cwd := round(  9.6000 * units);
    Angle :=  -53.1301;
end;

with Vec^.FontInfo[ 52] do begin
    Cdp := round ( 13.1847 * units);
    Cht := 0;
    Cwd := round(  9.0645 * units);
    Angle :=  -55.4915;
end;

with Vec^.FontInfo[ 53] do begin
    Cdp := round ( 13.5680 * units);
    Cht := 0;
    Cwd := round(  8.4800 * units);
    Angle :=  -57.9946;
end;

with Vec^.FontInfo[ 54] do begin
    Cdp := round ( 13.9452 * units);
    Cht := 0;
    Cwd := round(  7.8442 * units);
    Angle :=  -60.6422;
end;

with Vec^.FontInfo[ 55] do begin
    Cdp := round ( 14.3108 * units);
    Cht := 0;
    Cwd := round(  7.1554 * units);
    Angle :=  -63.4349;
end;

with Vec^.FontInfo[ 56] do begin
    Cdp := round ( 14.6585 * units);
    Cht := 0;
    Cwd := round(  6.4131 * units);
    Angle :=  -66.3706;
end;

with Vec^.FontInfo[ 57] do begin
    Cdp := round ( 14.9813 * units);
    Cht := 0;
    Cwd := round(  5.6180 * units);
    Angle :=  -69.4440;
end;

with Vec^.FontInfo[ 58] do begin
    Cdp := round ( 15.2717 * units);
    Cht := 0;
    Cwd := round(  4.7724 * units);
    Angle :=  -72.6460;
end;

with Vec^.FontInfo[ 59] do begin
    Cdp := round ( 15.5223 * units);
    Cht := 0;
    Cwd := round(  3.8806 * units);
    Angle :=  -75.9638;
end;

with Vec^.FontInfo[ 60] do begin
    Cdp := round ( 15.7260 * units);
    Cht := 0;
    Cwd := round(  2.9486 * units);
    Angle :=  -79.3803;
end;

with Vec^.FontInfo[ 61] do begin
    Cdp := round ( 15.8764 * units);
    Cht := 0;
    Cwd := round(  1.9846 * units);
    Angle :=  -82.8750;
end;

with Vec^.FontInfo[ 62] do begin
    Cdp := round ( 15.9688 * units);
    Cht := 0;
    Cwd := round(  0.9981 * units);
    Angle :=  -86.4237;
end;

with Vec^.FontInfo[ 63] do begin
    Cht := round(  8.0000 * units);
    Cdp := 0;
    Cwd := 0;
    Angle :=   90.0000;
end;

with Vec^.FontInfo[ 64] do begin
    Cht := round(  7.9382 * units);
    Cdp := 0;
    Cwd := round(  0.9923 * units);
    Angle :=   82.8750;
end;

with Vec^.FontInfo[ 65] do begin
    Cht := round(  7.7611 * units);
    Cdp := 0;
    Cwd := round(  1.9403 * units);
    Angle :=   75.9638;
end;

with Vec^.FontInfo[ 66] do begin
    Cht := round(  7.4906 * units);
    Cdp := 0;
    Cwd := round(  2.8090 * units);
    Angle :=   69.4440;
end;

with Vec^.FontInfo[ 67] do begin
    Cht := round(  7.1554 * units);
    Cdp := 0;
    Cwd := round(  3.5777 * units);
    Angle :=   63.4349;
end;

with Vec^.FontInfo[ 68] do begin
    Cht := round(  6.7840 * units);
    Cdp := 0;
    Cwd := round(  4.2400 * units);
    Angle :=   57.9946;
end;

with Vec^.FontInfo[ 69] do begin
    Cht := round(  6.4000 * units);
    Cdp := 0;
    Cwd := round(  4.8000 * units);
    Angle :=   53.1301;
end;

with Vec^.FontInfo[ 70] do begin
    Cht := round(  6.0206 * units);
    Cdp := 0;
    Cwd := round(  5.2680 * units);
    Angle :=   48.8141;
end;

with Vec^.FontInfo[ 71] do begin
    Cht := round(  5.6569 * units);
    Cdp := 0;
    Cwd := round(  5.6569 * units);
    Angle :=   45.0000;
end;

with Vec^.FontInfo[ 72] do begin
    Cht := round(  5.2680 * units);
    Cdp := 0;
    Cwd := round(  6.0206 * units);
    Angle :=   41.1859;
end;

with Vec^.FontInfo[ 73] do begin
    Cht := round(  4.8000 * units);
    Cdp := 0;
    Cwd := round(  6.4000 * units);
    Angle :=   36.8699;
end;

with Vec^.FontInfo[ 74] do begin
    Cht := round(  4.2400 * units);
    Cdp := 0;
    Cwd := round(  6.7840 * units);
    Angle :=   32.0054;
end;

with Vec^.FontInfo[ 75] do begin
    Cht := round(  3.5777 * units);
    Cdp := 0;
    Cwd := round(  7.1554 * units);
    Angle :=   26.5651;
end;

with Vec^.FontInfo[ 76] do begin
    Cht := round(  2.8090 * units);
    Cdp := 0;
    Cwd := round(  7.4906 * units);
    Angle :=   20.5560;
end;

with Vec^.FontInfo[ 77] do begin
    Cht := round(  1.9403 * units);
    Cdp := 0;
    Cwd := round(  7.7611 * units);
    Angle :=   14.0362;
end;

with Vec^.FontInfo[ 78] do begin
    Cht := round(  0.9923 * units);
    Cdp := 0;
    Cwd := round(  7.9382 * units);
    Angle :=    7.1250;
end;

with Vec^.FontInfo[ 79] do begin
    Cht := 0;
    Cdp := 0;
    Cwd := round(  8.0000 * units);
    Angle :=    0.0000;
end;

with Vec^.FontInfo[ 80] do begin
     Cdp := round(  0.9923 * units);
     Cht := 0;
    Cwd := round(  7.9382 * units);
    Angle :=   -7.1250;
end;

with Vec^.FontInfo[ 81] do begin
     Cdp := round(  1.9403 * units);
     Cht := 0;
    Cwd := round(  7.7611 * units);
    Angle :=  -14.0362;
end;

with Vec^.FontInfo[ 82] do begin
     Cdp := round(  2.8090 * units);
     Cht := 0;
    Cwd := round(  7.4906 * units);
    Angle :=  -20.5560;
end;

with Vec^.FontInfo[ 83] do begin
     Cdp := round(  3.5777 * units);
     Cht := 0;
    Cwd := round(  7.1554 * units);
    Angle :=  -26.5651;
end;

with Vec^.FontInfo[ 84] do begin
     Cdp := round(  4.2400 * units);
     Cht := 0;
    Cwd := round(  6.7840 * units);
    Angle :=  -32.0054;
end;

with Vec^.FontInfo[ 85] do begin
     Cdp := round(  4.8000 * units);
     Cht := 0;
    Cwd := round(  6.4000 * units);
    Angle :=  -36.8699;
end;

with Vec^.FontInfo[ 86] do begin
     Cdp := round(  5.2680 * units);
     Cht := 0;
    Cwd := round(  6.0206 * units);
    Angle :=  -41.1859;
end;

with Vec^.FontInfo[ 87] do begin
     Cdp := round(  5.6569 * units);
     Cht := 0;
    Cwd := round(  5.6569 * units);
    Angle :=  -45.0000;
end;

with Vec^.FontInfo[ 88] do begin
    Cdp := round (  6.0206 * units);
    Cht := 0;
    Cwd := round(  5.2680 * units);
    Angle :=  -48.8141;
end;

with Vec^.FontInfo[ 89] do begin
    Cdp := round (  6.4000 * units);
    Cht := 0;
    Cwd := round(  4.8000 * units);
    Angle :=  -53.1301;
end;

with Vec^.FontInfo[ 90] do begin
    Cdp := round (  6.7840 * units);
    Cht := 0;
    Cwd := round(  4.2400 * units);
    Angle :=  -57.9946;
end;

with Vec^.FontInfo[ 91] do begin
    Cdp := round (  7.1554 * units);
    Cht := 0;
    Cwd := round(  3.5777 * units);
    Angle :=  -63.4349;
end;

with Vec^.FontInfo[ 92] do begin
    Cdp := round (  7.4906 * units);
    Cht := 0;
    Cwd := round(  2.8090 * units);
    Angle :=  -69.4440;
end;

with Vec^.FontInfo[ 93] do begin
    Cdp := round (  7.7611 * units);
    Cht := 0;
    Cwd := round(  1.9403 * units);
    Angle :=  -75.9638;
end;

with Vec^.FontInfo[ 94] do begin
    Cdp := round (  7.9382 * units);
    Cht := 0;
    Cwd := round(  0.9923 * units);
    Angle :=  -82.8750;
end;

with Vec^.FontInfo[ 95] do begin
    Cdp := round (  8.0000 * units);
    Cht := 0;
    Cwd := 0;
    Angle :=  -90.0000;
end;

with Vec^.FontInfo[ 96] do begin
    Cht := round(  4.0000 * units);
    Cdp := 0;
    Cwd := 0;
    Angle :=   90.0000;
end;

with Vec^.FontInfo[ 97] do begin
    Cht := round(  3.8806 * units);
    Cdp := 0;
    Cwd := round(  0.9701 * units);
    Angle :=   75.9638;
end;

with Vec^.FontInfo[ 98] do begin
    Cht := round(  3.5777 * units);
    Cdp := 0;
    Cwd := round(  1.7889 * units);
    Angle :=   63.4349;
end;

with Vec^.FontInfo[ 99] do begin
    Cht := round(  3.2000 * units);
    Cdp := 0;
    Cwd := round(  2.4000 * units);
    Angle :=   53.1301;
end;

with Vec^.FontInfo[100] do begin
    Cht := round(  2.8284 * units);
    Cdp := 0;
    Cwd := round(  2.8284 * units);
    Angle :=   45.0000;
end;

with Vec^.FontInfo[101] do begin
    Cht := round(  2.4000 * units);
    Cdp := 0;
    Cwd := round(  3.2000 * units);
    Angle :=   36.8699;
end;

with Vec^.FontInfo[102] do begin
    Cht := round(  1.7889 * units);
    Cdp := 0;
    Cwd := round(  3.5777 * units);
    Angle :=   26.5651;
end;

with Vec^.FontInfo[103] do begin
    Cht := round(  0.9701 * units);
    Cdp := 0;
    Cwd := round(  3.8806 * units);
    Angle :=   14.0362;
end;

with Vec^.FontInfo[104] do begin
    Cht := 0;
    Cdp := 0;
    Cwd := round(  4.0000 * units);
    Angle :=    0.0000;
end;

with Vec^.FontInfo[105] do begin
     Cdp := round(  0.9701 * units);
     Cht := 0;
    Cwd := round(  3.8806 * units);
    Angle :=  -14.0362;
end;

with Vec^.FontInfo[106] do begin
     Cdp := round(  1.7889 * units);
     Cht := 0;
    Cwd := round(  3.5777 * units);
    Angle :=  -26.5651;
end;

with Vec^.FontInfo[107] do begin
     Cdp := round(  2.4000 * units);
     Cht := 0;
    Cwd := round(  3.2000 * units);
    Angle :=  -36.8699;
end;

with Vec^.FontInfo[108] do begin
     Cdp := round(  2.8284 * units);
     Cht := 0;
    Cwd := round(  2.8284 * units);
    Angle :=  -45.0000;
end;

with Vec^.FontInfo[109] do begin
    Cdp := round (  3.2000 * units);
    Cht := 0;
    Cwd := round(  2.4000 * units);
    Angle :=  -53.1301;
end;

with Vec^.FontInfo[110] do begin
    Cdp := round (  3.5777 * units);
    Cht := 0;
    Cwd := round(  1.7889 * units);
    Angle :=  -63.4349;
end;

with Vec^.FontInfo[111] do begin
    Cdp := round (  3.8806 * units);
    Cht := 0;
    Cwd := round(  0.9701 * units);
    Angle :=  -75.9638;
end;

with Vec^.FontInfo[112] do begin
    Cdp := round (  4.0000 * units);
    Cht := 0;
    Cwd := 0;
    Angle :=  -90.0000;
end;

with Vec^.FontInfo[113] do begin
    Cht := round(  2.0000 * units);
    Cdp := 0;
    Cwd := 0;
    Angle :=   90.0000;
end;

with Vec^.FontInfo[114] do begin
    Cht := round(  1.7889 * units);
    Cdp := 0;
    Cwd := round(  0.8944 * units);
    Angle :=   63.4349;
end;

with Vec^.FontInfo[115] do begin
    Cht := round(  1.4142 * units);
    Cdp := 0;
    Cwd := round(  1.4142 * units);
    Angle :=   45.0000;
end;

with Vec^.FontInfo[116] do begin
    Cht := round(  0.8944 * units);
    Cdp := 0;
    Cwd := round(  1.7889 * units);
    Angle :=   26.5651;
end;

with Vec^.FontInfo[117] do begin
    Cht := 0;
    Cdp := 0;
    Cwd := round(  2.0000 * units);
    Angle :=    0.0000;
end;

with Vec^.FontInfo[118] do begin
     Cdp := round(  0.8944 * units);
     Cht := 0;
    Cwd := round(  1.7889 * units);
    Angle :=  -26.5651;
end;

with Vec^.FontInfo[119] do begin
     Cdp := round(  1.4142 * units);
     Cht := 0;
    Cwd := round(  1.4142 * units);
    Angle :=  -45.0000;
end;

with Vec^.FontInfo[120] do begin
    Cdp := round (  1.7889 * units);
    Cht := 0;
    Cwd := round(  0.8944 * units);
    Angle :=  -63.4349;
end;

with Vec^.FontInfo[121] do begin
    Cdp := round (  2.0000 * units);
    Cht := 0;
    Cwd := 0;
    Angle :=  -90.0000;
end;

with Vec^.FontInfo[122] do begin
    Cht := round(  1.0000 * units);
    Cdp := 0;
    Cwd := 0;
    Angle :=   90.0000;
end;

with Vec^.FontInfo[123] do begin
    Cht := round(  0.7071 * units);
    Cdp := 0;
    Cwd := round(  0.7071 * units);
    Angle :=   45.0000;
end;

with Vec^.FontInfo[124] do begin
    Cht := 0;
    Cdp := 0;
    Cwd := round(  1.0000 * units);
    Angle :=    0.0000;
end;

with Vec^.FontInfo[125] do begin
     Cdp := round(  0.7071 * units);
     Cht := 0;
    Cwd := round(  0.7071 * units);
    Angle :=  -45.0000;
end;

with Vec^.FontInfo[126] do begin
    Cdp := round (  1.0000 * units);
    Cht := 0;
    Cwd := 0;
    Angle :=  -90.0000;
end;

with Vec^.FontInfo[127] do begin
    Cht := 0;
    Cdp := 0;
    Cwd := 0;
    Angle :=  -90.0000;
end;

end; (* define vectors *)




{-------------------------------------------------}
(* If, for some reason, you do not want to deal with
  music capabilities, replace the body of this procedure
  with just a begin end; pair  and also the TylBeam proc.
*)    
procedure definebeams (* var M : pMusFontInfRec *);
var i : integer;
  begin

end;

{----------------------------------------------------------}
(* use pre-calculated coordinates of a circle that has a
 * given unit-radius. Scale those points to fit the desired radius
 *)
procedure defineCircleCpts (rad : ScaledPts; centx, centy : ScaledPts;
				var CircleCpt : ControlPoints;
				var numpts : integer);
const UnitRadius = 16777216; (* TWO24 scaledpts *)
var ratio : real;
begin
  if (rad = 0) then
    begin
    complain (ERRBAD);
    writeln(logfile,'Error in fig#',pgfigurenum:0,' on page ',currpagenum:0);
    writeln(logfile,'Zero length radius for circle! Setting to 1 sp');
    rad := 1;
    end;
  ratio := float(rad) / float(UnitRadius);
  numpts := 16;
  CircleCpt[1,1] := round (ratio * 16777216.00000) + centx;
  CircleCpt[1,2] := 0 + centy; {round (ratio *      0.00000)}
  CircleCpt[2,1] := round (ratio * 15500126.47492) + centx;
  CircleCpt[2,2] := round (ratio * 6420362.60441) + centy;
  CircleCpt[3,1] := round (ratio * 11863283.20303) + centx;
  CircleCpt[3,2] := round (ratio * 11863283.20303) + centy;
  CircleCpt[4,1] := round (ratio * 6420362.60441) + centx;
  CircleCpt[4,2] := round (ratio * 15500126.47492) + centy;
  CircleCpt[5,1] := 0 + centx; {round (ratio *     -0.00000) }
  CircleCpt[5,2] := round (ratio * 16777216.00000) + centy;
  CircleCpt[6,1] := round (ratio * -6420362.60441) + centx;
  CircleCpt[6,2] := round (ratio * 15500126.47492) + centy;
  CircleCpt[7,1] := round (ratio * -11863283.20303) + centx;
  CircleCpt[7,2] := round (ratio * 11863283.20303) + centy;
  CircleCpt[8,1] := round (ratio * -15500126.47492) + centx;
  CircleCpt[8,2] := round (ratio * 6420362.60441) + centy;
  CircleCpt[9,1] := round (ratio * -16777216.00000) + centx;
  CircleCpt[9,2] := 0 + centy; {round (ratio *     -0.00000)}
  CircleCpt[10,1] := round (ratio * -15500126.47492) + centx;
  CircleCpt[10,2] := round (ratio * -6420362.60441) + centy;
  CircleCpt[11,1] := round (ratio * -11863283.20303) + centx;
  CircleCpt[11,2] := round (ratio * -11863283.20303) + centy;
  CircleCpt[12,1] := round (ratio * -6420362.60441) + centx;
  CircleCpt[12,2] := round (ratio * -15500126.47492) + centy;
  CircleCpt[13,1] := 0 + centx; {round (ratio *      0.00000) }
  CircleCpt[13,2] := round (ratio * -16777216.00000) + centy;
  CircleCpt[14,1] := round (ratio * 6420362.60441) + centx;
  CircleCpt[14,2] := round (ratio * -15500126.47492) + centy;
  CircleCpt[15,1] := round (ratio * 11863283.20303) + centx;
  CircleCpt[15,2] := round (ratio * -11863283.20303) + centy;
  CircleCpt[16,1] := round (ratio * 15500126.47492) + centx;
  CircleCpt[16,2] := round (ratio * -6420362.60441) + centy;
 (*   create the pre-list phantom *)
  CircleCpt[0,1] := CircleCpt[16,1];
  CircleCpt[0,2] := CircleCpt[16,2];  
end;


{---------------------------------------------------------------}
(* compute control points for an arc going from startangle to 
 * stopangle, centered at (centx, centy)
 *)
procedure definearcpts (rad : ScaledPts; centx, centy : ScaledPts;
			startang, stopang : integer;
			var cpts : ControlPoints;
			var nknots : integer);
var n : integer;
    a, b, curr, delta: real;
    i : integer;
begin
  a := startang * DEGTORAD;
  b := stopang * DEGTORAD;
  n := 16;

  if (a > b) then
   begin
    a := a - (2 * PI);
   end;

  delta := abs(b - a) / n;
 
  if (a = b) then
   begin
   complain (ERRNOTBAD);
   writeln(logfile,'Error in compute arc points:: should be a circle');
   end;
 curr := a;
 i := 1;
 while ((curr <= b)) do
   begin	 (* make arc about (centx,centy) *)
   cpts[i,1] := round (rad * cos (curr)) + centx;
   cpts[i,2] := round (rad * sin (curr)) + centy;
   i := i + 1;
   curr := curr + delta;
   end;  (* while *)

(* go one point beyond --
 *  around the arc so that we can have good smoothness
 *  for this phantom point 
 *)

 cpts[i,1] := round (rad * cos (b + delta)) + centx;
 cpts[i,2] := round (rad * sin (b + delta)) + centy;

(* and one phantom point before the list *)
 cpts[0,1] := round (rad * cos (a - delta)) + centx;
 cpts[0,2] := round (rad * sin (a - delta)) + centy;


 nknots := i-1;
end; 
			  
  

(* &&Module spline.p *)
(*
 Procedures below may make free use of the global variables
        arrayXY   [list of control points]
        pointmatrix [list of spline segments]
        knot    [list of spline knots]
        catrommtx  [matrix for Catmull-Rom splines]
        bsplmtx   [matrix for B-splines]
        lastPoint, intervals
*)


{-----------------------------------------------------}
function max (a, b: integer):integer;
begin
  if (a > b) then
    max := a
  else
    max := b;
end;

{-----------------------------------------------------}
function min (a, b: integer):integer;
begin
  if (a < b) then
    min := a
  else
    min := b;
end;

{---------------------------------------------------------------------}
(* initialize the Catmull-Rom basis matrix *)

procedure initcrmatrix;
begin
  catrommtx[1,1] := -0.5; catrommtx[1,2] := 1.5;
  catrommtx[1,3] := -1.5; catrommtx[1,4] := 0.5;
  catrommtx[2,1] := 1.0;  catrommtx[2,2] := -2.5;
  catrommtx[2,3] := 2.0;  catrommtx[2,4] := -0.5;
  catrommtx[3,1] := -0.5; catrommtx[3,2] := 0.0;
  catrommtx[3,3] := 0.5;  catrommtx[3,4] := 0.0;
  catrommtx[4,1] := 0.0;  catrommtx[4,2] := 1.0;
  catrommtx[4,3] := 0.0;  catrommtx[4,4] := 0.0;
end;

{-----------------------------------------------------}
procedure initbsplmatrix;
begin
  bsplmtx[1,1] := -1.0/6.0;     bsplmtx[1,2] := 0.5;
  bsplmtx[1,3] := -0.5;         bsplmtx[1,4] := 1.0/6.0;
  bsplmtx[2,1] := 0.5;          bsplmtx[2,2] := -1.0;
  bsplmtx[2,3] := 0.5;          bsplmtx[2,4] := 0.0;
  bsplmtx[3,1] := -0.5;         bsplmtx[3,2] := 0.0;
  bsplmtx[3,3] := 0.5;          bsplmtx[3,4] := 0.0;
  bsplmtx[4,1] := 1.0/6.0;      bsplmtx[4,2] := 2.0/3.0;
  bsplmtx[4,3] := 1.0/6.0;      bsplmtx[4,4] := 0.0;
end;

{--------------------------------------------------------}    
(* init the Cardinal Spline Matrix *)
procedure initcardmatrix;
begin
  cardmtx[1,1] := -1.0; cardmtx[1,2] := 1.0;
  cardmtx[1,3] := -1.0; cardmtx[1,4] := 1.0;
  cardmtx[2,1] := 2.0;  cardmtx[2,2] := -2.0;
  cardmtx[2,3] := 1.0;  cardmtx[2,4] := -1.0;
  cardmtx[3,1] := -1.0; cardmtx[3,2] := 0.0;
  cardmtx[3,3] := 1.0;  cardmtx[3,4] := 0.0;
  cardmtx[4,1] := 0.0;  cardmtx[4,2] := 1.0;
  cardmtx[4,3] := 0.0;  cardmtx[4,4] := 0.0;
end;

{--------------------------------------------------------}    
procedure initallspline;
  begin
  initcrmatrix;
  initbsplmatrix;
  initcardmatrix;
  end;


{-----------------------------------------------------}
procedure matXvector (var m: Fourby4Matrix; (* IN *)
			var v: Oneby4Vector; (* IN *)
                        var result: Oneby4Vector); (* OUT *)
var t: Oneby4Vector;
begin
  t[1] := v[1]*m[1,1] + v[2]*m[1,2] + v[3]*m[1,3] + v[4]*m[1,4];
  t[2] := v[1]*m[2,1] + v[2]*m[2,2] + v[3]*m[2,3] + v[4]*m[2,4];
  t[3] := v[1]*m[3,1] + v[2]*m[3,2] + v[3]*m[3,3] + v[4]*m[3,4];
  t[4] := v[1]*m[4,1] + v[2]*m[4,2] + v[3]*m[4,3] + v[4]*m[4,4];
  result[1] := t[1]; result[2] := t[2];
  result[3] := t[3]; result[4] := t[4];
end;

{-----------------------------------------------------}
(* actually the dot-product *)
function vecXvec (var v1, v2: Oneby4Vector) : real;
begin
  vecXvec := v1[1]*v2[1] + v1[2]*v2[2] + v1[3]*v2[3] + v1[4]*v2[4];
end;


{------------------------------------------------------}
(* basXctl is the pre-computed BasisMatrix times the control-point vector *)

function splinePosition (var basXctl : Oneby4Vector; (* IN *)
			t : real ) : real;
var tvect : Oneby4Vector;	{ vector of t values for spline matrix}
begin
  tvect[4] := 1.0;
  tvect[3] := t;
  tvect[2] := t * t;
  if (tvect[2] <= MINREAL) then
    begin			(* avoid underflow problems *)
    tvect[2] := 0.0;
    end;
  tvect[1] := t * tvect[2];  (* t^3 *)
  splinePosition := vecXvec (tvect, basXctl);  
end;  
			
{-------------------------------------------------}
function TwoToThe (n : integer) : integer;
label 78;
var i : integer;
    tmp : integer;
begin
tmp := 1;
if (n <= 0) then
  goto 78;
if (n < 6) then
  begin
    case n of
      1 : tmp := 2;
      2 : tmp := 4;
      3 : tmp := 8;
      4 : tmp := 16;
      5 : tmp := 32;
    end; (* case *)
  end  (* if *)
else
  begin
  tmp := 32;
  for i := 6 to n do
   tmp := tmp * 2;
  end;
78:
  TwoToThe := tmp;
end;  

{------------------------------------------------------}
function distance (x0, y0, x1, y1 : real) : real;
var res : real;
begin
  res := sqrt ( (x1 - x0)*(x1 - x0) + (y1 - y0)*(y1 - y0));
  distance := res;
end;  


{------------------------------------------------------}
(* compute the number of subdivisions for this span.
   We do this by a quadrature method and a simple linear-distance
   metric. This is not optimal in the number of subdivisions actually
   required, but is computationally efficient and accurate to the 
   nearest power of 2 .
   *)
function numsubdivisions (var XtimesBas, YtimesBas : Oneby4Vector;
			  resolution : ScaledPts): integer;
var n : integer;
    d : integer;  
    t : real;
    x0, y0, xt, yt : real;
begin
  x0 := splinePosition (XtimesBas, 0.0);
  y0 := splinePosition (YtimesBas, 0.0);

  t := 1.0;
  n := 0;
  xt := splinePosition (XtimesBas, t);
  yt := splinePosition (YtimesBas, t);  

  while ((round (distance (x0, y0, xt, yt)) > resolution) or
  	 (n < 1)) do
    begin
    t := t / 2.0; (* perform the quadrature *)
    n := n + 1;
    xt := splinePosition (XtimesBas, t);
    yt := splinePosition (YtimesBas, t);  
    end;  (* while *)
  numsubdivisions := TwoToThe (n);  
end;  

{------------------------------------------------------------------------}
(*  compute new control vertices such that the resulting spline
 * will interpolate through the old control points.
 * This will work as long as the actual arc length
 * between consecutive nodes does not vary from span to span.
 * The method is noted in Wu and Abel's CACM 20(10) Oct 77 paper 
 * but the actual working method is from
 *	Barsky and Greenberg's paper in
 *	CG&IP 14(3) Nov 1980 pp.203-226
 *)
procedure invertsplvertices (numpts : integer; 
				isclosed : boolean;
				var xys : ControlPoints); (* INOUT *)
var i : integer;
    beta, Xrprime, Yrprime : array[0..MAXCTLPTS] of real;
    tempxys : ControlPoints;
begin
	(* compute the values of beta *)
  beta[1] := 0.25;
  for i := 2 to numpts + 1 do
    beta[i] := 1.0 / (4.0 - beta[i - 1]);

	(* and the r primes from the original vertices *)
  Xrprime[1] := beta[1] * xys[1,1] * 5.0;
  Yrprime[1] := beta[1] * xys[1,2] * 5.0;
  for i := 2 to numpts -1 do
    begin
    Xrprime[i] := beta[i] * (6.0 * xys[i,1] - Xrprime[i - 1]);
    Yrprime[i] := beta[i] * (6.0 * xys[i,2] - Yrprime[i - 1]);
    end;  (* for *)
  Xrprime[numpts] := beta[numpts] * (5.0 * xys[numpts,1] - Xrprime[numpts - 1]);
  Yrprime[numpts] := beta[numpts] * (5.0 * xys[numpts,2] - Yrprime[numpts - 1]);

(* Now perform the back-substitution from the bottom up *)
  tempxys[numpts,1] := round (Xrprime[numpts]);
  tempxys[numpts,2] := round (Yrprime[numpts]);
  for i := numpts - 1 downto 1 do
    begin
    tempxys[i,1] := round (Xrprime[i] - beta[i] * tempxys[i + 1, 1]);
    tempxys[i,2] := round (Yrprime[i] - beta[i] * tempxys[i + 1, 2]);
    end;

if (isclosed) then
  begin
 (* at this point, we've probably been through one control-point
  *  adjustment, so let's not muck it up 
  *)
  tempxys[numpts+1,1] := tempxys[1,1];
  tempxys[numpts+1,2] := tempxys[1,2];
  tempxys[numpts+2,1] := tempxys[2,1];
  tempxys[numpts+2,2] := tempxys[2,2];
  tempxys[0,1] := tempxys[numpts,1];
  tempxys[0,2] := tempxys[numpts,2];
	  (* copy them back *)
  for i := 0 to (numpts+2) do
    begin
    xys[i,1] := tempxys[i,1];
    xys[i,2] := tempxys[i,2];
    end;  
  end  (* closed *)
else
  begin
  (* copy back *)
  for i := 2 to numpts -1 do
   begin
    xys[i,1] := tempxys[i,1];
    xys[i,2] := tempxys[i,2];
   end;
  end;  (* open*)
end; 
			      

{-----------------------------------------------------}
(*  adjust the list of control points so that we can use
 *   it for  B-spline interpolation.  
 *  Add any "phantom" vertices necessary so that the end
 *   conditions will be correct for interpolation
 *)
procedure Bctlptadjust (isclosed : boolean; isarc : boolean;
			 var n: integer; (* INOUT *)
                         var xys: ControlPoints; (* INOUT *)
                         var thx: ThickAryType); (* INOUT *)
var j : integer;
    tmp : ControlPoints;
    tmpthx : ThickAryType;
begin   (* ctlpt adjust*)

if (isclosed) then
  begin
(* here, we have to supply the last 'real' point for the user,
   and add three phantoms-- one before, and two after *)

  if (n = 2) then
    begin
    complain (ERRBAD);
    writeln(logfile,'A closed spline requires more than 2 control points ');
    writeln(logfile,'making a temporary fix in order to continue...');
    xys[3,1] := xys[1,1];
    xys[3,2] := xys[1,2];
    end;  

  for j := 1 to (n) do
    begin
    tmp[j, 1] := xys[j, 1];
    tmp[j, 2] := xys[j, 2];
    tmpthx[j] := thx[j];
    end;
		(* Now take care of the 'phantom' vertices *)    
  tmp[n+1, 1] := xys[1, 1];
  tmp[n+1, 2] := xys[1, 2];
  tmpthx[n+1] := thx[1];
  tmp[n+2, 1] := xys[2, 1];
  tmp[n+2, 2] := xys[2, 2];
  tmpthx[n+2] := thx[2];
  tmp[n+3, 1] := xys[3, 1]; 
  tmp[n+3, 2] := xys[3, 2];
  tmpthx[n+3] := thx[3];

  if (not isarc) then
    begin
    tmp[0,1] := xys[n, 1]; (* wrap around to the real last point *)
    tmp[0,2] := xys[n, 2];
    tmpthx[0] := thx[n];
    end
  else
    begin
    tmp[0,1] := xys[0,1];
    tmp[0,2] := xys[0,2];
    tmpthx[0] := thx[0];
    end;

  n := n + 1; 	(* we supplied the 'last' point for the user *)

  for j := 0 to n+2 do
    begin
    xys[j,1] := tmp[j,1];
    xys[j,2] := tmp[j,2];
    thx[j] := tmpthx[j];
    end;  (* for *)
  end  (* if closed *)
else 
  begin		 (* OPEN SPLINE *)
  if (not isarc) then
    begin
    tmp[0,1] := 2 * xys[1, 1] - xys[2,1];
    tmp[0,2] := 2 * xys[1, 2] - xys[2,2];
    end
  else
    begin
    tmp[0,1] := xys[0,1];
    tmp[0,2] := xys[0,2];
    end;
  tmpthx[0] := thx[1];

  for j := 1 to (n) do
    begin
    tmp[j, 1] := xys[j, 1];
    tmp[j, 2] := xys[j, 2];
    tmpthx[j] := thx[j];
    end;
  
  tmp[n+1, 1] := 2 * xys[n, 1] - xys[n-1,1];
  tmp[n+1, 2] := 2 * xys[n, 2] - xys[n-1,2];
  tmpthx[n+1] := thx[n];

  tmp[n+2, 1] := tmp[n+1, 1];
  tmp[n+2, 2] := tmp[n+1, 2];
  tmpthx[n+2] := thx[n];

  for j := 0 to n+2 do
    begin
    xys[j,1] := tmp[j,1];
    xys[j,2] := tmp[j,2];
    thx[j] := tmpthx[j];
    end;  (* for *)
  end; (*  if open *)
  
end;



{-----------------------------------------------------}
(*  adjust the list of control points so that we can use
 *       it for simple Catmull-Rom spline interpolation.  
 *  Add any "phantom" vertices necessary so that the end
 *   conditions will be correct for interpolation
 *)
procedure CRctlptadjust (isclosed : boolean; isarc : boolean;
			 var n: integer; (* INOUT *)
                         var xys: ControlPoints; (* INOUT *)
                         var thx: ThickAryType); (* INOUT *)
var j : integer;
    tmp : ControlPoints;
    tmpthx : ThickAryType;
begin   (* ctlpt adjust*)
if (isclosed) then
  begin
(* here, we have to supply the last 'real' point for the user,
   and add three phantoms-- one before, and two after *)

  if (n = 2) then
    begin
      complain (ERRBAD);
      writeln(logfile,'A closed spline requires more than 2 control points ');
      writeln(logfile,'making a temporary fix in order to continue...');
      xys[3,1] := xys[1,1];
      xys[3,2] := xys[1,2];
    end;  


  for j := 1 to (n) do
    begin
    tmp[j, 1] := xys[j, 1];
    tmp[j, 2] := xys[j, 2];
    tmpthx[j] := thx[j];
    end;
			(* the phantom vertices *)    
    tmp[n+1, 1] := xys[1, 1];
    tmp[n+1, 2] := xys[1, 2];
    tmpthx[n+1] := thx[1];
    tmp[n+2, 1] := xys[2, 1];
    tmp[n+2, 2] := xys[2, 2];
    tmpthx[n+2] := thx[2];
    tmp[n+3, 1] := xys[3, 1];
    tmp[n+3, 2] := xys[3, 2];
    tmpthx[n+3] := thx[3];
  
    if (not isarc) then
      begin
      tmp[0,1] := xys[n, 1]; (* wrap around to the real last point *)
      tmp[0,2] := xys[n, 2];
      tmpthx[0] := thx[n];
      end
    else
      begin
      tmp[0,1] := xys[0,1];
      tmp[0,2] := xys[0,2];
      tmpthx[0] := thx[0];
      end;
    n := n + 1; (* we supplied the 'last' point for the user *)
  
    for j := 0 to n+2 do
      begin
      xys[j,1] := tmp[j,1];
      xys[j,2] := tmp[j,2];
      thx[j] := tmpthx[j];
      end;  (* for *)
  end  (* if closed *)
else
  begin (* OPEN SPLINE *)
  if (not isarc) then
    begin
    tmp[0,1] := xys[1, 1]; (* double the first point *)
    tmp[0,2] := xys[1, 2];
    end
  else
    begin
    tmp[0,1] := xys[0,1];
    tmp[0,2] := xys[0,2];
    end;  
  tmpthx[0] := thx[1];

  for j := 1 to (n) do
    begin
    tmp[j, 1] := xys[j, 1];
    tmp[j, 2] := xys[j, 2];
    tmpthx[j] := thx[j];
    end;
    
  tmp[n+1, 1] := xys[n, 1]; (* and triple the last *)
  tmp[n+1, 2] := xys[n, 2];
  tmpthx[n+1] := thx[n];
  tmp[n+2, 1] := xys[n, 1];
  tmp[n+2, 2] := xys[n, 2];
  tmpthx[n+2] := thx[n];

  for j := 0 to n+2 do
    begin
    xys[j,1] := tmp[j,1];
    xys[j,2] := tmp[j,2];
    thx[j] := tmpthx[j];
    end;  (* for *)
  end; (* if open *)
end;    (* ctlpt adjust *)

     

{----------------------------------------------------------}

procedure interpsplines (splinetype: SplineKind;
			 isclosed: boolean;
			 isanArc: boolean;
			 linepatt : LineStyle;
                         var basismatrix : Fourby4Matrix; (* IN *)
                         numctls: integer; 
                         var arrayXY: ControlPoints; (* IN *)
                         var pointmatrix: SplineSegments; (* OUT *)
                         varythicks: boolean;
                         var thickmatrix: ThickAryType; (* IN *)
                         var TTmatrix: ThickAryType); (* OUT *)
label 32;
var xctl, yctl,		{ vectors of x, y posits of control points}
    wctl : Oneby4Vector; {vector of thicknesses at each ctl pt}
    t, incr: real;
    Pi: integer;	{ P sub i }
    i, currpt : integer;    
    theresolution : ScaledPts;

begin (* interp splines*)
  if ((not isclosed) and (isanArc)) then
    numctls := numctls + 1; (* lie a little *)

   case (splinetype) of

     BSPL: Bctlptadjust (isclosed, isanArc, numctls, arrayXY, thickmatrix);
     
     CARD,
     CATROM:  CRctlptadjust (isclosed, isanArc, numctls, arrayXY, thickmatrix);
    
     INTBSPL: begin
     		if (isclosed) then
		  begin
		  Bctlptadjust (true, isanArc, numctls, arrayXY, thickmatrix);
		  invertsplvertices (numctls, true, arrayXY);
		  end
		else 
		  begin
		  invertsplvertices (numctls, false, arrayXY);
		  Bctlptadjust (false, isanArc, numctls, arrayXY, thickmatrix);
		  end;  (* else *)
     	      end; (* Interpolating Bsplines *)
   end;

  if ((not isclosed) and (isanArc)) then
    numctls := numctls - 1; (* UN-lie a little *)


(* this is the scheme:
 *    val :=  t-vector   *  Basis matrix     * point matrix
 *        [t^3  t^2 t 1] *      [[Ms]]       * [Pi-1 Pi Pi+1 Pi+2]
 *    where "Pi-1" is "P sub (i-1)", etc.
 *
 *  But we do this in a round about way:
 *        Point matrix * basis
 *   then   * t-vector   will yield the single value
 *   
 *   there are certainly faster ways to do this, 
 *   but this is the easiest to understand
 *)

  currpt := 1;
  case linepatt of
     solid : theresolution := MAXVECLENsp;
     dotted,
     dashed,
     dotdash : theresolution := 3 * MAXVECLENsp; {###}
   end;

  for Pi := 1 to (numctls - 1) do
    begin
    xctl[1] := float(arrayXY[Pi-1, 1]);
    xctl[2] := float(arrayXY[Pi,   1]);
    xctl[3] := float(arrayXY[Pi+1, 1]);
    xctl[4] := float(arrayXY[Pi+2, 1]);
    yctl[1] := float(arrayXY[Pi-1, 2]);
    yctl[2] := float(arrayXY[Pi,   2]);
    yctl[3] := float(arrayXY[Pi+1, 2]);
    yctl[4] := float(arrayXY[Pi+2, 2]);
    matXvector (basismatrix, xctl, xctl);
    matXvector (basismatrix, yctl, yctl);

	(* compute the delta-t increment for this segment
		based on a metric for subdivision *)
    intervals := numsubdivisions (xctl, yctl, theresolution);
    if ((linepatt = solid) and (intervals <= 2)) then
      intervals := intervals * 2;
    incr := 1.0 / intervals;

	(* avoid over-flowing the "pointmatrix" *)
    if ((currpt + intervals - 1) >= MAXSPLINESEGS) then
       begin
       complain (ERRREALBAD);
       writeln (logfile,'error: Too many spline segments required.');
       writeln (logfile,' Reducing the number of control points to get output.');
       goto 32;
       end;
  
    t := 0.0;
    while (t < 0.999999999) do
      begin
	pointmatrix[currpt, 1] := round (splinePosition (xctl, t));
	pointmatrix[currpt, 2] := round (splinePosition (yctl, t));

	if (varythicks) then
	  begin
	    wctl[1] := float(thickmatrix[Pi-1]);
	    wctl[2] := float(thickmatrix[Pi  ]);
	    wctl[3] := float(thickmatrix[Pi+1]);
	    wctl[4] := float(thickmatrix[Pi+2]);
	    matXvector (catrommtx, wctl, wctl);  (* requires using Catmull-Rom *)
	    TTmatrix[currpt] := round (splinePosition (wctl, t));
	  end;
    
        t := t + incr;
        currpt := currpt + 1;
      end; (* while loop *)


    end; (* for loop *)

32:
	(* the END-condtion *)
    pointmatrix[currpt, 1] := round (splinePosition (xctl, 1.0));
    pointmatrix[currpt, 2] := round (splinePosition (yctl, 1.0));    
    if (varythicks) then
      begin
	wctl[1] := thickmatrix[numctls-2];
	wctl[2] := thickmatrix[numctls-1];
	wctl[3] := thickmatrix[numctls];
	wctl[4] := thickmatrix[numctls+1];
	matXvector (catrommtx, wctl, wctl);  (* requires using Catmull-Rom *)
	TTmatrix[currpt] := round (splinePosition (wctl, 1.0));
      end;

    lastPoint := currpt;

end; (* interpsplines *)


{----------------------------------------------------------------}
procedure drawSpline (splinetype : SplineKind;
		     isclosed: boolean;
		     isanArc: boolean;
		     patt : LineStyle;
                     numctls: integer;
                     var arrayXY: ControlPoints; (* IN *)
                     var pointmatrix: SplineSegments; (* OUT *)
                     varythicks: boolean;
                     var thickmatrix: ThickAryType; (* IN *)
                     var TTmatrix: ThickAryType); (* OUT *)
begin
  lastPoint := 0;


  case (splinetype) of
    CATROM : interpsplines (splinetype, isclosed, isanArc, patt, catrommtx,
			   numctls, arrayXY, pointmatrix,
              		   varythicks, thickmatrix, TTmatrix);

    CARD : interpsplines (splinetype, isclosed, isanArc, patt, cardmtx, 
			   numctls, arrayXY, pointmatrix, 
	                   varythicks, thickmatrix, TTmatrix);

    BSPL : interpsplines (splinetype, isclosed, isanArc, patt, bsplmtx, 
			   numctls, arrayXY, pointmatrix, 
	                   varythicks, thickmatrix, TTmatrix);

    INTBSPL : interpsplines (splinetype, isclosed, isanArc, patt, bsplmtx,
			   numctls, arrayXY, pointmatrix, 
	                   varythicks, thickmatrix, TTmatrix);
  end; (*Case *)	      	     
end;


(* &&module TeXtyl *)
{----------------------------------------------------------------}
(* rotate a (x,y) point about mx, my *)
procedure ptrotate (var x, y : integer;
                        mx, my: integer;
                        angle : real);
var tmpx, tmpy : integer;
    cosa, sina : real;
begin
  tmpx := x - mx;       
  tmpy := y - my;
  cosa := cos(angle * DEGTORAD); 
  sina := sin(angle * DEGTORAD);
  x := round(tmpx * cosa - tmpy * sina) + mx;
  y := round(tmpx * sina + tmpy * cosa) + my;
end;

{----------------------------------------------------------------}
(* transform two line points: scale, rotate and translate 
*)
procedure xfmlinepts (var x1, y1, x2, y2 : ScaledPts;
                        offh, offv : ScaledPts;
                        midx, midy : ScaledPts;
                        scalefact : real;
                        theta : real;
                        dx, dy : ScaledPts;
                        sx, sy : real);
begin
  if ((sx = 0.0) or (sy = 0.0)) then
    begin
      complain (ERRBAD);
      writeln(logfile,'?? Some scale factor is Zero... continuing anyway');
    end;
        (* scale about center of item*)
  if ((sx <> 1.0) or (sy <> 1.0)) then
   begin
   x1 := round((x1 - midx) * sx) + midx;
   x2 := round((x2 - midx) * sx) + midx;
   y1 := round((y1 - midy) * sy) + midy;     
   y2 := round((y2 - midy) * sy) + midy;
   end;
      (* rotate if necessary *)
   if (theta <> 0.0) then
     begin  (* rotate about the midpoint *)
     ptrotate(x1, y1, midx, midy, theta);
     ptrotate(x2, y2, midx, midy, theta);
     end;
      (* translate *)
   x1 := (x1 + round(dx * scalefact) + offh);
   x2 := (x2 + round(dx * scalefact) + offh);
   y1 := (y1 + round(dy * scalefact) + offv);
   y2 := (y2 + round(dy * scalefact) + offv);
end;  (* xfmlinepts *)

{----------------------------------------------------------------}
procedure xfmcontpts (var xpts : ControlPoints; xknots : integer;
                        offh, offv : ScaledPts; midx, midy : ScaledPts;
                        scalefact : real;
                        theta : real; dx, dy : ScaledPts; sx, sy : real);
var i : integer;
begin
    (* scale about center of item *)
 if ((sx <> 1.0) or (sy <> 1.0)) then
  for i := 0 to xknots do
     begin
     xpts[i,1] := round((xpts[i,1] - midx) * sx) + midx;
     xpts[i,2] := round((xpts[i,2] - midy) * sy) + midy;
     end;

  if (theta <> 0.0) then
    begin (* rotate about center *)
    for i := 0 to xknots do
      begin
      ptrotate (xpts[i,1], xpts[i,2], midx, midy, theta);
      end;
    end;
    (* translate *)
  for i := 0 to xknots do
    begin
    xpts[i,1] := (xpts[i,1] + round(dx * scalefact) + offh);
    xpts[i,2] := (xpts[i,2] + round(dy * scalefact) + offv);
    end;
end;  (* xfmcontpts *)


{----------------------------------------------------------------}
(* convert into DVI space and offset by H & V *)
procedure dvilinepts (var x1, y1, x2, y2 : ScaledPts;
			offh, offv : ScaledPts);
begin
   x1 := (x1  + offh);
   x2 := (x2  + offh);
   y1 := (y1 * (-1) + offv);
   y2 := (y2 * (-1) + offv);
end;

{----------------------------------------------------------------}
(* convert into DVI space and offset by H & V *)
procedure dvicontpts (var xpts : ControlPoints; xknots : integer;
                        offh, offv : ScaledPts);
var i : integer;
begin
  for i := 0 to xknots do
    begin
    xpts[i,1] := (xpts[i,1]  + offh);
    xpts[i,2] := (xpts[i,2] * (-1) + offv);
    end;
end;

{----------------------------------------------------------------}
(*	transform all the figure's elements according to the 
	top-level tranformation requirements in 1st Quadrant space.
	then reset the toplevel's xfms.
*)
procedure toplevelxfm (toplev, curfig : pItem; recurlevel : integer);
var pi : pItem;
    null1, null2 : ScaledPts;
    old1, old2 : ScaledPts;
    midx, midy : ScaledPts;
begin
  with toplev^ do
    begin
    midy := (BBty - BBby) div 2;
    midx := (BBrx - BBlx) div 2;
    end;
  pi := curfig^.body^.things;  { if recur==0, this is same as toplev }
  while (pi <> nil) do
    begin
    with pi^ do
      begin
      case (kind) of
	Aline : begin
		xfmlinepts (lx1, ly1, lx2, ly2, 0, 0, midx, midy, 1.0, 
		      toplev^.figtheta, toplev^.fdx, toplev^.fdy,
		      toplev^.fsx, toplev^.fsy);
		end;
	Aspline : begin
		  xfmcontpts (spts, nsplknots, 0, 0, midx, midy, 1.0,
		      toplev^.figtheta, toplev^.fdx, toplev^.fdy,
		      toplev^.fsx, toplev^.fsy);
		  end;
	Attspline : begin
		  xfmcontpts (ttpts, nttknots, 0, 0, midx, midy, 1.0,
		      toplev^.figtheta, toplev^.fdx, toplev^.fdy,
		      toplev^.fsx, toplev^.fsy);
		    end;
	Aarc : begin
	       null1 := 0; null2 := 0;
	       old1 := acentx; old2 := acenty;
	       xfmlinepts (acentx, acenty, null1, null2, 0,0, midx, midy, 1.0,
		    toplev^.figtheta, toplev^.fdx, toplev^.fdy,
		    toplev^.fsx, toplev^.fsy);		
			      
	       xfmcontpts (arcpts, narcknots + 1, 0, 0, old1, old2, 1.0,
		      toplev^.figtheta, 
		      toplev^.fdx + (acentx - old1), 
		      toplev^.fdy + (acenty - old2),
		      toplev^.fsx, toplev^.fsy);
	       end;		  	
	Alabel : begin
		 null1 := 0; null2 := 0;
		 xfmlinepts (labx, laby, null1, null2, 0, 0, midx, midy, 1.0,
		      toplev^.figtheta, toplev^.fdx, toplev^.fdy,
		      toplev^.fsx, toplev^.fsy);		
		 end;
	Abeam : ;   (* not transformable *)

	Atieslur: ; (* not transformable *)

	Afigure : begin
		    toplevelxfm (toplev, pi, recurlevel + 1);
		  end;
      end; (* case *)
    end; (* with *)
    pi := pi^.nextitem;
    end;  (* while *)
  if (recurlevel = 0) then
    begin (* reset the toplevel's xfms *)
    with toplev^ do
      begin
      figtheta := 0.0;
      fsx := 1.0; fsy := 1.0;
      fdx := 0;   fdy := 0;
      end;    
    end;
end;


{----------------------------------------------------------------}
function scalefitfactor (actualwid, actualht, 
			 goalwid, goalht: ScaledPts): real;
var sx, sy : real;
begin
  sx := goalwid/actualwid;
  sy := goalht/actualht;
  if (sx < sy) then
    scalefitfactor := sx
  else
    scalefitfactor := sy;
end;  



(* ---- The handlers for each primitive ---- 
 *   The result of calling each handler is either immediate
 *       output to the buffer of the commands to produce the
 *       primitive, OR the primitive gets pushed onto a stack/list
 *       that defines a current 'figure' (set of prims) for
 *       output at a later time
 *
 *  Look at linehandle for a basic idea of how the handlers
 *  work. the others follow pretty closely.
 *)


{------------------------------------------------------------}
procedure linehandle (figdepth : integer; scalefact: real; 
                     x1, y1, x2, y2 : ScaledPts;
                     dvih, dviv : ScaledPts; (* possible dvi-offsets *)
                     thk : VThickness; vk : VectKind;
		     patt : LineStyle;
		     minx, maxx, miny, maxy : ScaledPts;
                     tx, ty: ScaledPts; sx, sy, r : real);
var midx, midy : ScaledPts;                  
    lineitem : pItem;
begin
   midx := (minx + maxx) div 2;
   midy := (miny + maxy) div 2;

	(* do local primitive -level transformations *)
   xfmlinepts (x1, y1, x2, y2, dvih, dviv,
                midx, midy, scalefact, r, tx, ty, sx, sy);

   if (figdepth = 0) then 
     begin      (* ---- do the primitive by itself *)
      (* re-transform it to the 4th Quadrant *)
     dvilinepts (x1, y1, x2, y2, h, v);  (* global h and v posit *)
     IPUSH;
     TylLine (x1, y1, x2, y2, thk, vk, patt);
     IPOP;
     end
  else if (figdepth > 0) then
     begin      (* ---- Pack it and stack it *)
     lineitem := NewItem (Aline);
     with lineitem^ do
       begin
       BBlx := minx; 	BBby := miny;
       BBrx := maxx; 	BBty := maxy;
       lx1 := x1; 	ly1 := y1;
       lx2 := x2;	ly2 := y2;
       itemthick := thk;
       itemvec := vk;
       itempatt := patt;
       end;  
     pushItem (figdepth, lineitem);
     end
   else if (figdepth < 0) then
     begin      (* ---- just do it right away without any PUSH/POP pair *)
     		(* this is the case when we are unpacking a figure for
		 *  immediate output
		 *)
     TylLine (x1, y1, x2, y2, thk, vk, patt);
     end;  
end;  (*  linehandle *)


(* ---   Simple Splines -----*)
{-----------------------------------------------------}
procedure splinehandle (figdepth : integer; scalefact : real;
                        thetype : SplineKind; isclosed : boolean;
			markdiam : integer;
                        var contpts : ControlPoints;
                        nknots : integer;
                        dvih, dviv : ScaledPts; (* possible dvi-offsets *)
                        thk : VThickness; vec : VectKind;
			patt : LineStyle;
                        minx, maxx, miny, maxy : ScaledPts;
                        tx, ty : ScaledPts; sx, sy, r : real);
var midx, midy : ScaledPts;                     
    splineitem : pItem;
    i : integer;
begin
   midx := (minx + maxx) div 2;
   midy := (miny + maxy) div 2;
   
   xfmcontpts (contpts, nknots, dvih, dviv, midx, midy,
                scalefact, r, tx, ty, sx, sy);

   if (figdepth = 0) then
     begin      (* ----  do the primitive *)
     (* transform to 4th quad *)
     dvicontpts (contpts, nknots, h, v);
     IPUSH;
     TylSpline (thetype, isclosed, contpts, nknots, thk, vec, patt, markdiam);
     IPOP;
     end
   else if (figdepth > 0) then
     begin
     splineitem := NewItem (Aspline);
     with splineitem^ do
       begin
       BBlx := minx; BBby := miny;
       BBrx := maxx; BBty := maxy;
       itemthick := thk;
       itemvec := vec;
       itempatt := patt;
       nsplknots := nknots;
       spltype := thetype;
       sclosed := isclosed;
       dosmarks := markdiam;
       for i := 1 to nknots do
         begin
         spts[i,1] := contpts[i,1];
         spts[i,2] := contpts[i,2];
         end;
       end;  
     pushItem (figdepth, splineitem);
     end
   else if (figdepth < 0) then
     begin
     TylSpline (thetype, isclosed, contpts, nknots, thk, vec, patt, markdiam);
     end;  
end;  (*  splinehandle *)


(* --- Variable thickness splines ----- *)
{-----------------------------------------------------}
procedure ttsplhandle (figdepth : integer; scalefact : real;
                        thetype : SplineKind; isclosed : boolean;
			markdiam : integer;
                        contpts : ControlPoints;
                        ttks : ThickAryType;
                        nknots : integer; 
                        dvih, dviv : ScaledPts; (* possible dvi-offsets *)
                        vec : VectKind;
			patt : LineStyle;
                        minx, maxx, miny, maxy : ScaledPts;
                        tx, ty : ScaledPts; sx, sy, r : real);
var midx, midy : ScaledPts;
    ttsplitem : pItem;
    i : integer;
begin
   midx := (minx + maxx) div 2;
   midy := (miny + maxy) div 2;
   
   xfmcontpts (contpts, nknots, dvih, dviv, midx, midy,
                scalefact, r, tx, ty, sx, sy);

   if (figdepth = 0) then
     begin
     (* transform to 4th quad      *)
     dvicontpts (contpts, nknots, h, v);
     IPUSH;
     TylThickThinSpline (thetype, isclosed, contpts, ttks, nknots, vec, patt, markdiam);
     IPOP;
     end
   else if (figdepth > 0) then
     begin
     ttsplitem := NewItem (Attspline);
     with ttsplitem^ do
       begin
       BBlx := minx; BBby := miny;
       BBrx := maxx; BBty := maxy;
       itemvec := vec;
       itempatt := patt;
       nttknots := nknots;
       tspltype := thetype;
       dottmarks := markdiam;
       tclosed := isclosed;
       for i := 1 to nknots do
         begin
         ttpts[i,1] := contpts[i,1];
         ttpts[i,2] := contpts[i,2];
         ttarry[i] := ttks[i];
         end;
       end;  (*  ttsplitem *)
     pushItem (figdepth, ttsplitem);
     end
   else if (figdepth < 0) then
     begin
     TylThickThinSpline (thetype, isclosed, contpts, ttks, nknots, vec, patt, markdiam);
     end;  
  
end;  (*  ttsplhandle *)


(* ---- Musical Beams ---- *)
{-----------------------------------------------------}
procedure beamhandle (depth, siz : integer; bk : BeamKind;
                        x1, y1, x2, y2 : ScaledPts);
var bmitem : pItem;
begin
    if (depth = 0) then
      begin
      dvilinepts (x1, y1, x2, y2, h, v);
      IPUSH;
      TylBeam (x1, y1, x2, y2, siz, bk);
      IPOP;
      end
    else if (depth > 0) then
      begin
      bmitem := NewItem (Abeam);
      with bmitem^ do
        begin
        BBlx := min(x1, x2); 	BBby := min(y1, y2);
        BBrx := max(x1, x2); 	BBty := max(y1, y2);
	bx1 := x1;		by1 := y1;
	bx2 := x2;		by2 := y2;	
        staf := siz;
        bkind := bk;
        end;  (* with *)
      pushItem (depth, bmitem);
      end
    else if (depth < 0) then
      begin
      TylBeam (x1, y1, x2, y2, siz, bk);      
      end;  (* else *)
end;  (*  beamhandle *)


(* ---- Musical Ties and Slurs ----- *)
{-----------------------------------------------------}
procedure tieslurhandle (depth: integer; pts : ControlPoints;
                        numk : integer; minthick, maxthick : VThickness);
var tsitem : pItem;
    i : integer;
begin
if (depth = 0) then
   begin
     dvicontpts (pts, numk, h, v);
     IPUSH;
     TylTieSlur (pts, numk, minthick, maxthick);
     IPOP;
   end
else if (depth > 0) then
 begin
  tsitem := NewItem (Atieslur);
  with tsitem^ do
    begin
    ntknots := numk;
    for i := 1 to numk do 
      begin
      tspts[i,1] := pts[i,1];
      tspts[i,2] := pts[i,2];
      end;
    minth := minthick;
    maxth := maxthick;
    end;  (* with *)
  pushItem (depth, tsitem);
  end
else if (depth < 0) then
  begin
  TylTieSlur (pts, numk, minthick, maxthick);      
  end;  (* else *)
end;  (*  tieslurhandle *)


{---------------------------------------------------------}
procedure arccirclehandle (figdepth : integer; scalefact : real;
			cx, cy : ScaledPts;
			radius : ScaledPts;
			ang1, ang2 : integer;
			var contpts : ControlPoints; (* IN *)
			nknots : integer;
			dvih, dviv : ScaledPts; (* possible dvi-offsets *)
			thk : VThickness; vec : VectKind;
			patt : LineStyle;
			minx, maxx, miny, maxy : ScaledPts;
			tx, ty : ScaledPts; sx, sy, r : real);

var midx, midy : ScaledPts;                     
    middlex, middley : ScaledPts;
    arcitem : pItem;
    i : integer;
    isclosedarc : boolean;

begin
   midx := cx;  middlex := (minx + maxx) div 2;
   midy := cy;	middley := (miny + maxy) div 2;
   isclosedarc := (ang1 = ang2);
{
   if (isclosedarc) then
     maxspanlen := round ((360.0 / 16.0) * DEGTORAD * radius)
   else
     maxspanlen := round ((abs(ang2 - ang1) / 16.0) * DEGTORAD * radius);
{ }


   xfmcontpts (contpts, nknots+1, dvih, dviv, midx, midy,
                scalefact, r, tx, ty, sx, sy);

   if (figdepth = 0) then
     begin      (* ---- just do the primitive *)
     (* transform to 4th quad *)
     dvicontpts (contpts, nknots+1, h, v);
     IPUSH;
     doTylArc (isclosedarc, 
             contpts, nknots, thk, vec, patt); 
     IPOP;
     end
   else if (figdepth > 0) then
     begin
     arcitem := NewItem (Aarc);
     with arcitem^ do
       begin
       BBlx := minx; BBby := miny;
       BBrx := maxx; BBty := maxy;
       itemthick := thk;
       itemvec := vec;
       itempatt := patt;
       narcknots := nknots;
       acentx := cx;
       acenty := cy;
       aradius := radius;
       firstang := ang1;
       lastang := ang2;
       for i := 0 to nknots+1 do
         begin
         arcpts[i,1] := contpts[i,1];
         arcpts[i,2] := contpts[i,2];
         end;
       end;  
     pushItem (figdepth, arcitem);
     end
   else if (figdepth < 0) then
     begin
     doTylArc (isclosedarc, contpts, nknots, thk, vec, patt);
     end;  
end;  (*  arccirclehandle *)



{---------------------------------------------------------}
procedure labelhandle (depth : integer; scalefact: real; 
                       lax, lay : ScaledPts;
                       dvih, dviv : ScaledPts; (* possible dvi-offsets *)
		       style : integer; 
		       phrase : strng;
		       tx, ty : ScaledPts);
var labitem : pItem;
    null1, null2 : ScaledPts;
begin
(* xfm the label point if necessary *)
  lax := lax + round(tx * scalefact);
  lay := lay + round(ty * scalefact);

  if (depth = 0) then
    begin
    null1 := 0; null2 := 0;
    dvilinepts (lax, lay, null1, null2, h, v);
    IPUSH;
    TylLabel (lax, lay, style, phrase.str, phrase.len);
    IPOP;
    end
  else if (depth > 0) then
    begin
    labitem := NewItem (Alabel);
    with labitem^ do
      begin
      labx := lax; 
      laby := lay;
      fontstyle := style;
      strcopy (phrase.str, labeltext.str, phrase.len);
      labeltext.len := phrase.len;
      end;  
    pushItem (depth, labitem);
    end  
  else if (depth < 0) then
    begin
    TylLabel (lax, lay, style, phrase.str, phrase.len);
    end; 
end;


(* ####   Insert new handlers here for new "primitives"
	i.e., names callable from the \special[tyl ...]  level 
*)



{----------------------------------------------------------------}
(*  transform the current bbox coordinates, and output the new one *)
procedure newbbox (var minx, maxx, miny, maxy : ScaledPts;
                   midx, midy : ScaledPts;
                   sx, sy, rot : real; tx, ty : ScaledPts);
var
	  (* coords of full bbox for transformation [n/s][e/w][x/y] *)
   nex, ney, sex, sey, swx, swy, nwx, nwy: ScaledPts; 
   temp1, temp2 : integer;
begin
  (* describe  and transform the bbox *)
  nwx := round (minx * sx);      nex := round (maxx * sx);
  sex := round (maxx * sx);      swx := round (minx * sx);
  ney := round (maxy * sy);      nwy := round (maxy * sy);
  swy := round (miny * sy);      sey := round (miny * sy);
  
  ptrotate (nex, ney, midx, midy, rot);
  ptrotate (sex, sey, midx, midy, rot);
  ptrotate (swx, swy, midx, midy, rot);
  ptrotate (nwx, nwy, midx, midy, rot);
  
  nex := nex + tx; sex := sex + tx;
  swx := swx + tx; nwx := nwx + tx;
  ney := ney + ty; sey := sey + ty;
  swy := swy + ty; nwy := nwy + ty;
  (* now find the actual extents of the bbox *)
  temp1 := min (nex, nwx);
  temp2 := min (swx, sex);
  minx := min (temp1, temp2);
  
  temp1 := min (ney, nwy);
  temp2 := min (swy, sey);
  miny := min (temp1, temp2);
    
  temp1 := max (nex, nwx);
  temp2 := max (swx, sex);
  maxx := max (temp1, temp2);
  
  temp1 := max (ney, nwy);
  temp2 := max (swy, sey);
  maxy := max (temp1, temp2);      
end;
      
     
{-----------------------------------------------}
(* find the bounding box of the list of primitives  
	and/or sub-figures in this Item *)

procedure findBBox (blot : pItem; 
                var mnx, mxx, mny, mxy : ScaledPts);
var 
   pi : pItem;
   bmnx, bmxx, bmny, bmxy, midx, midy : ScaledPts; (* bbox [min/max][x/y] *)
   tmnx, tmxx, tmny, tmxy : ScaledPts;  (* temporary, in case of recursion *)
   null1, null2 : ScaledPts;
   prescale, postscale : real;
   old1, old2 : ScaledPts;
begin
  bmnx := TWO24; bmny := TWO24;
  bmxx := -TWO24; bmxy :=-TWO24;
  if (blot^.kind = Afigure) then
    begin (* afigure *)
    pi := blot^.body^.things;
    while (pi <> nil) do
      begin (* find the current bbox of the list of items here *)
      if (pi^.kind = Afigure) then
        begin  (* recur *)
        findBBox (pi, tmnx, tmxx, tmny, tmxy);
        bmnx := min (bmnx, tmnx);
        bmny := min (bmny, tmny);
        bmxx := max (bmxx, tmxx);
        bmxy := max (bmxy, tmxy);
        end
      else
        begin
        bmnx := min (bmnx, pi^.BBlx);
        bmny := min (bmny, pi^.BBby);
        bmxx := max (bmxx, pi^.BBrx);
        bmxy := max (bmxy, pi^.BBty);
        end;
      pi := pi^.nextitem;
      end;  (* while *)
	    (* now transform the items inside, AND the bbox *)
    pi := blot^.body^.things;
    midx := (bmnx + bmxx) div 2;
    midy := (bmny + bmxy) div 2;
    (* now take care of any pre and post size requirements *)
    (* see also the "figurehandle" proc. *)
     with blot^ do
      begin  
(* ### Keep this scaling biz here, too, for now. May blast it later *)
      if ((preWid <> 0) and (preHt <> 0)) then
	begin
	prescale := scalefitfactor ((bmxx - bmnx), (bmxy - bmny), preWid, preHt);
	fsx := fsx * prescale;
	fsy := fsy * prescale;
	end;
      if ((postWid <> 0) and (postHt <> 0)) then
	begin
	postscale := scalefitfactor ((bmxx - bmnx), (bmxy - bmny), postWid, postHt);
	fsx := fsx * postscale;
	fsy := fsy * postscale;
	end;

(* the actual scale-up is taken care of later in this proc. *)
      end; (* with *)  
    while (pi <> nil) do
      begin
      with pi^ do
        begin
        case (kind) of
          Aline : begin
                  xfmlinepts (lx1, ly1, lx2, ly2, 0, 0, midx, midy, 1.0, 
                        blot^.figtheta, blot^.fdx, blot^.fdy,
                        blot^.fsx, blot^.fsy);
                  end;
          Aspline : begin
                    xfmcontpts (spts, nsplknots, 0, 0, midx, midy, 1.0,
                        blot^.figtheta, blot^.fdx, blot^.fdy,
                        blot^.fsx, blot^.fsy);
                    end;
          Attspline : begin
                      xfmcontpts (ttpts, nttknots, 0, 0, midx, midy, 1.0,
                        blot^.figtheta, blot^.fdx, blot^.fdy,
                        blot^.fsx, blot^.fsy);
                      end;
	  Aarc : begin
		 null1 := 0; null2 := 0;
		 old1 := acentx; old2 := acenty;
	  	 xfmlinepts (acentx, acenty, null1, null2, 0,0, midx, midy, 1.0,
                        blot^.figtheta, blot^.fdx, blot^.fdy,
                        blot^.fsx, blot^.fsy);
	  	 xfmcontpts (arcpts, narcknots + 1, 0, 0, old1, old2, 1.0,
                        blot^.figtheta, 
			blot^.fdx + (acentx - old1),
			blot^.fdy + (acenty - old2),
                        blot^.fsx, blot^.fsy);
                 end;		  	
	  Alabel : begin
		   null1 := 0; null2 := 0;
	  	   xfmlinepts (labx, laby, null1, null2, 0,0, midx, midy, 1.0,
                        blot^.figtheta, blot^.fdx, blot^.fdy,
                        blot^.fsx, blot^.fsy);		
		   end;
          Abeam : ;   (* not transformable *)

          Atieslur: ; (* not transformable *)
          Afigure : ; (* do not need to re-transform *)
        end; (* case *)
      end; (* with *)
      pi := pi^.nextitem;
      end;  (* while *)
    (* transform the bbox, and re-find the new bbox *)
    newbbox (bmnx, bmxx, bmny, bmxy, midx, midy, blot^.fsx, blot^.fsy,
                blot^.figtheta, blot^.fdx, blot^.fdy);
    mnx := bmnx; mny := bmny;
    mxx := bmxx; mxy := bmxy;
    end  (* if *)
  else (* some other primitive *)
    begin
    mnx := blot^.BBlx; mny := blot^.BBby;
    mxx := blot^.BBrx; mxy := blot^.BBty;
    end;  (* else *)
end;  (*  findBBox *)


{---------------------------------------------------------}
(* traverse the list, determining the current bounding box for
 *       the items. We need this to find the mid-point
 *       for doing any remaining rotations 
 *)
procedure traverse (thefig, theitem : pItem);
var 
    minx, maxx, miny, maxy : ScaledPts;  
    curminx, curmaxx, curminy, curmaxy : ScaledPts;  
begin
  minx := TWO24; maxx := -TWO24;
  miny := TWO24; maxy := -TWO24;
  
  while (theitem <> nil) do
    begin
    if (theitem^.kind = Afigure) then
      begin (* recur *)
      findBBox (theitem, curminx, curmaxx, curminy, curmaxy);
      with theitem^ do
        begin
        BBlx := curminx;         BBby := curminy;
        BBrx := curmaxx;         BBty := curmaxy;
           (* reset the symbol's parameters since all the
                primitives in it have now been transformed
                according to the previous specifications *)
        figtheta := 0.0; 
        fsx := 1.0;      fsy := 1.0;
        fdx := 0;        fdy := 0;
	preWid := 0;	 preHt := 0;
	postWid := 0;	 postHt := 0;
        end;  (* with *)
      minx := min (minx, curminx);      miny := min (miny, curminy);
      maxx := max (maxx, curmaxx);      maxy := max (maxy, curmaxy);
      end  (* if a figure/symbol*)
    else
      begin  (* a primitive *)
      with theitem^ do 
        begin
        minx := min (minx, BBlx);        miny := min (miny, BBby);
        maxx := max (maxx, BBrx);        maxy := max (maxy, BBty);
        end;  (* with *)
      end;  (* else *)
    theitem := theitem^.nextitem;
    end;  (* while *)

  with thefig^ do
    begin  (* set the bounding box for this upper-level symbol defn *)
    BBlx := minx;
    BBby := miny;
    BBrx := maxx;
    BBty := maxy;
    end;  (* with *)
end;  (* traverse *)

(* ----- Figure symbols ----- *)
{---------------------------------------------------}
procedure figurehandle (globalsymlist, symbollist : pItem; dopush : integer);
const DoItNow = -1;
      NoScale = 1;
var pi, curfig : pItem;
    midx, midy : ScaledPts;
    null1, null2 : ScaledPts;
    prescale, postscale : real;
    tmnx, tmny, tmxx, tmxy : ScaledPts;
begin (* figurehandle *)

    (* PUSH. traverse the lists (recursively if necessary) and 
     * compute the transformed points.
     * Convert to 4th quadrant and offset by H & V.
     * We can do this destructively here
     * since we're going to output them right away anyhow.
     * Then call each respective primitive handler with a level
     * of -1 to indicate  to do its job immediately. 
     * POP.     
     *)
  curfig := symbollist;
  pi := curfig^.body^.things;
        (* find and set the bounding box for
         the figure's sub-symbols and primitives *)
  if (dopush > 0) then
    traverse (curfig, pi); 
  
      (* We eventually transform the items
	 to 4th Quadrant DVI space and output them! *)

  pi := curfig^.body^.things;

  midy := (globalsymlist^.BBby + globalsymlist^.BBty) div 2;
  midx := (globalsymlist^.BBlx + globalsymlist^.BBrx) div 2;

  if (dopush > 0) then 
    begin (* the top-level figure for outputting *)

    (* convert the bounding box because we are about to enter
    	into DVI space, and all calls to handlers hereafter
	are in terms of DVI coordinates *)

      with globalsymlist^ do
        begin 

(* Since there were external specifications about this figure,
	fit the current figure's actual size to the 
	"pre" size (specified by W marker) and/or to the
	"post" size (specified by the F marker). 
	We do this by simple scaling, *without* changing the midpoint
	of the bounding box, just its extents
 *)
	if ((preWid <> 0) and (preHt <> 0)) then
	  begin
	  prescale := scalefitfactor ((BBrx - BBlx), (BBty - BBby), preWid, preHt);
	  fsx := fsx * prescale;
	  fsy := fsy * prescale;
	  end;
	if ((postWid <> 0) and (postHt <> 0)) then
	  begin
	  postscale := scalefitfactor ((BBrx - BBlx), (BBty - BBby), postWid, postHt);
	  fsx := fsx * postscale;
	  fsy := fsy * postscale;
	  end;
	tmnx := BBlx; tmny := BBby; tmxx := BBrx; tmxy := BBty;
	xfmlinepts (tmnx, tmny, tmxx, tmxy, 0,0, midx, midy, 1.0,
			0.0, 0, 0, fsx, fsy);

	toplevelxfm (globalsymlist, globalsymlist, 0);
	
	dviBBlx := tmnx; 
	dviBBrx := tmxx; 
	dviBBby := tmny;
	dviBBty := tmxy;

	xfmlinepts (dviBBlx, dviBBby, dviBBrx, dviBBty, 0,0,
		midx, midy, 1.0, 0.0,
		- (tmnx - BBlx), - (tmny - BBby),
		1.0, 1.0);

	fdx := fdx - (tmnx - BBlx);
	fdy := fdy - (tmny - BBby);
	end;

      dvilinepts (dviBBlx, dviBBby, dviBBrx, dviBBty, h, v);
      pgfigurenum := pgfigurenum + 1;

    (* We are ready to output the figure to the page *)
      writeln(logfile);
      write(logfile,'Figure #',pgfigurenum:0,' on page ',currpagenum:0,' is approx. ');
{      write(logfile,((globalsymlist^.BBty - globalsymlist^.BBby) div SPPERPT):0,' pts high and ');
      writeln(logfile,((globalsymlist^.BBrx - globalsymlist^.BBlx) div SPPERPT):0,' pts wide (actual size)');
}
    write(logfile,((tmxy - tmny) div SPPERPT):0,' pts high and ');
    writeln(logfile,((tmxx - tmnx) div SPPERPT):0,' pts wide (actual size)');
      IPUSH;  

    end;

  while (pi <> nil) do
    begin
    with pi^ do
        begin
        case (kind) of
          Aline : begin
                 dvilinepts (lx1, ly1, lx2, ly2, h, v); (* DVI h and v posit *)
                 with globalsymlist^ do
                 linehandle (DoItNow, NoScale, 
                                pi^.lx1, pi^.ly1, pi^.lx2, pi^.ly2,
                                0, 0,  
                                pi^.itemthick, pi^.itemvec, pi^.itempatt,
				dviBBlx, dviBBrx, dviBBby, dviBBty,
                                fdx, -fdy, fsx, fsy, -figtheta);
                 end; (* Aline *)
         
         Aspline : begin
                   dvicontpts (spts, nsplknots, h, v);
                   with globalsymlist^ do
                   splinehandle (DoItNow, NoScale, pi^.spltype, 
		   		pi^.sclosed, pi^.dosmarks,
                                pi^.spts, pi^.nsplknots,
                                0, 0,
                                pi^.itemthick, pi^.itemvec, pi^.itempatt,
                                dviBBlx, dviBBrx, dviBBby, dviBBty,
                                fdx, -fdy, fsx, fsy, -figtheta);
                  end; (* Aspline *)
         
          Attspline : begin
                   dvicontpts (ttpts, nttknots, h, v);
                   with globalsymlist^ do
                   ttsplhandle (DoItNow, NoScale, pi^.tspltype, 
		   		pi^.tclosed, pi^.dottmarks,
                                pi^.ttpts, pi^.ttarry, pi^.nttknots,
                                0, 0,
                                pi^.itemvec, pi^.itempatt,
                                dviBBlx, dviBBrx, dviBBby, dviBBty,
                                fdx, -fdy, fsx, fsy, -figtheta);
                  end; (* Attspline *)

          Abeam : begin 
                  dvilinepts (bx1, by1, bx2, by2, h, v);
                  beamhandle (DoItNow, staf, bkind, bx1, by1, bx2, by2);
                  end; (* Abeam *)

          Atieslur : begin
                     dvicontpts (tspts, ntknots, h, v);
                     tieslurhandle (DoItNow, tspts, ntknots, minth, maxth);
                     end;  (* a tie or slur *)

	  Aarc : begin
                   dvicontpts (arcpts, narcknots + 1, h, v);
                   with globalsymlist^ do
                   arccirclehandle (DoItNow, NoScale,
				pi^.acentx, pi^.acenty,
				pi^.aradius,
				pi^.firstang, pi^.lastang,
				pi^.arcpts, pi^.narcknots,
				0, 0,
				pi^.itemthick, pi^.itemvec, pi^.itempatt,
                                dviBBlx, dviBBrx, dviBBby, dviBBty,
				fdx, -fdy, fsx, fsy, -figtheta);
	  	 end; (* arc *)
	  Alabel : begin
	  	   null1 := 0; null2 := 0;
	  	   dvilinepts (labx, laby, null1, null2, h, v);
		   with globalsymlist^ do
		   labelhandle (DoItNow, NoScale,
		   		pi^.labx, pi^.laby, 
				0, 0,
				pi^.fontstyle, pi^.labeltext,
				fdx, -fdy);
		  end; (* label *)

          Afigure : begin (* recur *)
                    figurehandle (globalsymlist, pi, 0);
                    end; (* another symbol *)

        end; (* case *)
      end; (* with *)
    pi := pi^.nextitem;
    end; (* while *)
  if (dopush > 0) then 
    begin
    IPOP;
    end;
end;  (*  figurehandle *)



(* %%% *)
{-----------------------------------------------------}
procedure mainhandlespecials (specnum, numpbytes : integer);
(* specnum is the DVI-number of the special
 * numpbytes is the number of parameter bytes
 *)
label 888;
const PARSLEN = 50;  (* Length of the byte-string-cache *)
      EMPTY = 0;
type charset = set of char;
var siz, numknots : integer;  (* Lots of temp vars that we use *)
     x1, y1, x2, y2 : integer;
     sx100, sy100 : real;
     transx, transy : ScaledPts;
     rot : real;
     SPscale : real;
     cpts : ControlPoints;
     thk : VThickness;
     patt : LineStyle;
     TTary : ThickAryType;
     vk : VectKind;
     bk : BeamKind;
     markdiam : integer;
     radius, ang1, ang2 : integer;
     phrase : strng;
     style : integer;
     nam : strng;
     sysnam : strng;	(* the first parameter of the \special *)
     let : char;
     i, gotten : integer;
     b : OctByt;
     pi : pItem;
     minx, miny, maxx, maxy : ScaledPts;
     maxthk, minthk : integer;
 
     tylnam,
     beginfigurenam,    (* names used for string to string comparisons *)
     endfigurenam,
     linenam,
     splinenam,
     ttsplnam,
     beamnam,
     tieslurnam,
     arcnam,
     labelnam,
     paramnam {internal} : charstring;

     splinetype : SplineKind;
     isclosedspline : boolean;

     parsearray : array [1..PARSLEN] of OctByt; (* cache of bytes to run through *)
     parsposit, parsmax : integer; (* current and max position in cache *)
     usingstream : boolean;	(* whether we read/parse using cache or from file *)


(*--------------------------------------------------------------
      These procedures depend on the correct ordering of
      GETs with respect to the number of bytes read in so far.
      precond: byte "b" has been read and gotten < numpbytes
      postcond: byte "b" has been read iff gotten < numpbytes.
      If your impl. definition of READ is non-standard, you will
      have to dink with the ordering and be really careful of
      keeping track of 'gotten' and 'numpbytes' variables 
--------------------------------------------------------------*)      

        function nextpbyte : integer;
        begin
          if (usingstream) then
            begin
            if (gotten < numpbytes) then
              begin
              nextpbyte := Dget1byte; 
              gotten := gotten + 1;
              end
            else
              nextpbyte := EMPTY;
            end
          else
            begin (* not using stream *)
            if (parsposit <= parsmax) then
              begin
              nextpbyte := parsearray[parsposit];
              parsposit := parsposit + 1;
              end
            else
              begin	 (* at end of parse array, so read from stream now *)
              usingstream := true;
              if (gotten < numpbytes) then
                begin
                nextpbyte := Dget1byte;
                gotten := gotten + 1;
                end
              else
                nextpbyte := EMPTY;
              end;
            end;  (* else *)
        end;        
        
(* !!!!! Make sure all these predicates jive correctly with
    the key-letter definitions		  *) 
{__________________________________________________________________}
        function isanumber (b : integer) : boolean;
        begin
          isanumber :=  ((b >= xord['0']) and (b <= xord['9']));
        end;
        
        function isaletter (b : integer) : boolean;
        begin
          isaletter := (((b >= xord['A']) and (b <= xord['Z'])) or
                        ((b >= xord['a']) and (b <= xord['z'])) or
			 (b = xord['@']) or
			 (b = xord['"']) );
        end;
        
        function isaspace (b : integer) : boolean;
        begin
          isaspace := ((b = xord[' ']) or 
	  	       (b = CR) or
		       (b = LF) or
		       (b = HT) or
		       (b = FF));
        end;
        
        function isdelimiter (b : integer) : boolean;
        begin
          (* not a key-letter *)
          isdelimiter := (((b < xord['A']) or (b > xord['Z'])) and
                         ((b < xord['a']) or (b > xord['z'])) and
			 (b <> xord['@']) and
			 (b <> xord['"']) );
        end;
      
        function isnotnull (b : integer) : boolean;
        begin
          isnotnull := (b <> EMPTY);
        end;
        
        
{__________________________________________________________________}
        function getnumber : integer;
        var n : integer;
            isneg : boolean;
        begin
          n := 0;
          isneg := false;
          while (  (isnotnull (b)) and
                  (not (isanumber (b)))) do
            begin       (* not a numeral *)
            if (b = xord['-']) then
              isneg := true;
            b := nextpbyte;
            end;
	
	  while (isaspace (b)) do  (* Skip spaces *)
	    b := nextpbyte;

          while ( (isnotnull (b)) and
                 isanumber (b)) do
            begin (* a numeral *)
            n := n * 10 + (b - xord['0']);
            b := nextpbyte;
            end;

          if ((gotten = numpbytes)  and
                 isanumber (b)) then
            begin  (* end condition *)
            n := n * 10 + (b - xord['0']);
            end; 

          if (isneg) then
            getnumber := -(n)
          else
            getnumber := n;
        end;
{__________________________________________________________________}

        function getletter : char;
        var k : char;
        begin
          k := ' ';
          while ( (isnotnull (b)) and
                   (isdelimiter (b) and not (isaspace (b)))) do
            begin (* non letter *)
            b := nextpbyte;
            end;

         if  ( (isnotnull (b)) and
                ( isaletter (b) or isaspace (b)
                 and not (isanumber (b)))) then
          begin
            k := xchr[b];
            b := nextpbyte;
          end;
        getletter := k;
        end;
{__________________________________________________________________}

        function getanything : char;
        var k : char;
        begin
          k := ' ';
          while (not (isnotnull (b))) do
            begin (* not usable *)
            b := nextpbyte;
            end;

         if (isnotnull (b)) then
          begin
            k := xchr[b];
            b := nextpbyte;
          end;
        getanything := k;
        end;

{****************************************************
   The following routines look for key - letter tokens
  that indicate certain attributes for a primitive.

Currently, the letters used are:
	S	for scaled-points measurement
	P	for printers points
	M	millimeters measurement
	C	use a Circular vector for drawing
	H	Horizontal-pen vector
	V	Vertical vector
	B	B-spline
	I	Interpolating B-spline
	K	Catmull-Rom spline
	D	Cardinal spline
	U	Open spline
	O	closed spline
	X	put marks on spline control pts
	T	Transformation marker
	R	Regular beam characters
	G	Grace Beam characters
	@	Specify center-point for arc/circle
	L	Line-style 
	F	for beginfigure: Fit figure to wid/ht
	W	for beginfigure: figure was created at this wid & ht
**************************************************}


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

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

     strcopy (dvifname.str, logfilnam.str, dvifname.len);
     logfilnam.len := dvifname.len;
     rp := revindex (logfilnam, '.');
     (* add a ".tlog" extension *)
     i := rp - 1;
     logfilnam.str[i + 1] := '.';
     logfilnam.str[i + 2] := 't';
     logfilnam.str[i + 3] := 'l';
     logfilnam.str[i + 4] := 'o';
     logfilnam.str[i + 5] := 'g';
     logfilnam.len := i + 5;

     openlogfile;
end; 


{-----------------------------------------------------}
    function inTFM (z: integer): boolean;
    label
        9997, 9998, 9999;
    var
        k: integer;
        lh: integer;
        nw: integer;
        alpha, beta: integer; 
    begin
        readtfmword;
        lh := b2 * 256 + b3;
        readtfmword;
        font[nf].bc := b0 * 256 + b1;
        font[nf].ec := b2 * 256 + b3;
        if (font[nf].ec < font[nf].bc) then 
            font[nf].bc := font[nf].ec + 1;
        readtfmword;
        nw := b0 * 256 + b1;
        if ((nw = 0) or (nw > 256)) then 
            goto 9997;
        for k := 1 to 3 + lh do 
          begin
            if eof(tfmfile) then 
                goto 9997;
            readtfmword;
            if (k = 4) then 
              if (b0 < 128) then 
                tfmchecksum := ((b0 * 256 + b1) * 256 + b2) * 256 + b3
              else 
                tfmchecksum := (((b0 - 256) * 256 + b1) * 256 + b2) * 256 + b3
          end; 
          
            for k := 0 to (font[nf].ec - font[nf].bc) do
              begin
                readtfmword;
                if (b0 > nw) then 
                    goto 9997;
                font[nf].widths[k] := b0
              end; 
          alpha := 16 * z;
          beta := 16;
          while z >= TWO23 do
            begin
              z := z div 2;
              beta := beta div 2
            end;
        for k := 0 to nw - 1 do
          begin
            readtfmword;
            inwidth[k] := (((b3 * z) div 256 + b2 * z) div 256 + b1 * z) div beta;
            if b0 > 0 then 
                if b0 < 255 then 
                    goto 9997
                else 
                    inwidth[k] := inwidth[k] - alpha;
          end;
        if inwidth[0] <> 0 then 
            goto 9997;
        with font[nf] do
          begin
          for k := 0 to (ec - bc) do 
            if widths[k] = 0 then
              begin
              widths[k + bc] := TWO31;
{              pixelwidths[k + bc] := 0;}
              end
            else
              begin
              widths[k + bc] := inwidth[widths[k]];
{              pixelwidths[k + bc] := round(conv * widths[k]);}
              end;
           end; (* with *)
        inTFM := true;
        goto 9999;
9997:
	complain (ERRREALBAD);
        writestrng(tfmname,true);
	writeln(logfile,'---not loaded, TFM file is bad');
	      
9998:
        inTFM := false;
9999:
        
    end; 



{-----------------------------------------------------}
procedure Fastdefinefont (fn: integer);
var     p, k: integer;
        n, waste: integer;
        c, q, d: integer;

begin  { Fastdefinefont }
  c := Dsign4byte;
  q := Dsign4byte;
  d := Dsign4byte;
  p := Dget1byte;
  n := Dget1byte;
  for k := 1 to (p + n) do
    waste := Dget1byte;                         
end;  { Fastdefinefont }


{-----------------------------------------------------}
    procedure definefont (e: integer);
    var
        f: 0..MAXFONTS;
        p, k: integer;
        n: integer;
        c, q, d: integer;
        r: integer;
    begin
        if (nf = MAXFONTS) then 
        begin
	  complain (ERRREALBAD);
          writeln(logfile,'TeXtyl capacity exceeded (max fonts=', MAXFONTS: 1, ')!');
          writeln('TeXtyl capacity exceeded (max fonts=', MAXFONTS: 1, ')!');
          jumpout
        end;
        font[nf].num := e;
        f := 0;
        while font[f].num <> e do  (* find first occurrence *)
            f := f + 1; 
        c := Dsign4byte;
        font[nf].checksum := c;
        q := Dsign4byte;
        font[nf].scaledsize := q;
        d := Dsign4byte;
        font[nf].designsize := d;
        p := Dget1byte;
        n := Dget1byte;
        font[nf].name.len := p + n;
        for k := 1 to (p + n) do
           font[nf].name.str[k] := Dget1byte;

        if (f = nf) then 
        begin (* f = nf *)
            for k := 1 to AREALENGTH do 
                tfmname.str[k] := ' ';

              r := 0;
            
            for k := 1 to font[nf].name.len do 
              begin
                r := r + 1;
                tfmname.str[r] := xchr[font[nf].name.str[k]]
              end;
            tfmname.str[r + 1] := '.';
            tfmname.str[r + 2] := 't';
            tfmname.str[r + 3] := 'f';
            tfmname.str[r + 4] := 'm';

	    tfmname.str[r + 5] := chr(32);

	    tfmname.len := r + 4;

            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
            else 
              begin
                if (q <= 0) or (q >= TWO27) then 
		  begin
		    complain (ERRREALBAD);
                    writestrng(tfmname,true);
                    writeln(logfile,'---not loaded, bad scale (', q: 1, ')!');
		  end
                else if (d <= 0) or (d >= TWO27) then 
		  begin
		    complain (ERRREALBAD);
                    writestrng(tfmname,true);
                    writeln(logfile,'---not loaded, bad design size (', d: 1, ')!');
		  end
                else
                  if inTFM(q) then
                    begin (* intfm *)
                    font[nf].space := q div 6;
                    if (c <> 0) and (tfmchecksum <> 0) and (c <> tfmchecksum) then 
                      begin
                      writeln(logfile,'Problem in fig#',pgfigurenum:0,' on page ',currpagenum:0);
	              writestrng(tfmname,true);
                      writeln(logfile,'---beware: check sums do not agree!');
                      writeln(logfile,'   (', c: 1, ' vs. ', tfmchecksum: 1, ')');
                      end;
                    d := round(100.0 * conv * q / (trueconv * d));
                    nf := nf + 1;
                    font[nf].space := 0;
                    end (* intfm *)
                 end;
            end;
    end;

{-----------------------------------------------------}
    function firstpar (o: OctByt): integer;
    var fpar : integer;
    begin
       case (o) of
            0, 1, 2, 3, 4, 5, 6,
            7, 8, 9, 10, 11, 12, 13,
            14, 15, 16, 17, 18, 19, 20,
            21, 22, 23, 24, 25, 26, 27,
            28, 29, 30, 31, 32, 33, 34,
            35, 36, 37, 38, 39, 40, 41,
            42, 43, 44, 45, 46, 47, 48,
            49, 50, 51, 52, 53, 54, 55,
            56, 57, 58, 59, 60, 61, 62,
            63, 64, 65, 66, 67, 68, 69,
            70, 71, 72, 73, 74, 75, 76,
            77, 78, 79, 80, 81, 82, 83,
            84, 85, 86, 87, 88, 89, 90,
            91, 92, 93, 94, 95, 96, 97,
            98, 99, 100, 101, 102, 103, 104,
            105, 106, 107, 108, 109, 110, 111,
            112, 113, 114, 115, 116, 117, 118,
            119, 120, 121, 122, 123, 124, 125,
            126, 127:
                fpar := o - 0;
            128, 133, 235, 239, 243:
                fpar := Dget1byte;
            129, 134, 236, 240, 244:
                fpar := Dget2byte;
            130, 135, 237, 241, 245:
                fpar := Dget3byte;
            143, 148, 153, 157, 162, 167:
                fpar := Dsign1byte;
            144, 149, 154, 158, 163, 168:
                fpar := Dsign2byte;
            145, 150, 155, 159, 164, 169:
                fpar := Dsign3byte;
            131, 132, 136, 137, 146, 151, 156,
            160, 165, 170, 238, 242, 246:
                fpar := Dsign4byte;
            138, 139, 140, 141, 142, 247, 248,
            249, 250, 251, 252, 253, 254, 255:
                fpar := 0;
            147:
                fpar := w;
            152:
                fpar := x;
            161:
                fpar := y;
            166:
                fpar := z;
            171, 172, 173, 174, 175, 176, 177,
            178, 179, 180, 181, 182, 183, 184,
            185, 186, 187, 188, 189, 190, 191,
            192, 193, 194, 195, 196, 197, 198,
            199, 200, 201, 202, 203, 204, 205,
            206, 207, 208, 209, 210, 211, 212,
            213, 214, 215, 216, 217, 218, 219,
            220, 221, 222, 223, 224, 225, 226,
            227, 228, 229, 230, 231, 232, 233,
            234:
                fpar := o - 171
        end;
        firstpar := fpar;
    end;

{-----------------------------------------------------}
    function specialcases (o: OctByt; p: integer): boolean;
    label
        46, 44, 30, 9998;
    var
        pure: boolean;

    begin
        pure := true;
        if ((o < 157) or (o > 249)) then
          begin
	    complain (ERRREALBAD);
            writeln(logfile, 'undefined command ', o: 1, '!');
            goto 30;
          end;
        case (o) of 
            157, 158, 159, 160:
                begin
                    goto 44;
                end;
            161, 162, 163, 164, 165:
                begin
                    y := p;
                    goto 44;
                end;
            166, 167, 168, 169, 170:
                begin
                    z := p;
                    goto 44;
                end; 
            171, 172, 173, 174, 175, 176, 177,
            178, 179, 180, 181, 182, 183, 184,
            185, 186, 187, 188, 189, 190, 191,
            192, 193, 194, 195, 196, 197, 198,
            199, 200, 201, 202, 203, 204, 205,
            206, 207, 208, 209, 210, 211, 212,
            213, 214, 215, 216, 217, 218, 219,
            220, 221, 222, 223, 224, 225, 226,
            227, 228, 229, 230, 231, 232, 233,
            234:
                begin
                    goto 46;
                end;
            235, 236, 237, 238:
                begin
                    goto 46;
                end;
            243, 244, 245, 246:
                begin
                    definefont(p);
                    goto 30;
                end;

            239, 240, 241, 242:
                begin   (* =========specials============= *)
                  mainhandlespecials (o, p);
                  goto 30;
                end; 
            247:
                begin
		  complain (ERRREALBAD);
                  writeln(logfile,'preamble command within a page!');
                  goto 9998;
                end;
            248, 249:
                begin
		  complain (ERRREALBAD);
                  writeln(logfile,'postamble command within a page!');
                  goto 9998;
                end;
       (*     others:
                begin
                  write(' ', 'undefined command ', o: 1, '!');
                  goto 30;
                end   
	*)
        end;
44:  (* label *)
        if (v > 0) and (p > 0) then 
            if (v > TWO31 - p) then 
            begin
                p := TWO31 - v
            end;
        if (v < 0) and (p < 0) then 
            if ((-v) > (p + TWO31)) then 
            begin
                p := -v - TWO31
            end;

        v := v + p;

        goto 30;
46:  (* label *)
        font[nf].num := p;
        curfont := 0;
        while font[curfont].num <> p do 
            curfont := curfont + 1;
        goto 30 ;
9998:
        pure := false;
30:
        specialcases := pure;
    end; 


{-----------------------------------------------------}
    function dopage : boolean;
    label
        41, 42, 43, 30, 9998, 9999;
    var
        o: OctByt;
        p, q: integer;

    begin
        curfont := nf;
 	s := 0;
        h := 0;
        v := 0;
        w := 0;
        x := 0;
        y := 0;
        z := 0;
  	
        ourxpos := 0;
	ourypos := 0;
	ourfontnum := (-1);
        while true do 
          begin 
            o := Dget1byte;
            p := firstpar(o);
            if eof(dvifile) then begin
                writeln(logfile, 'Bad DVI file: ', 'the file ended prematurely', '!');
                writeln('Bad DVI file: ', 'the file ended prematurely', '!');
                jumpout
            end; 
            if o <= 131 then 
              begin 
                goto 41;
              end
            else
              begin
               if (o > 156) then
                 begin
                   if specialcases(o, p) then 
                      goto 30
                   else 
                      goto 9998;
                 end;
                                         
                case (o) of
                    133, 134, 135, 136:
                        begin
                          goto 41;
                        end;
                    132, 137:
                        begin
                            goto 42
                        end;
                    138:
                        begin
                            goto 30;
                        end;
                    139:
                        begin (* BOP *)
			  complain (ERRREALBAD);
                          writeln(logfile, 'bop occurred before eop');
                          goto 9998; (* Fail *)
                        end;
                    140:
                        begin (* EOP *)
                            if (s <> 0) then 
			      begin
			      complain (ERRREALBAD);
                              writeln(logfile, 'stack not empty at end of page (level ', s: 1, ')!');
			      end;
			    if (multifigure <> 0) then
			      begin
			        complain (ERRBAD);
			        writeln(logfile,'Some figure definition not closed at end of page ', currpagenum:0,'!');
			      end;
			    			       
                            write (currpagenum:0,']'); 
                            write (logfile,currpagenum:0,']'); 
			    if ((currpagenum mod 10) = 0) then
			      writeln;
                            dopage := true;
                            goto 9999;
                        end;
                    141:
                        begin (* PUSH *)
                          with stack[s] do 
                            begin
                            sh := h;
                            sv := v;
                            sw := w;
                            sx := x;
                            sy := y;
                            sz := z;
                            end; (* with *)
                          s := s + 1;
                          goto 30;
                        end;
                    142:
                        begin (* POP *)
                            if s = 0 then 
			      begin
			      complain (ERRREALBAD);
                              writeln(logfile,'illegal pop at level zero!');
			      end
                            else 
			      begin
                                s := s - 1;
                                with stack[s] do
                                  begin
                                  h := sh;
                                  v := sv;
                                  w := sw;
                                  x := sx;
                                  y := sy;
                                  z := sz;
                                  end;
                               end;
                            goto 30;
                        end; 
                    143, 144, 145, 146:
                        begin
                            q := p;
                            goto 43
                        end;
                    147, 148, 149, 150, 151:
                        begin
                            w := p;
                            q := p;
                            goto 43
                        end;
                    152, 153, 154, 155, 156:
                        begin
                            x := p;
                            q := p;
                            goto 43
                        end; 
                (*    others:
                        if specialcases(o, p) then 
                            goto 30
                        else 
                            goto 9998;
                                *)                          
                end; (* case *)
            end; (* else *)
41:   (* finish cmd to set/put a char *)
            if p < 0 then 
                p := 255 - (-1 - p) mod 256
            else if p >= 256 then 
                p := p mod 256;
            if (p < font[curfont].bc) or (p > font[curfont].ec) then 
                q := TWO31
            else 
                q := font[curfont].widths[p];
            if (q = TWO31) then 
              begin
	        complain (ERRREALBAD);
                writeln(logfile,'Character ', p:1,' invalid in font #',curfont:0);
              end;
            if o >= 133 then 
                goto 30;
            if q = TWO31 then 
                q := 0;
            goto 43;

42:  (* finish cmd to set/put rule *)
            q := Dsign4byte;
            if o = 137 then 
                goto 30;
            goto 43 ;

43:  (*finish cmd that sets h += q *)
            if (h > 0) and (q > 0) then 
                if (h > (TWO31 - q)) then 
                  begin
                    q := TWO31 - h
                  end;
            if (h < 0) and (q < 0) then 
                if ((-h) > (q + TWO31)) then 
                  begin
                    q := (-h) - TWO31
                  end;

            h := h + q;
30:
        end;
9998:
        dopage := false;
9999:

    end; 

{-----------------------------------------------------}
    procedure skippages;
    label
        9999;
    var
        p: integer;
        k: 0..255;
        downthedrain: integer;
    begin
        while true do 
          begin
            if eof(dvifile) then 
              begin
                writeln(logfile, 'Bad DVI file: ', 'the file ended prematurely', '!');
                write(' ', 'Bad DVI file: ', 'the file ended prematurely', '!');
                jumpout
              end;
            k := Dget1byte;
            p := firstpar(k);
            case (k) of
                139:
                    begin (* BOP *)
                        newbackptr := DVIMark + TotBytesWritten - 1;
			currpagenum := Dsign4byte; (* count[0] *)
                        for k := 1 to 9 do 
                            waste := Dsign4byte; (* WAS count[k] := *)
                        downthedrain := Dsign4byte;
                        BackupInBuf (4);
                        cmdSigned (oldbackptr, 4);
                        oldbackptr := newbackptr;
                        write(' ['); 
                        write(logfile,' ['); 
                        goto 9999;
                    end;
                132, 137: (* RULE *)
                    downthedrain := Dsign4byte;
                243, 244, 245, 246:
                    begin
                        definefont(p);
                    end;
                239, 240, 241, 242: (* specials *)
                    begin
                        mainhandlespecials (k, p);
                    end;
                248:
                    begin (* POST *)
                        ourq := DVIMark + TotBytesWritten - 1;
                        inpostamble := true;
                        goto 9999
                    end;
              (*  others:
                    null
		*)
            end
        end;
    9999:

    end; 

{-----------------------------------------------------}
    procedure readpostamble;
    var
        k: integer;
        p, q, m: integer;
        indx : integer;
    begin
        if (Dsign4byte <> numerator) then 
            writeln(logfile,'Postamble',' numerator',' doesn''t match the preamble!');
        if (Dsign4byte <> denominator) then 
            writeln(logfile,'Postamble',' denominator',' doesn''t match the preamble!');
        if (Dsign4byte <> mag) then 
           begin
           writeln(logfile,'Postamble',' magnification',' doesn''t match the preamble!');
           end;
        maxv := Dsign4byte;
        maxh := Dsign4byte;
        maxs := Dget2byte;
        BackupInBuf (2);
        cmd2byte (maxs + 2); (* pretend the stack depth 
			      * does not increase by
			      * more than two
			      *)
        
        totalpages := Dget2byte;
        repeat
            k := Dget1byte;
            if (k >= 243) and (k < 247) then 
              begin
                p := firstpar(k);
                Fastdefinefont(p);
                k := 138;
              end
        until k <> 138; (* NOP *)

       (* here, backup 1, enter all our fonts and 
        then output the 249 that we backed over *)
        BackupInBuf (1);
        for indx := 1 to MFontsDefd do
          begin
          with MFontTable[indx]^ do 
            enterfont (DVIFontNum, Cksum, DesSize,
                       DesSize, FontName );
          end; (* for *)
        for indx := 1 to VFontsDefd do
          begin
          with VFontTable[indx]^ do
            enterfont (DVIFontNum, Cksum, DesSize,
                        DesSize, FontName);
          end;  (* for *)
	for indx := 1 to LFontsDefd do
	  begin
	  with LFontTable[indx]^ do
	    enterfont (DVIFontNum, Cksum, DesSize,
	    		DesSize, FontName);    
	  end;
        cmd1byte(249);  (* post post *)

        if (k <> 249) then 
            writeln(logfile,'byte ',k:0,' is not postpost!');
        q := Dsign4byte;
        BackupInBuf (4);
        cmd4byte (ourq);
        m := Dget1byte;
        if (m <> 2) then 
            writeln(logfile,'identification should be ', 2: 1, '!');
        m := 223;
        while (m = 223) and not eof(dvifile) do 
            m := Dget1byte;
        if not eof(dvifile) then 
	begin
            writeln(' ', 'Bad DVI file: ', 'signature in should be 223', '!');
            writeln(logfile, 'Bad DVI file: ', 'signature in should be 223', '!');
            jumpout
        end;
    end;


(* MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN *)
begin (* main *)
    initialize;
    AskandOpenFiles;  (* ask for filenames of inputdvi and outputfil *)

    writeln(logfile, TylVersion,' for Berkeley Unix');	

    write(logfile,'Reading File: ');
    writestrng(dvifname,true);     
    writeln(logfile);


    p := Dget1byte;
    if (p <> 247) then 
    begin
        write(' ', 'Bad DVI file: ', 'First byte isn''t start of preamble!', '!');
        writeln(logfile,'Bad DVI file: ', 'First byte isn''t start of preamble!', '!');
        jumpout
    end;
    p := Dget1byte;
    if (p <> 2) then 
        writeln(logfile,'identification in byte 1 should be ', 2: 1, '!');
    numerator := Dsign4byte;
    denominator := Dsign4byte;
    if (numerator <= 0) then 
    begin
        write(' ', 'Bad DVI file: ', 'numerator is ', numerator: 1, '!');
        writeln(logfile, 'Bad DVI file: ', 'numerator is ', numerator: 1, '!');	
        jumpout
    end;
    if (denominator <= 0) then 
    begin
        write(' ', 'Bad DVI file: ', 'denominator is ', denominator: 1, '!');
        writeln(logfile, 'Bad DVI file: ', 'denominator is ', denominator: 1, '!');
        jumpout
    end;
    conv := numerator / 254000.0 * (resolution / denominator);
    mag := Dsign4byte;
    if (mag <= 0) then 
    begin
        write(' ', 'Bad DVI file: ', 'magnification is ', mag: 1, '!');
        writeln(logfile, 'Bad DVI file: ', 'magnification is ', mag: 1, '!');
        jumpout
    end;
    magfactor := mag / 1000.0;
    trueconv := conv;
    conv := trueconv * magfactor;
    p := Dget1byte; 	(* the 'k' of the preamble *)
    while p > 0 do 
    begin
        p := p - 1;
        waste := Dget1byte;
    end;

    skippages;
    if not inpostamble then 
    begin 
        while (maxpages > 0) do 
          begin (* while *)
            maxpages := maxpages - 1;
            if (not dopage) then 
              begin
                write(' ', 'Bad DVI file: ', 'page ended unexpectedly', '!');
                writeln(logfile, 'Bad DVI file: ', 'page ended unexpectedly', '!');
                jumpout
              end;
		(* now we are at an EOP ---end of page *)
		(*  flushout GDVIbuffer, and reset counters *)
{ 	    writeln('EOP: bytes used= ',GDVIBuf.TotByteLen:0);  }
            WriteDVIBuf;
            ClearDVIBuf;
            multifigure := 0;
	    pgfigurenum := 0;
            FTBDs := 0;
            didnewfonts := false;
            repeat
                k := Dget1byte;
                if (k >= 243) and (k < 247) then  
                  begin (* fontdefs *)
                    p := firstpar(k);
                    definefont(p);
                    k := 138
                  end;
            until (k <> 138); (* nop *)

            if (k = 248) then 
            begin
                inpostamble := true;
                ourq := DVIMark + TotBytesWritten - 1;
                goto 30
            end;

            if (k = 139) then  (* BOP *)
  	      begin
		newbackptr := DVIMark + TotBytesWritten - 1;
		currpagenum := Dsign4byte; (* Count[0] *)
		for k := 1 to 9 do 
		    waste := Dsign4byte; (* WAS count[k] := *)
		waste := Dsign4byte; (* backpointer *)
		BackupInBuf (4);
		cmdSigned (oldbackptr, 4);
		oldbackptr := newbackptr;
		write(' ['); 
		write(logfile,' ['); 
	      end
	    else
              begin (* NOT bop?? *)
		writeln('We did not find BOP when expected');
		writeln(logfile,'We did not find BOP when expected');
                jumpout;
              end;

        end; (* while *)
30: 
    end; (* if not inpostamble *)
    if (not inpostamble) then 
	skippages;
    waste := Dsign4byte; (* ptr to the last bop in file *)
    BackupInBuf (4);
    cmdSigned (oldbackptr, 4);
    readpostamble;
    WriteDVIBuf;

    while ((TotBytesWritten mod 4) <> 0) do
       OutputByte(223);  (* final signatures *)

    writeln;
    writeln(logfile);
    write ('Output written on '); 
    writestrng(outname, false); 
    write(' (',currpagenum:0,' page');
    if (currpagenum > 1) then
      write('s');
    writeln(', ',TotBytesWritten:0,' bytes).');

    write (logfile,'Output written on ');
    writestrng(outname, true); 
    write(logfile,' (',currpagenum:0,' page');
    if (currpagenum > 1) then
      write(logfile,'s');
    writeln(logfile,', ',TotBytesWritten:0,' bytes).');

    write ('Log written on ');
    writestrng(logfilnam, false); writeln;
    write (logfile,'Log written on '); 
    writestrng(logfilnam, true); writeln (logfile);
    writeln;
    writeln(logfile);
666:
    if (ErrorOccurred) then
      begin
        writeln;
        writeln('Some error(s) occurred. Please check Logfile for details');
        writeln('Assume that the outputfile is incorrect');
      end;
end. 

