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
**************************************************}


{__________________________________________________________________}