
/* This file "parser.w" is the input to bison, except for the token
   definitions, which are generated separately by an awk script and then
   edited and inserted below by the Makefile.

   An explanation of coding style is in order.  This program was first
   written in the late 1980s in pascal for compilation on an IBM VM/CMS
   system.  Parsing was automated using a custom parser-generator
   with table optimizations adapted from a compiler-compiler called
   BOBS-System, of a vintage similar to the original Yacc.  The program
   has migrated to several other operating systems since, including VMS
   and flavors of Unix, with debugging done using a variety of pascal
   compilers.  The result was a strict LALR(1) grammar and table-driven
   parser with a fully accessible stack of production attributes and
   predictive error messages.

   For a while, dpic was distributed in C form by converting the
   pascal using p2c.  More recently, the pascal code was also included;
   consequently, the distribution had to contain versions of p2c and
   the custom parser generator.  To avoid requiring and maintaining the
   latter tools, it was decided to enter the world of Linux orthodoxy,
   provide the source in C, and use GNU bison to generate the parser.

   Dpic has been quite solid for a decade or more and in order not
   to introduce bugs, the C code has been altered very little.  As a
   result, there are few C idioms used but some p2c idiosyncracies
   (use of With, FORLIM ...) remain.  Starting from scratch would
   have resulted in cleaner code but bugs would have been introduced.
   The main program changes have resulted from going from parse code
   exploiting a completely accessible stack to the more implicit mode
   of bison. Error recovery and some error messages are also different.
   To avoid changing how dpic handles input, the original lexical analyser
   has been kept, controlled by tables now generated by the awk script.
*/

%{
#define EXTRN extern
#include "dpic.h"
#define Rnd(x)	(x<0?(-(long)floor(-x+0.5)):((long)floor(x + 0.5)))

#define envinx(x)	blockparms.env[(int)(Rnd(x)-Xenvvar-1)]

void yyerror(char const *);

boolean hasoutline(int, boolean);
boolean hasshade(int, boolean);
boolean isprint_(Char);
boolean teststflag(int, int);
double findvar(char *, int);
double intpow(double, int);
double linlen(double, double);
double pheight(primitive *);
double pwidth(primitive *);
double venv(primitive *, int);
int bval(Char *);
int cmpstring(primitive *, primitive *);
int getstval(int);
int putstring(int, nametype *, Char *, chbufinx, chbufinx);
int varhash(Char *, chbufinx, chbufinx);
primitive *( findenv(primitive *));
primitive *( findplace(primitive *, Char *, chbufinx, chbufinx));
primitive *( sprintfstring( attribute *, attribute *, int ));
void addsuffix(Char *, chbufinx *, int *, double, int, double );
void appendthen(primitive **);
void appendstring(nametype *, Char *, chbufinx, chbufinx);
void attcopy(int,int);
void attreduce(int,int);
void checkjust(nametype *, boolean *, boolean *, boolean *, boolean *);
void clearchbuf(chbufinx, int);
void consoleflush(void);
void copyprim(primitive *, primitive **);
void copystr(nametype **, nametype *);
void corner(primitive *, int, double *, double *);
void deletefreeargs(arg **);
void deletefreeinbufs(fbuffer **);
void deletename(nametype **);
void deletestringbox(primitive **);
void deletetree(primitive **);
void dodefhead( attribute *);
void donamedobj(attribute *);
void mkOptionVars(void);
void doundefine( attribute * );
void eqop(double *, int, double);
void FindExitPoint(primitive *, postype *);
void getnesw(primitive *);
void getscale(double, double, primitive *, double *, double *);
void inheritenv(primitive *);
void initnesw(void);
void inittwo(void);
void lineardir(primitive *, double, double, int *);
void makevar(char *, int, double);
void markerror(int);
void marknotfound(int, Char *, chbufinx, chbufinx);
void nesw(primitive *);
void neswrec(primitive *);
void newbuf(fbuffer **);
void newprim(primitive **, int, primitive *);
void newstr(nametype **);
void putbval(Char *, int);
void queueprim( primitive *, primitive * );
void readfor(fbuffer *, int, fbuffer **, Char, boolean);

void resetenv(int, primitive *);
void resetscale(double, int, primitive *);
void scaleobj(primitive *, double);
void setangles(double *, double *, postype, double, double, double, double);
void setspec(int *, int);
void setstflag(int *, int);
void setstval(int *, int);
void setthen(int *);
void shift(primitive *, double, double);
void skipwhite(void);
void storestring(nametype *, Char *, chbufinx, chbufinx, int);
void wchar(FILE **, Char);
void wrbuf(fbuffer *, int);

#ifdef DDEBUG
int lspec(int);
void logaddr(fbuffer *);
void prattribute(char *, attribute *);
void printobject(primitive *);
void prvars(primitive *);
void snapname(Char *, chbufinx, chbufinx);
void wrbufaddr(fbuffer *, int);
extern void logpos(char *, postype );
extern void logspec(int );
extern int ordp(void *);
extern int odp(void *);
extern int ahnum(int);
extern void prtstval(int);
extern void snaptree(primitive *, int);
extern void snaptype(FILE **, int);
#endif

nametype *( findname(primitive *, Char *, chbufinx, chbufinx, nametype **,
  int *));
nametype *( glfindname(
  primitive *, Char *, chbufinx, chbufinx, nametype **, int *) );
primitive *( nthprimobj(primitive *, int, int) );

extern arg *(findmacro(arg *, Char *, chbufinx, chbufinx, arg **));
extern boolean isthen(primitive *);
extern boolean ismdistmax(double);
extern double datan(double, double);
extern double Max(double, double);
extern double Min(double, double);
extern double principal(double, double);
extern int ahlex(int);
extern int eqstring(Char *, chbufinx, chbufinx, Char *, chbufinx, chbufinx);
extern int Floor(double);
extern int pahlex(int, int);
extern int pahnum(int, int);
extern int yylex(attribute *);
extern postype arcend(primitive *);
extern postype arcstart(primitive *);
extern void backup(void);
extern void copyleft(fbuffer *mac, fbuffer **buf, int attr);
extern void disposeargs(arg **);
extern void disposebufs(fbuffer **);
extern void drawtree(double, double, double, double, primitive *);
extern void fatal(int);
extern void inchar(void);
extern void newarg(arg **);
extern void pointinput(nametype *);
extern void pointoutput(boolean, nametype *, int *);
extern void P__argv(char*, int, int);
extern void setjust(nametype *, int);
extern void skipcontinue(boolean);
extern void skiptobrace(void);
extern void skiptoend(void);
extern void wcoord(FILE **, double, double);
extern void wfloat(FILE **, double);
extern void wpair(FILE **, double, double);
extern void wstring(FILE **, nametype *);

typedef double envarray[Xlastenv - XXenvvar];

%}

%define parse.error verbose
%define api.value.type { attribute }
%lex-param { attribute *pyylval }

%{
  nametype *lastvar, *namptr, *primtextp;
  fbuffer *lastm;
  arg *macp, *lastp;
  primitive *primp, *prp, *eb, *wprim;
  int i, j, k, gltstval, lj, nexprs, nwi;
  double r, s, t, x1, z1, dx, dy, ts;
  boolean bswitch;
  attribute *attribp;
  int FORLIM;
  char cy;
%}

%start input

%token END 0 "end of file"
							/* Tokens all have identifiers in order to preserve
							   their existing numerical values.
							   Do not change the following two lines: */
/* start tokens */

%token	XEMPTY 1 "blank"
%token	Xlt 2 "<"
%token	Xcw 3 "cw"
%token	Xccw 4 "ccw"
%token	Xlparen 5 "("
%token	Xrparen 6 ")"
%token	Xmult 7 "*"
%token	Xplus 8 "+"
%token	Xminus 9 "-"
%token	Xdiv 10 "/"
%token	Xpercent 11 "%"
%token	Xnewline 12 "end of line or ;"
%token	Xcaret 13 "^"
%token	Xnot 14 "!"
%token	Xandand 15 "&&"
%token	Xoror 16 "||"
%token	Xcomma 17 ","
%token	Xcolon 18 ":"
%token	Xleftbrack 19 "["
%token	Xrightbrack 20 "]"
%token	Xleftbrace 21 "{"
%token	Xrightbrace 22 "}"
%token	Xdot 23 "."
%token	Xblock 24 "[]"
%token	Xleftquote 25 "`"
%token	Xrightquote 26 "'"
%token	Xeq 27 "="
%token	Xcoloneq 28 ":="
%token	Xpluseq 29 "+="
%token	Xminuseq 30 "-="
%token	Xmulteq 31 "*="
%token	Xdiveq 32 "/="
%token	Xremeq 33 "%="
%token	Xampersand 34 "&"
%token	Xfloat 35 "number"
%token	Xname 36 "identifier"
%token	Xlabel 37 "label"
%token	XLaTeX 38 "LaTeX"
%token	Xstring 39 "string"
%token	Xcomment 40 "#"
%token	Xarg 41 "$ argument"
%token	DotPS 42 ".PS"
%token	DotPE 43 "end of file or .PE"
%token	Xht 44 "ht"
%token	Xwid 45 "wid"
%token	Xrad 46 "rad"
%token	Xdiam 47 "diam"
%token	Xthick 48 "thick"
%token	Xscaled 49 "scaled"
%token	Xfrom 50 "from"
%token	Xto 51 "to"
%token	Xat 52 "at"
%token	Xwith 53 "with"
%token	Xby 54 "by"
%token	Xthen 55 "then"
%token	Xcontinue 56 "continue"
%token	Xchop 57 "chop"
%token	Xsame 58 "same"
%token	Xof 59 "of"
%token	Xthe 60 "the"
%token	Xway 61 "way"
%token	Xbetween 62 "between"
%token	Xand 63 "and"
%token	XHere 64 "Here"
%token	Xnth 65 "ordinal: st or rd or nd or th"
%token	Xlast 66 "last"
%token	Xfill 67 "fill"
%token	Dotx 68 ".x"
%token	Doty 69 ".y"
%token	Xprint 70 "print"
%token	Xcopy 71 "copy"
%token	Xreset 72 "reset"
%token	Xexec 73 "exec"
%token	Xsh 74 "sh"
%token	Xcommand 75 "command"
%token	Xdefine 76 "define"
%token	Xundefine 77 "undef"
%token	Xrand 78 "rand"
%token	Xif 79 "if"
%token	Xelse 80 "else"
%token	Xfor 81 "for"
%token	Xdo 82 "do"
%token	Xendfor 83 "end of for {...} contents"
%token	Xsprintf 84 "sprintf"
%token	Xcorner 85 "compass corner: .n .ne .center .end etc"
%token	Dotne 86 ".ne"
%token	Dotse 87 ".se"
%token	Dotnw 88 ".nw"
%token	Dotsw 89 ".sw"
%token	Dotn 90 ".top or .n"
%token	Dots 91 ".bot or .s"
%token	Dote 92 ".right or .e"
%token	Dotw 93 ".left or .w"
%token	Dotstart 94 "start"
%token	Dotend 95 "end"
%token	Dotc 96 ".c"
%token	Xcompare 97 "logical operator"
%token	Xeqeq 98 "=="
%token	Xneq 99 "!="
%token	Xge 100 ">="
%token	Xle 101 "<="
%token	Xgt 102 ">"
%token	Xparam 103 "attribute .ht .wid etc"
%token	Xheight 104 ".ht"
%token	Xwidth 105 ".wid"
%token	Xradius 106 ".rad"
%token	Xdiameter 107 ".diam"
%token	Xthickness 108 ".thick"
%token	Xlength 109 ".len"
%token	Xfunc1 110 "function (1 arg)"
%token	Xabs 111 "abs"
%token	Xacos 112 "acos"
%token	Xasin 113 "asin"
%token	Xcos 114 "cos"
%token	Xexp 115 "exp"
%token	Xexpe 116 "expe"
%token	Xint 117 "int"
%token	Xlog 118 "log"
%token	Xloge 119 "loge"
%token	Xsign 120 "sign"
%token	Xsin 121 "sin"
%token	Xsqrt 122 "sqrt"
%token	Xtan 123 "tan"
%token	Xfloor 124 "floor"
%token	Xfunc2 125 "function (2 args)"
%token	Xatan2 126 "atan2"
%token	Xmax 127 "max"
%token	Xmin 128 "min"
%token	Xpmod 129 "pmod"
%token	Xlinetype 130 "line type: dotted etc"
%token	Xsolid 131 "solid"
%token	Xdotted 132 "dotted"
%token	Xdashed 133 "dashed"
%token	Xinvis 134 "invisible"
%token	Xcolrspec 135 "color spec: colored outlined shaded"
%token	Xcolour 136 "coloured"
%token	Xoutlined 137 "outlined"
%token	Xshaded 138 "shaded"
%token	Xtextpos 139 "text position: ljust rjust above below center"
%token	Xcenter 140 "center"
%token	Xljust 141 "ljust"
%token	Xrjust 142 "rjust"
%token	Xabove 143 "above"
%token	Xbelow 144 "below"
%token	Xarrowhd 145 "arrowhead parameter: <- -> <->"
%token	Xlefthead 146 "<-"
%token	Xrighthead 147 "->"
%token	Xdoublehead 148 "<->"
%token	Xdirecton 149 "direction: up down right left"
%token	Xup 150 "up"
%token	Xdown 151 "down"
%token	Xright 152 "right"
%token	Xleft 153 "left"
%token	Xprimitiv 154 "drawn object: box circle line etc"
%token	Xbox 155 "box"
%token	Xcircle 156 "circle"
%token	Xellipse 157 "ellipse"
%token	Xarc 158 "arc"
%token	Xline 159 "line"
%token	Xarrow 160 "arrow"
%token	Xmove 161 "move"
%token	Xspline 162 "spline"
%token	Xenvvar 163 "environment variable"
%token	Xarcrad 164 "arcrad"
%token	Xarrowht 165 "arrowht"
%token	Xarrowwid 166 "arrowwid"
%token	Xboxht 167 "boxht"
%token	Xboxrad 168 "boxrad"
%token	Xboxwid 169 "boxwid"
%token	Xcirclerad 170 "circlerad"
%token	Xdashwid 171 "dashwid"
%token	Xellipseht 172 "ellipseht"
%token	Xellipsewid 173 "ellipsewid"
%token	Xlineht 174 "lineht"
%token	Xlinewid 175 "linewid"
%token	Xmoveht 176 "moveht"
%token	Xmovewid 177 "movewid"
%token	Xtextht 178 "textht"
%token	Xtextoffset 179 "textoffset"
%token	Xtextwid 180 "textwid"
%token	Xarrowhead 181 "arrowhead"
%token	Xfillval 182 "fillval"
%token	Xlinethick 183 "linethick"
%token	Xmaxpsht 184 "maxpsht"
%token	Xmaxpswid 185 "maxpswid"
%token	Xscale 186 "scale"
/* end tokens */

%% /* beginning of rules section */
							/* Some rules in the following rely on the implicit
                               default action '{ $$ = $1 }' */

input :                                                           /* input1 */

		| input picture NL                                        /* input2 */
		{ deletetree(&envblock);
    	  deletefreeargs(&freearg);
    	  deletefreeinbufs(&freeinbuf);
#ifdef DDEBUG
          if (debuglevel > 0) {
            fprintf(log_, "deletetree:\n");
	        fprintf(log_, "deletefreeargs: ");
	        fprintf(log_, "deletefreeinbufs: ");
	        fprintf(log_, "inittwo:\n"); }
#endif
    	  inittwo();
    	  if (envblock != NULL) { envblock->direction = Xright; }
		  }
		;

picture	:	prestart psline NL elementlist optnl DotPE          /* picture1 */
		{ $$ = $2;
		  if (envblock != NULL ) {
            getnesw(envblock->son);
#ifdef DDEBUG
	        if (debuglevel > 0) {
              snaptree(envblock->son,0);
		      fprintf(log_, " Global dimensions:\n");
              fprintf(log_, "(n,s)(e,w)=");
		      wpair(&log_, north, south); wpair(&log_, east, west);
              putc('\n', log_);
              fflush(log_); }
#endif
		    envblock->aat.xpos = (east + west) * 0.5;
		    envblock->aat.ypos = (north + south) * 0.5;
		    envblock->blockheight_ = north - south;
		    envblock->blockwidth_ = east - west;
	        if (drawmode == xfig) {
		      shift(envblock, -west, -south);
		      north -= south;
		      east -= west;
		      west = 0.0;
		      south = 0.0; }
            else if (((drawmode==SVG) || (drawmode==PDF) || (drawmode==PS)) &&
              (envblock->blockparms.env != NULL)) {
							/* linethick/2 in drawing units*/
		      r = (envblock->envinx(Xlinethick) / 2 / 72)
                  * envblock->envinx(Xscale);
#ifdef DDEBUG
		      if (debuglevel > 0) {
			    fprintf(log_,     " west="); wfloat(&log_, west);
			    fprintf(log_,     " south="); wfloat(&log_, south);
			    fprintf(log_,     " lthick/2="); wfloat(&log_, r);
			    fprintf(log_,     " shift=("); wfloat(&log_, r-west);
                putc(',', log_); wfloat(&log_, r-south);
                fprintf(log_, ")\n"); fflush(log_); }
#endif
							/* shift .sw to (r,r) */
		      shift(envblock, (2 * r) - west, (2 * r) - south);
		      north += (3 * r) - south;
		      east += (3 * r) - west;
		      west = r;
		      south = r;
	          }
	        xfheight = north;
	        getscale($$.xval, $$.yval, envblock, &scale, &fsc);
#ifdef DDEBUG
	        if (debuglevel > 0) {
		      fprintf(log_, "After shift:\n");
		      fprintf(log_, "xfheight="); wfloat(&log_, xfheight);
              putc('\n', log_);
		      printobject(envblock);
		      printobject(envblock->son);
		      fprintf(log_, "\nStarting drawtree ================= ");
		      if (($$.xval > 0.0) && (east > west)) {
		        fprintf(log_, "fsc="); wfloat(&log_, fsc); }
		      putc('\n', log_);
		      snaptree(envblock, 0);
		      putc('\n', log_); fflush(log_); }
#endif
		    if ((drawmode == SVG) || (drawmode == PDF) || (drawmode == PS)) {
		      dptextratio = findvar("dptextratio", 11);
		      if (dptextratio == 0) { dptextratio = 1.0; }
		      dpPPI = findvar("dpPPI", 5); }
            else if (drawmode == xfig) {
              xfigres = findvar("xfigres", 7);
              xdispres = findvar("xdispres", 8); }
	        drawtree(north, south, east, west, envblock);
#ifdef DDEBUG
	        if (debuglevel > 0) {
		      fprintf(log_, " drawtree done ================= \n"); }
#endif
	        }
	      }
		;

NL	:	Xnewline                                                     /* NL1 */

		| error                                                      /* NL2 */
		{ yyerrok; /* yyclearin; */ }
		;

prestart	: /* empty */                                      /* prestart1 */
		{ mkOptionVars(); }

psline	:	DotPS                                                /* psline1 */
		{ $$.xval = 0; $$.yval = 0; }

		| DotPS term                                             /* psline2 */
		{ $$.xval = $2.xval; $$.yval = 0; }

		| DotPS term term                                        /* psline3 */
		{ $$.xval = $2.xval; $$.yval = $3.xval; }
		;

elementlist	:                                               /* elementlist1 */

		| element                                           /* elementlist2 */
		{ if (($1.prim != NULL) && ($1.lexval != Xcontinue)) {
            queueprim( $1.prim, envblock ); }
#ifdef DDEBUG
          if (debuglevel > 0 ) { snaptree(envblock->son,0); }
#endif
    	  }

		| elementlist NL element                            /* elementlist3 */
		{ if (($3.prim != NULL) && ($3.lexval != Xcontinue)) {
            queueprim( $3.prim, envblock ); }
#ifdef DDEBUG
          if (debuglevel > 0 ) { snaptree(envblock->son,0); }
#endif
		  }
		;

term	:	factor                                                 /* term1 */

		| term Xmult factor                                        /* term2 */
		{ $$.xval = $1.xval * $3.xval; }

		| term Xdiv factor                                         /* term3 */
		{ if ($3.xval == 0.0) { markerror(852); $$.xval = 0.0; }
    		else { $$.xval = $1.xval / $3.xval; }
		  }

		| term Xpercent factor                                     /* term4 */
		{ i = Rnd($1.xval);
    	  j = Rnd($3.xval);
    	  if (j == 0) { markerror(852); $$.xval = 0.0; }
    	  else { $$.xval = i - ((i / j) * j); }
		  }
		;

element	:	namedobj /* chop operation for linear objects */    /* element1 */
		{ if ($$.prim != NULL) {
			prp = $$.prim;
			if ((prp->ptype == Xspline) || (prp->ptype == Xmove) ||
			    (prp->ptype == Xarrow) || (prp->ptype == Xline)) {
			  if ($$.startchop != 0.0) {
				dx = prp->endpos_.xpos - prp->aat.xpos;
				dy = prp->endpos_.ypos - prp->aat.ypos;
				s = linlen(dx, dy);
#ifdef DDEBUG
				if (debuglevel == 2) { fprintf(log_, " element1 startchop=");
				  wfloat(&log_, $$.startchop);
				  fprintf(log_, " (dx,dy)="); wpair(&log_, dx, dy);
				  fprintf(log_, " s="); wfloat(&log_, s); putc('\n', log_); }
#endif
				if (s != 0.0) {
				  t = $$.startchop / s;
				  prp->aat.xpos += t * dx;
				  prp->aat.ypos += t * dy; }
			    }
			  while (prp->son != NULL) { prp = prp->son; }
			  if ($$.endchop != 0.0) {
				dx = prp->endpos_.xpos - prp->aat.xpos;
				dy = prp->endpos_.ypos - prp->aat.ypos;
				s = linlen(dx, dy);
#ifdef DDEBUG
				if (debuglevel == 2) { fprintf(log_, " element1 endchop=");
				  wfloat(&log_, $$.endchop);
				  fprintf(log_, " (dx,dy)="); wpair(&log_, dx, dy);
				  fprintf(log_, " s="); wfloat(&log_, s); putc('\n', log_); }
#endif
				if (s != 0.0) {
				  t = $$.endchop / s;
				  prp->endpos_.xpos -= t * dx;
				  prp->endpos_.ypos -= t * dy; }
			    }
			  }
			FindExitPoint(prp, &envblock->here_); }
#ifdef DDEBUG
			if (debuglevel > 0) { prattribute("element1", &$$);
			  fprintf(log_, " element1 Here=");
			  wpair(&log_, envblock->here_.xpos, envblock->here_.ypos);
              putc('\n', log_);
			  printobject($$.prim); }
#endif
			}

		| Xlabel suffix Xcolon position                         /* element2 */
		{ if ($2.lexval != XEMPTY) {
		    addsuffix(chbuf, &$1.chbufx,&$1.toklen, $2.xval,$2.lexval,$2.yval);}
		  prp = findplace(envblock->son, chbuf, $1.chbufx, $1.toklen);
		  if (prp == NULL) {
			newprim(&$$.prim, Xlabel, envblock);
			newstr(&$$.prim->name);
			storestring($$.prim->name, chbuf, $1.chbufx, $1.toklen, 1);
			prp = $$.prim; }
		  else if (prp->ptype != Xlabel) {
			newprim(&$$.prim, Xlabel, envblock);
			$$.prim->name = prp->name;
			prp->name = NULL;
			prp = $$.prim; }
		  clearchbuf($1.chbufx, $1.toklen);
		  prp->aat.xpos = $4.xval;
		  prp->aat.ypos = $4.yval;
#ifdef DDEBUG
          if (debuglevel>1) {
            prattribute("element2", &$$);
            if ($$.prim != NULL) printobject($$.prim); }
#endif
		  }

		| assignlist                                            /* element3 */

		| Xdirecton                                             /* element4 */
			{ envblock->direction = $1.lexval; }

		| XLaTeX                                                /* element5 */
		{ newprim(&$$.prim, XLaTeX, envblock);
    	  newstr(&$$.prim->textp);
    	  storestring($$.prim->textp, chbuf, $1.chbufx, $1.toklen, 1);
		  clearchbuf($1.chbufx, $1.toklen);
		  }

		| command                                               /* element6 */

		| lbrace elementlist optnl Xrightbrace                  /* element7 */
		{ envblock->here_.xpos = $1.xval;
    	  envblock->here_.ypos = $1.yval;
    	  if (($1.state == Xright) || ($1.state == Xleft) ||
			  ($1.state == Xdown) || ($1.state == Xup)) {
			envblock->direction = $1.state; }
#ifdef DDEBUG
          if (debuglevel>1) { prattribute("element7", &$$); }
#endif
		  }

		| ifpart                                                /* element8 */

		| elsehead elementlist optnl Xrightbrace                /* element9 */

		| for Xrightbrace                                      /* element10 */

		| Xcommand stringexpr                                  /* element11 */
		{ if ($2.prim != NULL) {
			newprim(&$$.prim, XLaTeX, envblock);
			$$.prim->textp = $2.prim->textp;
			$2.prim->textp = NULL;
			if (envblock->son == $2.prim) { envblock->son = $$.prim; }
			deletestringbox(&$2.prim);
			}
		  }

		| Xexec stringexpr                                     /* element12 */
		{ if ($2.prim == NULL) { }
          else if ($2.prim->textp == NULL) { }
          else if ($2.prim->textp->segmnt != NULL) {
			primtextp = $2.prim->textp;
			newbuf(&lastm);      /* Temp buffer; put nlch into inbuf */
			lastm->carray[1] = nlch;
			lastm->savedlen = 1;
			copyleft(lastm, &inbuf, -1);
			FORLIM = primtextp->len;
	                  /*  Copy string to lastm then to inbuf */
			for (i = 1; i <= FORLIM; i++) {
			  lastm->carray[i] = primtextp->segmnt[primtextp->seginx + i - 1]; }
			lastm->savedlen = primtextp->len;
			copyleft(lastm, &inbuf, -1);
						  /*  Add nlch in inbuf */
			lastm->carray[1] = nlch;
			lastm->savedlen = 1;
			copyleft(lastm, &inbuf, -1);
			deletestringbox(&$2.prim);
			disposebufs(&lastm); }
		  }
		;

lbrace	:	Xleftbrace                                           /* lbrace1 */
		{ $$.xval = envblock->here_.xpos;
    	  $$.yval = envblock->here_.ypos;
    	  $$.state = envblock->direction; }
		;

namedobj:	object /* then, arc, and deferred shift */         /* namedobj1 */
		{ donamedobj(&$$); }

		| Xlabel suffix Xcolon object                          /* namedobj2 */
		{ if ($4.prim != NULL) {
		    if ($2.lexval != XEMPTY) { addsuffix(chbuf, &$1.chbufx,
                  &$1.toklen, $2.xval,$2.lexval,$2.yval); }
			primp = findplace(envblock->son, chbuf, $1.chbufx, $1.toklen);
			if (primp != NULL) {
	    	  $4.prim->name = primp->name;
	    	  primp->name = NULL; }
			else {
	    	  wprim = $4.prim;
	    	  newstr(&wprim->name);
	    	  storestring(wprim->name, chbuf, $1.chbufx, $1.toklen, 1); }
			$$ = $4;
			donamedobj(&$$);
			}
		  clearchbuf($1.chbufx, $1.toklen);
		  }
		;

suffix	:                                                        /* suffix1 */
		{ $$.lexval = XEMPTY; }

		| Xleftbrack expression Xrightbrack                      /* suffix2 */
		{ if ($2.xval > maxint) { markerror(875); fatal(8); }
          else { $$.xval = $2.xval; } }

		| Xleftbrack position Xrightbrack                        /* suffix3 */
    	{ $$.lexval = Xcomma;
    	  $$.xval = $2.xval;
    	  $$.yval = $2.yval;
    	  if ((fabs($2.xval) > maxint) || (fabs($2.yval) > maxint)) {
            markerror(875); fatal(8);}
		  }
		;

position	:	pair                                           /* position1 */
			{ $$ = $1; }

		| expression Xbetween position Xand position           /* position2 */
		{ r = $1.xval;
    	  $$.xval = $3.xval + (r * ($5.xval - $3.xval));
    	  $$.yval = $3.yval + (r * ($5.yval - $3.yval)); }

		| expression Xof Xthe Xway Xbetween position Xand position
                                                               /* position3 */
		{
    	  r = $1.xval;
    	  $$.xval = $6.xval + (r * ($8.xval - $6.xval));
    	  $$.yval = $6.yval + (r * ($8.yval - $6.yval)); }

		| expression Xlt position Xcomma position Xcompare shift
                                                               /* position4 */
		{ r = $1.xval;
    	  $$.xval = $3.xval + (r * ($5.xval - $3.xval));
    	  $$.yval = $3.yval + (r * ($5.yval - $3.yval));
		  if ($6.lexval != Xgt) { markerror(869); }
		  else if ($7.lexval != XEMPTY) {
	   	    $$.xval += $7.xval;
	   	    $$.yval += $7.yval;
			}
		  }
		;

assignlist	:	assignment                                   /* assignlist1 */

		| assignlist Xcomma assignment                       /* assignlist2 */
		{ $$.xval = $3.xval; }
		;

command	:	Xprint expression redirect                          /* command1 */
		{ if ($3.lexval == XEMPTY) {
            wfloat(&errout, $2.xval); putc('\n', errout); }
    	  else if ($3.state == 0) {
#ifndef SAFE_MODE
	  		wfloat(&redirect, $2.xval); putc('\n', redirect);
			if (redirect != NULL) { fclose(redirect); }
			redirect = NULL;
#endif
			}
		  }

		| Xprint position redirect                              /* command2 */
		{ if ($3.lexval == XEMPTY) {
	  		wpair(&errout, $2.xval, $2.yval); putc('\n', errout); }
    	  else if ($3.state == 0) {
#ifndef SAFE_MODE
	  		wpair(&redirect, $2.xval, $2.yval);
			putc('\n', redirect);
			if (redirect != NULL) { fclose(redirect); }
			redirect = NULL;
#endif
			}
		  }

		| Xprint stringexpr redirect                            /* command3 */
		{ if ($3.lexval == XEMPTY) {
	      	wstring(&errout, $2.prim->textp);
			putc('\n', errout); }
    	  else if ($3.state == 0) {
#ifndef SAFE_MODE
	  		if ($2.prim != NULL) {
			  wstring(&redirect, $2.prim->textp); }
			putc('\n', redirect);
			if (redirect != NULL) { fclose(redirect); }
			redirect = NULL;
#endif
			}
		  deletestringbox(&$2.prim);
		  }

		| Xreset                                                /* command4 */
		{ resetenv(0, envblock); }

		| Xreset resetlist                                      /* command5 */

		| systemcmd                                             /* command6 */

		| Xcopy stringexpr                                      /* command7 */
		{ if ($2.prim != NULL) {
#ifdef SAFE_MODE
			markerror(901);
#else
			pointinput($2.prim->textp);
#endif
			deletestringbox(&$2.prim);
    		}
		  }

		| Xdefine Xname                                         /* command8 */
		{ currprod = 4;
          $$ = $2;
		  dodefhead( &$$ );
          }

		| Xdefine Xlabel                                        /* command9 */
		{ currprod = 5;
          $$ = $2;
		  dodefhead( &$$ );
          }
		;

		| Xundefine Xname                                      /* command10 */
		{ $$ = $2; doundefine( &$2 );
		  clearchbuf($2.chbufx, $2.toklen); }

		| Xundefine Xlabel                                     /* command11 */
		{ $$ = $2; doundefine( &$2 );
		  clearchbuf($2.chbufx, $2.toklen); }
		;

optnl	:                                                         /* optnl1 */

		| NL                                                      /* optnl2 */
		;

ifpart	:	ifhead elementlist optnl Xrightbrace                 /* ifpart1 */
		;

elsehead:	ifpart Xelse Xleftbrace                            /* elsehead1 */
		{ if ($1.xval == 1.0) { currprod = 1; skiptobrace(); } }
		;

for	:	forhead elementlist optnl                                   /* for1 */
		{ forattr = $$;
#ifdef DDEBUG
		  if (debuglevel>0) prattribute("for1",&$$);
#endif
		  }

		| for forincr elementlist optnl /* for2 */
		{ forattr = $$; }
		;

stringexpr:	string                                           /* stringexpr1 */
		{
#ifdef DDEBUG
		  if (debuglevel>0) {
			prattribute("stringexpr1",&$$);
            printobject($$.prim);
  			fflush(log_); }
#endif
		  }

		| stringexpr Xplus string                            /* stringexpr2 */
		{ if ($3.prim != NULL) { prp = $3.prim;
		  $$.prim->boxwidth_ += prp->boxwidth_;
		  $$.prim->boxheight_ = Max($1.prim->boxheight_, prp->boxheight_);
		  if (prp->textp != NULL) {
    	    if ($1.prim->textp == NULL) {
			  $$.prim->textp = prp->textp; prp->textp = NULL; }
    		else if (($1.prim->textp->segmnt == prp->textp->segmnt) &&
	     		($1.prim->textp->seginx + $1.prim->textp->len ==
	      		  prp->textp->seginx)) {
			  $$.prim->textp->len += prp->textp->len;
			  putbval($$.prim->textp->segmnt,
                bval($1.prim->textp->segmnt)-1);
			  prp->textp->segmnt = NULL;
    		  }
    		else { appendstring($$.prim->textp, prp->textp->segmnt,
		        prp->textp->seginx, prp->textp->len); }
		  }
		deletetree(&$3.prim); }
		}
		;

string	:	Xstring                                              /* string1 */
		{ newprim(&$$.prim, Xstring, envblock);
		  eb = findenv(envblock);
		  wprim = $$.prim;
		  wprim->boxheight_ = eb->envinx(Xtextht);
		  wprim->boxwidth_ = eb->envinx(Xtextwid);
		  if (wprim->boxwidth_ == 0.0) {
			switch (drawmode) {
		  	  case xfig:
							/* To keep xfig from crashing, assume text height
							   is 0.1 and a character is 0.1*0.75 wide */
		  	  	if ($$.prim->boxheight_ == 0.0) {
		  	      $$.prim->boxheight_ = 0.1 * eb->envinx(Xscale); }
		  	  	$$.prim->boxwidth_ = $$.prim->boxheight_ * $1.toklen * 0.75;
		  	  	break;
		  	  case PDF:
		  	  	$$.prim->boxwidth_ = $$.prim->boxheight_ * $1.toklen * 0.6;
		  	  	break;
		  	  }
		    }
		  newstr(&wprim->textp);
		  storestring(wprim->textp, chbuf, $1.chbufx, $1.toklen, 1);
#ifdef DDEBUG
		  if (debuglevel>1) {
            prattribute("string1",&$$);
            printobject($$.prim);
  			fflush(log_); }
#endif
		  clearchbuf($1.chbufx, $1.toklen);
		  }

		| sprintf Xrparen                                        /* string2 */
		;

  /*      assignment = "<name>" suffix "=" assignrhs   */
assignment	:	Xname suffix Xeq assignrhs                   /* assignment1 */
		{ if ($2.lexval != XEMPTY) { addsuffix(chbuf, &$1.chbufx,
                &$1.toklen, $2.xval,$2.lexval,$2.yval); }
		    $$.varname = findname(envblock, chbuf, $1.chbufx, $1.toklen,
			     &lastvar, &k);
		    if (($$.varname == NULL) && ($3.lexval != Xeq)) {
			  $$.varname = glfindname(envblock->parent, chbuf,
				 $1.chbufx, $1.toklen, &namptr, &gltstval); }
		    if ($$.varname == NULL) {
			  newstr(&$$.varname);
			  j = varhash(chbuf, $1.chbufx, $1.toklen);
			  storestring($$.varname, chbuf, $1.chbufx, $1.toklen, 1);
		#ifdef DDEBUG
			if (debuglevel > 1) {
			    fprintf(log_, "assignment: j=%d envblock=%d eqstr=%d\n",
				    j,ordp(envblock), k);
			    fprintf(log_, " lastvar=%d", ordp(lastvar));
			    if (lastvar != NULL) {
				  snapname(lastvar->segmnt, lastvar->seginx, lastvar->len); }
			    putc('\n', log_);
			    fprintf(log_, " varname=%d\n", ordp($1.varname));
			    prvars(envblock);
			    }
		#endif
			wprim = envblock;
			if (lastvar == NULL) { wprim->blockparms.vars[j] = $$.varname; }
			else if (k < 0) {
			  if (wprim->blockparms.vars[j]->nextname == NULL) {
			    wprim->blockparms.vars[j]->nextname = $$.varname; }
			  else {
				$$.varname->nextname = lastvar->nextname;
				lastvar->nextname = $$.varname; }
			    }
			else if (lastvar == wprim->blockparms.vars[j]) {
			  $$.varname->nextname = wprim->blockparms.vars[j];
			  wprim->blockparms.vars[j] = $$.varname; }
			else {
			  namptr = wprim->blockparms.vars[j];
							/* while (namptr^.next<>nil) and
							   (namptr^.next<>lastvar) do */
			  while (namptr->nextname != lastvar) { namptr = namptr->nextname; }
			  namptr->nextname = $$.varname;
			  $$.varname->nextname = lastvar;
			  }
			wprim->blockparms.nvars[j]++;
			$$.varname->val = 0.0;
		    }
		  if ($3.lexval == Xeq) { $$.varname->val = $4.xval; }
		  else { eqop(&$$.varname->val, $3.lexval, $4.xval); }
		  $$.xval = $$.varname->val;

		  clearchbuf($1.chbufx, $1.toklen);
          }

		| Xenvvar Xeq assignrhs                              /* assignment2 */
		{ if (envblock != NULL) {
		    if (($1.lexval == Xarrowhead) && (drawmode == TeX) &&
		      ($3.xval == 0.0)) { markerror(858); }
		    else {
		      if (envblock->blockparms.env == NULL) { inheritenv(envblock); }
		      if ($1.lexval == Xscale) {
			    resetscale($3.xval, $2.lexval, envblock); }
		      else { eqop(&envblock->envinx($1.lexval), $2.lexval, $3.xval); }
		      }
		    $$.xval = envblock->envinx($1.lexval);
#ifdef DDEBUG
		    if (debuglevel > 0) {
		      fprintf(log_, " Assignment3or4 envblock[%d]: lexval=%d value=",
			    ordp(envblock), $1.lexval);
		      wfloat(&log_, envblock->envinx($1.lexval)); putc('\n', log_); }
#endif
		    $$.startchop = $$.lexval;
		    if (($$.lexval == Xdashwid) || ($$.lexval == Xlinethick)) {
		      newprim(&($$.prim), XLaTeX, envblock);
		      if ($1.lexval == Xlinethick) { $$.prim->lthick = $$.xval; }
		      else { $$.prim->lparam = $$.xval; }
		      }
	        }
		  }
		;

assignrhs : expression                                        /* assignrhs1 */

		| assignment                                          /* assignrhs2 */
		;

expression	:	term                                         /* expression1 */

		| Xplus term                                         /* expression2 */
		{ $$.xval = $2.xval; }

		| Xminus term                                        /* expression3 */
		{ $$.xval = -$2.xval; }

		| expression Xplus term                              /* expression4 */
		{ $$.xval = $1.xval + $3.xval; }

		| expression Xminus term                             /* expression5 */
		{ $$.xval = $1.xval - $3.xval; }
		;

ifhead	:	setlogic logexpr Xthen Xleftbrace                    /* ifhead1 */
		{ inlogic = false;
    	  $$.xval = $2.xval;
    	  if ($$.xval == 0.0) {
		    currprod = 2 /* ifhead1 */;
		    skiptobrace();
    	    }
		  }
		;

setlogic:	Xif                                                /* setlogic1 */
		{ inlogic = true; }
		;

logexpr	:	logprod                                             /* logexpr1 */

		| logexpr Xoror logprod                                 /* logexpr2 */
		{ if (($1.xval != 0.0) || ($3.xval != 0.0)) { $$.xval = 1.0; }
    	  else { $$.xval = 0.0; }
		  }
		;

forhead	:	Xfor assignlist Xto expression do Xleftbrace        /* forhead1 */
		{
		  $$.xval = $2.xval;                     /* initial value  */
		  $$.yval = $5.xval;                          /* increment */
		  $$.endchop = $4.xval;                     /* final value */
		  $$.toklen = 0;                                  /* flags */
		  if ($$.xval == $$.endchop) {
			$$.toklen = -1;
			$$.yval = 1.0; }
		  else if ($5.lexval == Xmult) {
			t = 0.0;
			if ($$.xval == 0.0) { $$.toklen = 860; }
			else { t = $$.endchop * $$.xval; }
			if (t < 0.0) { $$.toklen = 862; }
			else if ((t == 0.0) && (fabs($$.yval * $$.xval) != 0.0)) {
			  $$.toklen = 860; }
			else if (($$.yval == 0.0) && (t != 0.0)) { $$.toklen = 860; }
			else if ((fabs($$.yval) == 1) &&
				 (fabs($$.xval) != fabs($$.endchop))) { $$.toklen = 860; }
			else { $$.toklen = 1; }
		    }
		  else if ($$.yval == 0.0) { $$.toklen = 860; }
		  else if (($$.endchop - $$.xval) * $$.yval > 0) { $$.toklen = -1; }
		  if ($$.toklen > 800) { markerror($$.toklen); $$.toklen = 0; }
							/* store loop variable */
		  $$.startchop = $2.startchop;
		  if ($$.startchop == 0.0) {
			$$.varname = $2.varname;
			$$.varname->val = $$.xval; }
		  else if ((Rnd($$.startchop)) != Xscale) {
			if (envblock->blockparms.env == NULL) { inheritenv(envblock); }
			envblock->envinx($$.startchop) = $$.xval; }
		  else { resetscale($$.xval, Xeq, envblock); }

		  currprod = 3 /* forhead1 */ ;
		  if ($$.toklen == 0) { skiptobrace(); }
          else { readfor(NULL, 1, &inbuf, '}', true); }
#ifdef DDEBUG
    	  if (debuglevel > 0) {
            fprintf(log_," forhead:\n");
		    wrbufaddr(inbuf,0);
		    fprintf(log_, "for: initial="); wfloat(&log_, $$.xval);
		    fprintf(log_, " final="); wfloat(&log_, $$.endchop);
		    fprintf(log_, " incr="); wfloat(&log_, $$.yval);
		    putc('\n', log_); }
#endif
		  }
		;

forincr	: Xendfor                                               /* forincr1 */
		{ $$ = forattr;
	    attribp = &$$;
#ifdef DDEBUG
		if (debuglevel>1) prattribute("forincr1 $$",&$$);
#endif
	    if (attribp->varname != NULL) { attribp->xval = attribp->varname->val; }
	    else { attribp->xval = envblock->envinx(attribp->startchop); }
	    bswitch = false;
	    if (attribp->toklen < 0) {
		  if (attribp->yval == 0) { bswitch = true; }
		  else {
		    attribp->xval += attribp->yval;
		    if (((attribp->yval > 0) && (attribp->xval > attribp->endchop)) ||
			    ((attribp->yval < 0) && (attribp->xval < attribp->endchop))) {
			  bswitch = true; }
		    }
	      }
	    else if (attribp->xval == 0) { bswitch = true; }
	    else {
		  attribp->xval *= attribp->yval;
		  if (((fabs(attribp->yval) >= 1.0) &&
		     (fabs(attribp->xval) > fabs(attribp->endchop))) ||
		    ((fabs(attribp->yval) < 1.0) &&
		     (fabs(attribp->xval) < fabs(attribp->endchop)))) { bswitch= true; }
	      }
	    if (attribp->varname != NULL) { attribp->varname->val = attribp->xval; }
	    else if ((Rnd(attribp->startchop)) != Xscale) {
		  envblock->envinx(attribp->startchop)= attribp->xval; }
	    else { resetscale(attribp->xval, Xeq, envblock); }
	    if (bswitch) {
		  while (inbuf->attrib < 0) {
		    lastm = inbuf;
		    inbuf = inbuf->higherb;
		    disposebufs(&lastm); }
		  lastm = inbuf;
		  inbuf = inbuf->higherb;
		  disposebufs(&lastm);
	      }
		}
		;

do	:	Xdo                                                          /* do1 */
		{ $$.xval = 1.0; }

		| by expression Xdo                                          /* do2 */
		{ $$.xval = $2.xval; }
		;

by	:	Xby                                                          /* by1 */

		| Xby Xmult                                                  /* by2 */
		{ $$.lexval = $2.lexval; }
		;

redirect:                                                      /* redirect1 */
		{ $$.lexval = XEMPTY; }

		| Xcompare stringexpr                                  /* redirect2 */
		{ attribp = &$2;
		  $$.state = 1;
		  bswitch = false;
		  if (attribp->prim != NULL) {
			if (attribp->prim->textp == NULL) { markerror(861); }
			else if ($1.lexval != Xgt) { markerror(869); }
			else if (safemode) { markerror(901); }
			else { bswitch = true; }
		    }
#ifdef SAFE_MODE
		  if (bswitch) { markerror(901); }
#else
		  if (bswitch) { pointoutput(true,attribp->prim->textp, &$$.state); }
#endif
		  deletestringbox(&attribp->prim);
		  }

		| Xcompare Xcompare stringexpr                         /* redirect3 */
		{ attribp = &$3;
		  $$.state = 1;
		  bswitch = false;
		  if (attribp->prim != NULL) {
			if (attribp->prim->textp == NULL) { markerror(861); }
			else if (($1.lexval != Xgt) || ($2.lexval != Xgt)) {
			    markerror(869); }
			else if (safemode) { markerror(901); }
			else { bswitch = true; }
		    }
#ifdef SAFE_MODE
		  if (bswitch) { markerror(901); }
#else
		  if (bswitch) { pointoutput(false, attribp->prim->textp, &$$.state); }
#endif
		  deletestringbox(&attribp->prim);
		  }
		;

resetlist:	Xenvvar                                           /* resetlist1 */
		{ resetenv($1.lexval, envblock); }

		| resetlist Xcomma Xenvvar                            /* resetlist2 */
		{ resetenv($3.lexval, envblock); }
		;

systemcmd:	Xsh stringexpr                                    /* systemcmd1 */
		{ $$.xval = -1.0;
	      attribp = &$2;
	      if (attribp->prim != NULL) {
		    if (attribp->prim->textp != NULL) {
		      primtextp = attribp->prim->textp;
		      if (primtextp->segmnt != NULL) {
			    if (primtextp->seginx + primtextp->len >= CHBUFSIZ) {markerror(866); }
			    else if (safemode) { markerror(901); }
#ifndef SAFE_MODE
			    else {
			      primtextp->segmnt[primtextp->seginx + primtextp->len] = '\0';
			      $$.xval = system((char*)
                    &primtextp->segmnt[primtextp->seginx]); }
#endif
		        }
		      }
		    deletestringbox(&attribp->prim);
	        }
#ifdef DDEBUG
		  if (debuglevel>1) { prattribute("systemcmd1",&$$); }
#endif
		  }
		;

sprintf	:	Xsprintf Xlparen stringexpr                         /* sprintf1 */
		{ $$.prim = sprintfstring( &$3, &$3, 0 );
          $$.lexval = Xstring;
          }



		| Xsprintf Xlparen stringexpr Xcomma exprlist           /* sprintf2 */
		{ $$.prim = sprintfstring( &$3, &$5, $5.state );
          $$.lexval = Xstring;
          }
		;

exprlist:	expression                                         /* exprlist1 */
		{ $$.state = 1; }

		| expression Xcomma exprlist  /* right recursion */    /* exprlist2 */
		{ $$.state = $3.state + 1; }
		;

object	:	block                                                /* object1 */

		| object Xht expression                                  /* object2 */
		{ if ($1.prim != NULL) {
			wprim = $1.prim;
			switch (wprim->ptype) {
			  case Xbox:
			  case Xblock:
			    if (wprim->ptype == Xblock) {
			      r = 0.5 * ($3.xval - wprim->blockheight_);
			      wprim->blockheight_ = $3.xval; }
			    else {
			      r = 0.5 * ($3.xval - wprim->boxheight_);
			      wprim->boxheight_ = $3.xval; }
			    if (!teststflag($1.state, Xat)) {
			      switch (wprim->direction) {
			        case Xleft:
			        case Xright:
				      break; /* blank case */
			        case Xup:
				      shift($1.prim, 0.0, r);
				      break;
			        case Xdown:
				      shift($1.prim, 0.0, -r);
				      break;
			        }
			      }
			    break;
			  case Xstring:
	  			wprim->boxheight_ = $3.xval;
	  			if ((drawmode == PDF) && (wprim->textp != NULL)) {
	      		  wprim->boxwidth_ = wprim->boxheight_ *
					wprim->textp->len * 0.6;
	  			  }
	  			break;
			  case Xcircle:
			    if (!teststflag($1.state, Xat)) {
			      switch (wprim->direction) {
			        case Xleft:
			        case Xright:
				      break; /* blank case */
			        case Xup:
				      wprim->aat.ypos += (0.5 * $3.xval) - wprim->circleradius_;
				      break;
			        case Xdown:
				      wprim->aat.ypos += wprim->circleradius_ - (0.5 * $3.xval);
				      break;
			        }
			      }
			    wprim->circleradius_ = $3.xval * 0.5;
			    break;
			  case Xellipse:
			    if (!teststflag($1.state, Xat)) {
			      switch (wprim->direction) {
			        case Xleft:
			        case Xright:
				      break; /* blank case */
			        case Xup:
				      wprim->aat.ypos +=
				        0.5 * ($3.xval - wprim->ellipseheight_);
				      break;
			        case Xdown:
				      wprim->aat.ypos +=
				        0.5 * (wprim->ellipseheight_ - $3.xval);
				      break;
			        }
			      }
			    wprim->ellipseheight_ = $3.xval;
			    break;
			  case Xline:
			  case Xarrow:
			  case Xmove:
			  case Xarc:
			  case Xspline:
			    prp = $1.prim;
			    while (prp != NULL) {
			      prp->lineheight_ = $3.xval;
			      if (isthen(prp)) { prp = prp->parent; } else { prp = NULL; }
			      }
			    break;
			  case Xlabel:
			  case XLaTeX:
			    markerror(858);
			    break;
			    }
		      }
			}

		| object Xwid expression                                 /* object3 */
		{ if ($1.prim != NULL) {
			wprim = $1.prim;
			switch (wprim->ptype) {
			  case Xbox:
			  case Xblock:
			    if (wprim->ptype == Xblock) {
			      r = 0.5 * ($3.xval - wprim->blockwidth_);
			      wprim->blockwidth_ = $3.xval; }
			  else {
			      r = 0.5 * ($3.xval - wprim->boxwidth_);
			      wprim->boxwidth_ = $3.xval; }
			  if (!teststflag($1.state, Xat)) {
			    switch (wprim->direction) {
			      case Xup:
			      case Xdown:
				    break; /* blank case */
			      case Xright:
				    shift($1.prim, r, 0.0);
				    break;
			      case Xleft:
				    shift($1.prim, -r, 0.0);
				    break;
			      }
			    }
			  break;
			case Xstring:
			  wprim->boxwidth_ = $3.xval;
			  break;
			case Xcircle:
			  if (!teststflag($1.state, Xat)) {
			    switch (wprim->direction) {
			      case Xup:
			      case Xdown:
				    break; /* blank case */
			      case Xright:
				    wprim->aat.xpos += (0.5 * $3.xval) - wprim->circleradius_;
				    break;
			      case Xleft:
				    wprim->aat.xpos += wprim->circleradius_ - (0.5 * $3.xval);
				    break;
			      }
			    }
			  wprim->circleradius_ = $3.xval * 0.5;
			  break;
			case Xellipse:
			  if (!teststflag($1.state, Xat)) {
			    switch (wprim->direction) {
			      case Xup:
			      case Xdown:
				    break; /* blank case */
			      case Xright:
				    wprim->aat.xpos += 0.5 * ($3.xval - wprim->ellipsewidth_);
				    break;
			      case Xleft:
				    wprim->aat.xpos += 0.5 * (wprim->ellipsewidth_ - $3.xval);
				    break;
			      }
			    }
			  wprim->ellipsewidth_ = $3.xval;
			  break;
			case Xline:
			case Xarrow:
			case Xmove:
			case Xarc:
			case Xspline:
			  prp = $1.prim;
			  while (prp != NULL) {
			    prp->linewidth_ = $3.xval;
			    if (isthen(prp)) { prp = prp->parent; } else { prp = NULL; }
			    }
			  break;
			case Xlabel:
			case XLaTeX:
			  markerror(858);
			  break;
			  }
		    }
	 	  }

		| object Xrad expression                                 /* object4 */
		{ if ($1.prim != NULL) {
			wprim = $1.prim;
			switch (wprim->ptype) {
			  case Xbox:
			    wprim->boxradius_ = $3.xval;
			    break;
			  case Xarc:
			    t = $3.xval;
			    if (wprim->direction == 0) {
			      $3.xval = wprim->aat.xpos + (wprim->aradius_ *
                    cos( wprim->startangle_ + wprim->arcangle_));
			      $3.yval = wprim->aat.ypos + (wprim->aradius_ *
                    sin( wprim->startangle_ + wprim->arcangle_));
			      r = cos(wprim->startangle_);
			      s = sin(wprim->startangle_);
			      wprim->aat.xpos += wprim->aradius_ * r;
			      wprim->aat.ypos += wprim->aradius_ * s;
			      wprim->aradius_ = t;
			      wprim->aat.xpos -= wprim->aradius_ * r;
			      wprim->aat.ypos -= wprim->aradius_ * s;
			      setstflag(&$1.state, Xradius);
			      goto object_xx;
			      }
			    else {
			      r = cos(wprim->startangle_);
			      s = sin(wprim->startangle_);
			      $$.prim->aat.xpos += wprim->aradius_ * r;
			      $$.prim->aat.ypos += wprim->aradius_ * s;
			      $$.prim->aradius_ = t;
			      $$.prim->aat.xpos -= wprim->aradius_ * r;
			      $$.prim->aat.ypos -= wprim->aradius_ * s;
			      setstflag(&$$.state, Xradius);
				  }
			    break;
			  case Xcircle:
			    if (!teststflag($1.state, Xat)) {
			      switch (wprim->direction) {
			        case Xleft:
				      wprim->aat.xpos += wprim->circleradius_ - $3.xval;
				      break;
			        case Xright:
				      wprim->aat.xpos += $3.xval - wprim->circleradius_;
				      break;
			        case Xup:
				      wprim->aat.ypos += $3.xval - wprim->circleradius_;
				      break;
			        case Xdown:
				      wprim->aat.ypos += wprim->circleradius_ - $3.xval;
				      break;
			        }
			      }
			    wprim->circleradius_ = $3.xval;
			    setstflag(&$1.state, Xradius);
			    break;
			  default:
			    markerror(858);
			    break;
			  }
		    }
		  }

		| object Xdiam expression                                /* object5 */
		{ if ($1.prim != NULL) {
			wprim = $1.prim;
			if (wprim->ptype == Xcircle) {
			  r = 0.5 * $3.xval;
			  if (!teststflag($1.state, Xat)) {
				switch (wprim->direction) {
				  case Xleft:
				    wprim->aat.xpos += wprim->circleradius_ - r;
				    break;
				  case Xright:
				    wprim->aat.xpos += r - wprim->circleradius_;
				    break;
				  case Xup:
				    wprim->aat.ypos += r - wprim->circleradius_;
				    break;
				  case Xdown:
				    wprim->aat.ypos += wprim->circleradius_ - r;
				    break;
				  }
			    }
			  wprim->circleradius_ = r;
			  }
			else { markerror(858); }
		    }
		  }

		| object Xthick expression                               /* object6 */
		{ if ($1.prim != NULL) { wprim = $1.prim;
			if ($3.xval >= 0.0) { wprim->lthick = $3.xval; }
            else { wprim->lthick = venv(wprim,Xlinethick); } }   /*Error msg?*/
		  }

		| object Xscaled expression                              /* object7 */
		{ if (($1.prim != NULL) && ($3.lexval != XEMPTY)) {
			wprim = $$.prim;
			r = $3.xval - 1;
			corner($1.prim, Dotc, &x1, &z1);
			switch (wprim->ptype) {
			  case Xbox:
			  case Xblock:
			  case Xstring:
			    if (teststflag($1.state, Xat)) {
			      dx = 0.0;
			      dy = 0.0;
			      }
			    else if (wprim->ptype == Xblock) {
			      dx = wprim->blockwidth_ * r / 2;
			      dy = wprim->blockheight_ * r / 2;
			      }
			    else {
			      dx = wprim->boxwidth_ * r / 2;
			      dy = wprim->boxheight_ * r / 2;
			      }
			    scaleobj($$.prim, $3.xval);
			    switch (wprim->direction) {
			      case Xright: shift(
                    $$.prim, x1 - wprim->aat.xpos + dx, z1 - wprim->aat.ypos);
			        break;
			      case Xleft: shift(
                    $$.prim, x1 - wprim->aat.xpos - dx, z1 - wprim->aat.ypos);
			        break;
			      case Xup: shift(
                    $$.prim, x1 - wprim->aat.xpos, z1 - wprim->aat.ypos + dy);
			        break;
			      case Xdown: shift(
                    $$.prim, x1 - wprim->aat.xpos, z1 - wprim->aat.ypos - dy);
			        break;
			      }
			    break;
			  case Xcircle:
			    wprim->circleradius_ = $3.xval * wprim->circleradius_;
			    if (!teststflag($1.state, Xat)) {
			      switch (wprim->direction) {
			        case Xup:
				      wprim->aat.xpos = x1;
				      wprim->aat.ypos = z1 + wprim->circleradius_;
				      break;
			        case Xdown:
				      wprim->aat.xpos = x1;
				      wprim->aat.ypos = z1 - wprim->circleradius_;
				      break;
			        case Xright:
				      wprim->aat.xpos = x1 + wprim->circleradius_;
				      wprim->aat.ypos = z1;
				      break;
			        case Xleft:
				      wprim->aat.xpos = x1 - wprim->circleradius_;
				      wprim->aat.ypos = z1;
				      break;
			        }
			      }
			    break;
			  case Xellipse:
			    wprim->ellipsewidth_ *= $3.xval;
			    wprim->ellipseheight_ *= $3.xval;
			    if (!teststflag($1.state, Xat)) {
			      switch (wprim->direction) {
			        case Xup:
				      wprim->aat.xpos = x1;
				      wprim->aat.ypos = z1 + (wprim->ellipseheight_ / 2);
				      break;
			        case Xdown:
				      wprim->aat.xpos = x1;
				      wprim->aat.ypos = z1 - (wprim->ellipseheight_ / 2);
				      break;
			        case Xright:
				      wprim->aat.xpos = x1 + (wprim->ellipsewidth_ / 2);
				      wprim->aat.ypos = z1;
				      break;
			        case Xleft:
				      wprim->aat.xpos = x1 - (wprim->ellipsewidth_ / 2);
				      wprim->aat.ypos = z1;
				      break;
			        }
			      }
			    break;
			  case Xline:
			  case Xarrow:
			  case Xmove:
			  case Xarc:
			  case Xspline:
			    scaleobj($$.prim, $3.xval);
			    corner($$.prim, Dotc, &r, &s);
			    shift($$.prim, x1 - r, z1 - s);
			    break;
			  case Xlabel:
			  case XLaTeX:
			    markerror(858);
			    break;
			  }
		    }
		  }

		| object Xdirecton optexp                                /* object8 */
		{ if ($$.prim != NULL) {
			wprim = $$.prim;
			if ((wprim->ptype == Xspline) || (wprim->ptype == Xarrow) ||
			    (wprim->ptype == Xmove) || (wprim->ptype == Xline) ||
			    (wprim->ptype == Xarc)) {
			  i = $2.lexval;
			  envblock->direction = i;
			  eb = findenv(envblock);
			  switch (wprim->ptype) {
			    case Xarc:
			      r = cos(wprim->startangle_);
			      s = sin(wprim->startangle_);
			      wprim->aat.xpos += wprim->aradius_ * r;
			      wprim->aat.ypos += wprim->aradius_ * s;
				  nwi = wprim->direction;
			      if (((nwi == Xup) && (i == Xleft)) ||
				      ((nwi == Xdown) && (i == Xright)) ||
				      ((nwi == Xright) && (i == Xup)) ||
				      ((nwi == Xleft) && (i == Xdown))) {
				    wprim->arcangle_ = pi * 0.5; }
			      else if (((nwi == Xup) && (i == Xright)) ||
				      ((nwi == Xdown) && (i == Xleft)) ||
				      ((nwi == Xright) && (i == Xdown)) ||
				      ((nwi == Xleft) && (i == Xup))) {
				    wprim->arcangle_ = (-pi) * 0.5; }
			      if ($3.lexval != XEMPTY) {
				    wprim->aradius_ = $3.xval; }
			      wprim->aat.xpos -= wprim->aradius_ * r;
			      wprim->aat.ypos -= wprim->aradius_ * s;
			      wprim->direction = i;
			      break;
			    case Xline:
			    case Xmove:
			    case Xarrow:
			    case Xspline:
			      wprim->direction = i;
			      if ($3.lexval != XEMPTY) { r = $3.xval; s = r; }
			      else { switch (wprim->ptype) {
				    case Xline:
				    case Xarrow:
				    case Xspline:
				      r = eb->envinx(Xlineht);
				      s = eb->envinx(Xlinewid);
				      break;
				    case Xmove:
				      r = eb->envinx(Xmoveht);
				      s = eb->envinx(Xmovewid);
				      break;
				      }
			        }
			      lineardir($$.prim, r, s, &$$.state);
			      break;
			      }
			  }
			else { markerror(858); }
		    }
#ifdef DDEBUG
	    if (debuglevel > 0) { printobject($$.prim); }
#endif
		  }

		| object Xlinetype optexp                                /* object9 */
		{ if ($1.prim != NULL) {
			setspec(&$$.prim->spec, $2.lexval);
			if ($3.lexval == XEMPTY) {
              if ($2.lexval == Xdashed) {
				eb = findenv(envblock);
                $$.prim->lparam = eb->envinx(Xdashwid); }
              }
            else if ((($2.lexval == Xsolid) || ($2.lexval == Xinvis))
               && (($1.prim->ptype == Xmove) || ($1.prim->ptype == Xspline)
                || ($1.prim->ptype == Xarrow) || ($1.prim->ptype == Xline))) {
			  lineardir($$.prim, $3.xval, $3.xval, &$$.state); }
			else if (($2.lexval == Xsolid) || ($2.lexval == Xinvis)) {
			  markerror(858); }
			else { $$.prim->lparam = $3.xval; }
		    }
#ifdef DDEBUG
	    if (debuglevel > 0) { printobject($$.prim); }
#endif
		  }

		| object Xchop optexp                                   /* object10 */
		{ if ($1.prim != NULL) {
			if (($1.prim->ptype != Xspline) &&
			    ($1.prim->ptype != Xmove) &&
			    ($1.prim->ptype != Xarrow) && ($1.prim->ptype != Xline)) {
			  markerror(858); }
			else {
			  wprim = $1.prim;
			  if ($3.lexval != XEMPTY) { r = $3.xval; }
			  else {
				eb = findenv(envblock);
				r = eb->envinx(Xcirclerad);
			    }
			  if (teststflag($$.state, Xchop)) { $$.endchop = r; }
			  else {
				$$.startchop = r;
				$$.endchop = r;
				setstflag(&$$.state, Xchop);
			    }
			  }
		    }
		  }

		| object Xfill optexp                                   /* object11 */
		{ if ($1.prim != NULL) {
			wprim = $1.prim;
			if ($3.lexval != XEMPTY) { s = $3.xval; }
			else {
			  eb = findenv(envblock);
			  s = eb->envinx(Xfillval);
			  }
			prp = $$.prim;
			while (prp != NULL) {
			  switch (wprim->ptype) {
			    case Xbox:
			      prp->boxfill_ = s;
			      break;
			    case Xcircle:
			      prp->circlefill_ = s;
			      break;
			    case Xellipse:
			      prp->ellipsefill_ = s;
			      break;
			    default:
                  if ((drawmode == TeX) || (drawmode == tTeX) ||
                      (drawmode == Pict2e)) { markerror(858); }
			      else {
				    switch (wprim->ptype) {
				      case Xline:
				      case Xarrow:
				      case Xmove:
				      case Xspline:
				      case Xarc:
				        prp->linefill_ = s;
				        break;
				      default:
				        markerror(858);
				        break;
				      }
			        }
			      break;
			    }
			  if (isthen(prp)) { prp = prp->parent; }
			  else { prp = NULL; }
			  }
		    }
		  }

		| object Xarrowhd optexp                                /* object12 */
		{ if ($$.prim != NULL) {
			wprim = $$.prim;
			if ((wprim->ptype != Xspline) && (wprim->ptype != Xarc) &&
			    (wprim->ptype != Xarrow) && (wprim->ptype != Xline)) {
			  markerror(858); }
			else {
			  wprim->lineatype_ = pahlex(wprim->lineatype_,$2.lexval);
			  if ($3.lexval != XEMPTY) { lj = Rnd($3.xval); }
			  else {
				eb = findenv(envblock);
				lj = (long)floor(eb->envinx(Xarrowhead)+0.5);
			    }
			  wprim->lineatype_ = pahnum(wprim->lineatype_, lj);
			  }
		    }
		  }

		| object Xthen                                          /* object13 */
		{ if ($1.prim != NULL) {
#ifdef DDEBUG
		    if (debuglevel > 0) {
	          fprintf(log_, "lexical \"then\" found, ");
	          prtstval($1.state); putc('\n', log_); }
#endif
			appendthen(&$$.prim);
			if ($1.prim->ptype != Xarc) { setstflag(&$$.state, XEMPTY); }
		    }
		  }

		| object Xcw                                            /* object14 */
		{ if ($1.prim != NULL) {
			wprim = $1.prim;
			if (wprim->ptype != Xarc) { markerror(858); }
			else {
			  if ((wprim->arcangle_ > 0.0) && (wprim->direction == 0)) {
				wprim->arcangle_ = -fabs(
				  principal((2.0 * pi) - wprim->arcangle_,2.0*pi));}
			  else if (wprim->direction != 0) {
				wprim->aat = arcstart($$.prim);
				switch (wprim->direction) {
				  case Xup:
				    wprim->aat.xpos += wprim->aradius_;
				    break;
				  case Xdown:
				    wprim->aat.xpos -= wprim->aradius_;
				    break;
				  case Xleft:
				    wprim->aat.ypos += wprim->aradius_;
				    break;
				  case Xright:
				    wprim->aat.ypos -= wprim->aradius_;
				    break;
				  }
				if (wprim->arcangle_ > 0.0) {
				  wprim->startangle_ =
                    principal(wprim->startangle_ + pi, pi); }
				  wprim->arcangle_ = -fabs(wprim->arcangle_);
			    }
			  setstflag(&$$.state, Xcw);
			  }
		    }
		  }

		| object Xccw                                           /* object15 */
		{ if ($1.prim != NULL) {
			wprim = $1.prim;
			if (wprim->ptype != Xarc) { markerror(858); }
			else {
			  if ((wprim->arcangle_ < 0.0) && (wprim->direction == 0)) {
				wprim->arcangle_ =
                  fabs(principal(wprim->arcangle_ - (2.0 * pi),2.0*pi)); }
			  else if (wprim->direction != 0) {
				wprim->aat = arcstart($1.prim);
				switch (wprim->direction) {
				  case Xup: wprim->aat.xpos -= wprim->aradius_; break;
				  case Xdown: wprim->aat.xpos += wprim->aradius_; break;
				  case Xleft: wprim->aat.ypos -= wprim->aradius_; break;
				  case Xright: wprim->aat.ypos += wprim->aradius_; break;
				  }
				if (wprim->arcangle_ < 0.0) {
				  wprim->startangle_ =
                    principal( wprim->startangle_ + pi, pi); }
				  wprim->arcangle_ = fabs(wprim->arcangle_);
			    }
			  setstflag(&$1.state, Xccw);
			  }
		    }
		  }

		| object Xsame                                          /* object16 */
		{ if ($1.prim != NULL) {
			prp = nthprimobj(envblock->son, 0, $1.prim->ptype);
			if (prp == NULL) { markerror(857); }
			else {
			  wprim = $1.prim;
			  wprim->lparam = prp->lparam;
			  wprim->lthick = prp->lthick;
			  wprim->direction = prp->direction;
			  wprim->spec = prp->spec;
			  if (hasoutline($1.lexval, false)) {
				copystr(&wprim->outlinep, prp->outlinep); }
			  if (hasshade($1.lexval, false)) {
				copystr(&wprim->shadedp, prp->shadedp); }
			  }
			if (prp != NULL) {
			  wprim = $1.prim;
			  switch (wprim->ptype) {
			    case Xbox:
			    case Xstring:
			      if (wprim->ptype == Xbox) {
				    switch (wprim->direction) {
				      case Xup:
				        wprim->aat.ypos += 0.5 *
					      (prp->boxheight_ - wprim->boxheight_);
				        break;
				      case Xdown:
				        wprim->aat.ypos -= 0.5 *
					      (prp->boxheight_ - wprim->boxheight_);
				        break;
				      case Xleft:
				        wprim->aat.xpos -=
				          0.5 * (prp->boxwidth_ - wprim->boxwidth_);
				        break;
				      case Xright:
				        wprim->aat.xpos +=
				          0.5 * (prp->boxwidth_-wprim->boxwidth_);
				        break;
				      }
			        }
			      wprim->boxfill_ = prp->boxfill_;
			      wprim->boxheight_ = prp->boxheight_;
			      wprim->boxwidth_ = prp->boxwidth_;
			      wprim->boxradius_ = prp->boxradius_;
			      break;
			    case Xblock:
			      markerror(858);
			      break;
			    case Xcircle:
			      switch (wprim->direction) {
			        case Xup:
				      wprim->aat.ypos +=
                        prp->circleradius_ - wprim->circleradius_;
				      break;
			        case Xdown:
				      wprim->aat.ypos +=
                        wprim->circleradius_ - prp->circleradius_;
				      break;
			        case Xleft:
				      wprim->aat.xpos +=
                        wprim->circleradius_ - prp->circleradius_;
				      break;
			        case Xright:
				      wprim->aat.xpos +=
                        prp->circleradius_ - wprim->circleradius_;
				      break;
			        }
			      wprim->circlefill_ = prp->circlefill_;
			      wprim->circleradius_ = prp->circleradius_;
			      break;
			    case Xellipse:
			      switch (wprim->direction) {
			        case Xup:
				      wprim->aat.ypos +=
				        0.5 * (prp->ellipseheight_ - wprim->ellipseheight_);
				      break;
			        case Xdown:
				      wprim->aat.ypos -=
				        0.5 * (prp->ellipseheight_ - wprim->ellipseheight_);
				      break;
			        case Xleft:
				      wprim->aat.xpos -=
				        0.5 * (prp->ellipsewidth_ - wprim->ellipsewidth_);
				      break;
			        case Xright:
				      wprim->aat.xpos +=
				        0.5 * (prp->ellipsewidth_ - wprim->ellipsewidth_);
				      break;
			        }
			      wprim->ellipsefill_ = prp->ellipsefill_;
			      wprim->ellipseheight_ = prp->ellipseheight_;
			      wprim->ellipsewidth_ = prp->ellipsewidth_;
			      break;
			    case Xarc:
			      x1 = wprim->aat.xpos +
                    (wprim->aradius_ * cos(wprim->startangle_));
			      z1 = wprim->aat.ypos + 
                    (wprim->aradius_ * sin(wprim->startangle_));
			      wprim->aradius_ = prp->aradius_;
			      wprim->startangle_ = prp->startangle_;
			      wprim->aat.xpos = x1 -
                    (wprim->aradius_ * cos(wprim->startangle_));
			      wprim->aat.ypos = z1 -
                    (wprim->aradius_ * sin(wprim->startangle_));
			      wprim->arcangle_ = prp->arcangle_;
			      break;
			    case Xline:
			    case Xarrow:
			    case Xmove:
			    case Xspline:
			      wprim->endpos_.xpos =
				    wprim->aat.xpos + prp->endpos_.xpos-prp->aat.xpos;
			      wprim->endpos_.ypos =
				    wprim->aat.ypos + prp->endpos_.ypos-prp->aat.ypos;
			      wprim->lineheight_ = prp->lineheight_;
			      wprim->linewidth_ = prp->linewidth_;
			      wprim->lineatype_ = prp->lineatype_;
			      break;
			    case Xlabel:
			    case XLaTeX:
			      markerror(858);
			      break;
			    }
			  }
		    }
		  }

		| object stringexpr                                     /* object17 */
		{ if ($2.prim != NULL) {
			if ($1.prim != NULL) {
			  wprim = $1.prim;
			  if (wprim->textp == NULL) { wprim->textp = $2.prim->textp; }
			  else {
				namptr = wprim->textp;
				i = 1;
				while (namptr->nextname != NULL) { namptr = namptr->nextname; i++; }
				namptr->nextname = $2.prim->textp;
				if (wprim->ptype == Xstring) {
				  if (drawmode == SVG) {
					eb = findenv(envblock);
					if (eb != NULL) {
					  r = findvar("dptextratio", 11);
					  if (r == 0) { r = 1.0; }
					  wprim->boxheight_ += eb->envinx(Xtextht) / r;
					  }
				    }
				  else { wprim->boxheight_ *= ((i + 1) / i); }
				  }
			    }
			  if ((drawmode == PS) || (drawmode == PDF) ||
			      (drawmode == PSfrag)) { /* output contains text */
				printstate = ((printstate >> 1) * 2) + 1;
			    }
			  }
			$2.prim->textp = NULL;
			deletestringbox(&$2.prim);
		    }
		  }

		| object Xby position                                   /* object18 */
		{ if ($1.prim != NULL) {
			$$  = $1;
			if (($1.prim->ptype == Xmove) || ($1.prim->ptype == Xspline) ||
			  ($1.prim->ptype == Xarrow) || ($1.prim->ptype == Xline) ||
			  ($1.prim->ptype == Xarc)) {
			    wprim = $1.prim;
			    x1 = $3.xval + wprim->aat.xpos;
			    z1 = $3.yval + wprim->aat.ypos;
			    if (wprim->ptype == Xarc) {
				  x1 += wprim->aradius_ * cos(wprim->startangle_);
				  z1 += wprim->aradius_ * sin(wprim->startangle_);
			      }
			    $3.xval = x1;
			    $3.yval = z1;
                goto object_xx;
			    }
			  else { markerror(858); }
		    }
		  }

		| object Xfrom position                                 /* object19 */
		{ if ($1.prim != NULL) {
			wprim = $$.prim;
			if ((wprim->ptype == Xmove) || (wprim->ptype == Xspline) ||
			  (wprim->ptype == Xarrow) || (wprim->ptype == Xline) ||
              (wprim->ptype == Xarc)) {
			  if (wprim->ptype == Xarc) {
                r = $3.xval;
                s = $3.yval;
				if (teststflag($1.state, Xto)) {
				  $3.xval = wprim->aat.xpos + (wprim->aradius_ *
                    cos( wprim->startangle_ + wprim->arcangle_));
				  $3.yval = wprim->aat.ypos + (wprim->aradius_ *
                    sin( wprim->startangle_ + wprim->arcangle_));
				  }
				wprim->aat.xpos = r -
                  (wprim->aradius_ * cos(wprim->startangle_));
				wprim->aat.ypos = s -
                  (wprim->aradius_ * sin(wprim->startangle_));
				if (teststflag($1.state, Xto)) { goto object_xx; }
			    }
			  else if (!teststflag($1.state, Xto)) {
				prp = $1.prim;
				while (isthen(prp)) { prp = prp->parent; }
				shift(prp, $3.xval - prp->aat.xpos, $3.yval - prp->aat.ypos);
			    }
			  else {
				wprim->aat.xpos = $3.xval;
				wprim->aat.ypos = $3.yval;
                }
			  setstflag(&$1.state, Xfrom);
			  }
			else { markerror(858); }
		    }
		  }

		| object Xto position                                   /* object20 */
		{
          object_xx:
    	    if ($1.prim != NULL) {
    	      if (($1.prim->ptype == Xmove) || ($1.prim->ptype == Xspline) ||
    	        ($1.prim->ptype == Xarrow) || ($1.prim->ptype == Xline) ||
    	        ($1.prim->ptype == Xarc)) {
    	        if (($1.prim->ptype != Xarc) & teststflag($1.state, Xto)) {
#ifdef DDEBUG
    	    	  if (debuglevel > 0) {
    	    	    fprintf(log_, "\"then\" inserted, \n");
    	    	    prtstval($1.state); putc('\n', log_); }
#endif
    	    	  appendthen(&$$.prim);
    	    	  setstflag(&$$.state, XEMPTY);
    	          }
    	        wprim = $$.prim;
    	        if (wprim->ptype != Xarc) {
			      wprim->endpos_.xpos = $3.xval;
			      wprim->endpos_.ypos = $3.yval;
    	          }
    	        else {
    	    	  x1 = wprim->aat.xpos + (wprim->aradius_ *
                    cos(wprim->startangle_));
    	    	  z1 = wprim->aat.ypos + (wprim->aradius_ *
                    sin(wprim->startangle_));
    	    	  dx = $3.xval - x1;
    	    	  dy = $3.yval - z1;
    	    	  ts = (dx * dx) + (dy * dy);
    	    	  if (wprim->direction != 0) { i = wprim->direction; }
    	    	  else { i = $$.toklen; }
#ifdef DDEBUG
    	    	  if (debuglevel == 2) {
    	    	    fprintf(log_, " (x1,z1)="); wpair(&log_, x1, z1);
    	    	    fprintf(log_, " (dx,dy)="); wpair(&log_, dx, dy);
    	    	    fprintf(log_, " ts="); wfloat(&log_, ts);
    	    	    fprintf(log_, " i=%d", i); }
#endif
    	    	  if (ts == 0.0) { wprim->arcangle_ = 0.0; }
    	    	  else {
    	    	    t = sqrt(Max(0.0,(4.0 *
                          wprim->aradius_ * wprim->aradius_) - ts) / ts);
#ifdef DDEBUG
    	    	    if (debuglevel == 2) {
    	    		  fprintf(log_, " t="); wfloat(&log_, t);
    	    		  fprintf(log_, " |arcangle|=");
    	    		  wfloat(&log_, wprim->arcangle_ * 180 / pi);
    	    		  putc('\n', log_); }
#endif
    	    	    r = sqrt(ts);               /* t is always nonnegative  */
    	    	    if (t <= 0.0) { wprim->aradius_ = 0.5 * r; }
    	    	    switch (i) {
							/* Determine which of the two default arcs to
							   draw: */
    	    	    case Xup:
    	    	      if (wprim->arcangle_ * ((-dx) - (t * dy)) < 0.0) {t= -t; }
    	    	      break;
    	    	    case Xdown:
    	    	      if (wprim->arcangle_ * ((-dx) - (t * dy)) > 0.0) { t=-t; }
    	    	      break;
    	    	    case Xright:
    	    	      if (wprim->arcangle_ * (dy - (t * dx)) < 0.0) { t = -t; }
    	    	      break;
    	    	    case Xleft:
    	    	      if (wprim->arcangle_ * (dy - (t * dx)) > 0.0) { t = -t; }
    	    	      break;
    	    	      }
    	    	    wprim->aat.xpos = x1 + (0.5 * (dx + (t * dy)));
    	    	    wprim->aat.ypos = z1 + (0.5 * (dy - (t * dx)));
#ifdef DDEBUG
    	    	    if (debuglevel == 2) {
    	    		  fprintf(log_, " t="); wfloat(&log_, t);
    	    		  fprintf(log_, " aradius=");
    	    		  wfloat(&log_, wprim->aradius_);
    	    		  fprintf(log_, " aat=");
    	    		  wpair(&log_, wprim->aat.xpos, wprim->aat.ypos);
    	    		  putc('\n', log_);
    	    	      }
#endif
    	    	    setangles(&wprim->startangle_,
    	    		      &wprim->arcangle_, wprim->aat, x1, z1,
    	    		      $3.xval, $3.yval);
    	    	    }
							/* ratio centre-to-chord/half-chord */
    	    	  if (wprim->direction != 0) { $$.toklen = wprim->direction; }
    	    	  wprim->direction = 0;
    	          }
    	        setstflag(&$$.state, Xto);
#ifdef DDEBUG
    	        if (debuglevel > 0) { printobject($$.prim); }
#endif
    	        }
    	      else { markerror(858); }
    	      }
		   }

		| object Xat position                                   /* object21 */
		{ if ($1.prim != NULL) {
			$$.xval = $3.xval;
			$$.yval = $3.yval;
			if ((drawmode != SVG) || (getstval($1.state) == 0)) {
			    setstval(&$$.state, Dotc); }
			setstflag(&$$.state, Xat);
#ifdef DDEBUG
		    if (debuglevel > 0) {
	    	  fprintf(log_, " (xval,yval)=");
	    	  wpair(&log_, $$.xval, $$.yval);
	    	  fprintf(log_, " state=%d val=%d flag=%d\n",
		      $$.state, $$.state >> 8, $$.state & 255);
		      }
#endif
		    }
		  }

		| object Xtextpos                                       /* object22 */
		{ if ($1.prim != NULL) {
			namptr = $$.prim->textp;
			if (namptr == NULL) { markerror(861); }
            else {
			  while (namptr->nextname != NULL) { namptr = namptr->nextname; }
			  setjust(namptr, $2.lexval);
			  if (drawmode == SVG) {
				wprim = $$.prim;
				if ((!teststflag($$.state, Xat)) &&
                    (wprim->ptype == Xstring)) {
				  $$.xval = wprim->aat.xpos;
				  $$.yval = wprim->aat.ypos;
				  setstflag(&$$.state, Xat); }
				setstflag(&$$.state, Xcw);
				i = getstval($$.state);
				if ((wprim->ptype != Xmove) && (wprim->ptype != Xspline) &&
				    (wprim->ptype != Xarrow) && (wprim->ptype != Xline)) {
				  switch ($2.lexval) {
				    case Xljust:
				      if (i == Dotn) { setstval(&$$.state, Dotnw); }
				      else if (i == Dots) { setstval(&$$.state, Dotsw); }
				      else { setstval(&$$.state, Dotw); }
				      break;
				    case Xrjust:
				      if (i == Dotn) { setstval(&$$.state, Dotne); }
				      else if (i == Dots) { setstval(&$$.state, Dotse); }
				      else { setstval(&$$.state, Dote); }
				      break;
				    case Xbelow:
				      if (i == Dote) { setstval(&$$.state, Dotne); }
				      else if (i == Dotw) { setstval(&$$.state, Dotnw); }
				      else { setstval(&$$.state, Dotn); }
				      break;
				    case Xabove:
				      if (i == Dote) { setstval(&$$.state, Dotse); }
				      else if (i == Dotw) { setstval(&$$.state, Dotsw); }
				      else { setstval(&$$.state, Dots); }
				      break;
				    }
				  }
			    }
			  }
		    }
		  }

		| object Xcolrspec stringexpr                           /* object23 */
        {
#ifdef DDEBUG
          if (debuglevel > 0) {
      	    fprintf(log_, " object23: type=%d ", $1.lexval);
      	    switch ($2.lexval) {
      	    case Xshaded:
      	      fprintf(log_, "shaded \"str\"; hasshade=%s",
      		    hasshade($1.lexval, true) ? " TRUE" : "FALSE"); break;
      	    case Xoutlined:
      	      fprintf(log_, "outlined \"str\"; hasoutline=%s",
      		    hasoutline($1.lexval, true) ? " TRUE" : "FALSE"); break;
      	    case Xcolour:
      	      fprintf(log_, "colour \"str\"; hasoutline=%s; hashade=%s",
      		    hasoutline($1.lexval, true) ? " TRUE" : "FALSE",
      		    hasshade($1.lexval, false) ? " TRUE" : "FALSE"); break;
      	    default:
      	      fprintf(log_, "unknown "); break;
      	    }
      	    putc('\n', log_);
            }
#endif
		  if ((drawmode == Pict2e) || (drawmode == TeX) ||
		      (drawmode == tTeX) || (drawmode == xfig)) { markerror(858); }
		  else if (($3.prim != NULL) && ($1.prim != NULL)) {
			wprim = $$.prim;
			switch ($2.lexval) {
			case Xshaded:
			  if (hasshade($1.lexval, true)) {
			    deletename(&wprim->shadedp);
			    wprim->shadedp = $3.prim->textp;
			    $3.prim->textp = NULL;
			    }
			  break;
			case Xoutlined:
			  if (hasoutline($1.lexval, true)) {
			    deletename(&wprim->outlinep);
			    wprim->outlinep = $3.prim->textp;
			    $3.prim->textp = NULL;
			    }
			  break;
			case Xcolour:
			  if (hasoutline($1.lexval, true)) {
			    deletename(&wprim->outlinep);
			    wprim->outlinep = $3.prim->textp;
			    $3.prim->textp = NULL;
				i = wprim->ptype;
			    if (((i != Xspline) && (i != Xarrow) && (i != Xline) &&
				   (i != Xarc)) & hasshade($1.lexval, false)) {
				  deletename(&wprim->shadedp);
				  copystr(&wprim->shadedp, wprim->outlinep);
			      }
			    }
			  break;
			  }
		    }
		    deletestringbox(&$3.prim);
		  }

		| objectwith Xat position                               /* object24 */
		{ if ($1.prim != NULL) {
			$$.xval = $3.xval;
			$$.yval = $3.yval;
			setstval(&$$.state, XEMPTY);
			setstflag(&$$.state, Xat);
		    }
		  }

		| objectwith Xcorner Xat position                       /* object25 */
		{ if ($1.prim != NULL) {
			$$.xval = $4.xval;
			$$.yval = $4.yval;
			setstval(&$$.state, $2.lexval);
			setstflag(&$$.state, Xat);
		    }
		  }

		| objectwith pair Xat position                          /* object26 */
		{ if ($1.prim != NULL) {
			$$.xval = $4.xval;
			$$.yval = $4.yval;
            i = $$.prim->ptype;
			if ((i != Xarc) && (i != Xellipse) && (i != Xcircle) &&
			  (i != Xblock) && (i != Xstring) && (i != Xbox)){markerror(858);}
			else {
			  $$.startchop = $2.xval;
			  $$.endchop = $2.yval;
			  setstval(&$$.state, Xfloat);
			  }
			setstflag(&$$.state, Xat);
		    }
		  }

		| Xcontinue                                             /* object27 */
		{ primp = NULL;
	      prp = envblock->son;
	      while (prp != NULL) { i = prp->ptype;
		    if ( (i != XLaTeX) && (i != Xstring) && (i != Xblock)
			  && (i != Xlabel) ) { primp = prp; }
		    prp = prp->nextname; }
	      if (primp == NULL) { markerror(857); }
	      else {
		    while (primp->son != NULL) { primp = primp->son; }
		    $$.prim = primp;
		    if ($$.prim != NULL) {
			  appendthen(&$$.prim);
			  if ($$.prim->ptype != Xarc) { setstflag(&$$.state, XEMPTY); }
		      }
		    }
		  }
		;

openblock	:	Xleftbrack                                    /* openblock1 */
		{ newprim(&$$.prim, Xblock, envblock);
		  $$.prim->here_.xpos = 0.0;
		  $$.prim->here_.ypos = 0.0;
		  envblock = $$.prim;
		  tail = NULL;
		  $$.lexval = 0;
		  }
		;

			/* position values for basic drawn object */
block	:	Xprimitiv optexp                                      /* block1 */
		{ if (($1.lexval > Xprimitiv) && ($1.lexval < Xenvvar)) {
			newprim(&$$.prim, $1.lexval, envblock);
			eb = findenv(envblock);
			if ($1.lexval != Xmove) {
              if ($1.lexval == Xarc) { j = MPost; } else { j = drawmode; }
              switch (j) {
                case PGF:
                case PSTricks:
  			      $$.prim->lthick = -eb->envinx(Xlinethick); break;
                case MPost:
                case Pict2e:
                case PDF:
                case PS :
                case SVG:
                case PSfrag:
  			      $$.prim->lthick = eb->envinx(Xlinethick); break;
                default: break; }
              }
			if (($2.lexval != XEMPTY) &&               /* check expr allowed */
			    ($1.lexval != Xmove) &&
			    ($1.lexval != Xspline) &&
			    ($1.lexval != Xarrow) &&
			    ($1.lexval != Xline)) { markerror(858); }
			wprim = $$.prim;
			switch ($1.lexval) {
			  case Xbox:
			    wprim->boxheight_ = eb->envinx(Xboxht);
			    wprim->boxwidth_ = eb->envinx(Xboxwid);
			    wprim->boxradius_ = eb->envinx(Xboxrad);
			    switch (wprim->direction) {
			      case Xup:
			        wprim->aat.ypos += wprim->boxheight_ * 0.5;
			        break;
			      case Xdown:
			        wprim->aat.ypos -= wprim->boxheight_ * 0.5;
			        break;
			      case Xleft:
			        wprim->aat.xpos -= wprim->boxwidth_ * 0.5;
			        break;
			      case Xright:
			        wprim->aat.xpos += wprim->boxwidth_ * 0.5;
			        break;
			      }
			    break;
			  case Xcircle:
			    wprim->circleradius_ = eb->envinx(Xcirclerad);
			    switch (wprim->direction) {
			      case Xup:
			        wprim->aat.ypos += wprim->circleradius_;
			        break;
			      case Xdown:
			        wprim->aat.ypos -= wprim->circleradius_;
			        break;
			      case Xleft:
			        wprim->aat.xpos -= wprim->circleradius_;
			        break;
			      case Xright:
			        wprim->aat.xpos += wprim->circleradius_;
			        break;
			      }
			    break;
			  case Xellipse:
			    wprim->ellipseheight_ = eb->envinx(Xellipseht);
			    wprim->ellipsewidth_ = eb->envinx(Xellipsewid);
			    switch (wprim->direction) {
			      case Xup:
			        wprim->aat.ypos += wprim->ellipseheight_ * 0.5;
			        break;
			      case Xdown:
			        wprim->aat.ypos -= wprim->ellipseheight_ * 0.5;
			        break;
			      case Xleft:
			        wprim->aat.xpos -= wprim->ellipsewidth_ * 0.5;
			        break;
			      case Xright:
			        wprim->aat.xpos += wprim->ellipsewidth_ * 0.5;
			        break;
			      }
			    break;
			  case Xarc:
			    wprim->aradius_ = eb->envinx(Xarcrad);
			    switch (wprim->direction) {
			      case Xup:
			        wprim->startangle_ = 0.0;
			        wprim->aat.xpos -= wprim->aradius_;
			        break;
			      case Xdown:
			        wprim->startangle_ = pi;
			        wprim->aat.xpos += wprim->aradius_;
			        break;
			      case Xleft:
			        wprim->startangle_ = 0.5 * pi;
			        wprim->aat.ypos -= wprim->aradius_;
			        break;
			      case Xright:
			        wprim->startangle_ = (-0.5) * pi;
			        wprim->aat.ypos += wprim->aradius_;
			        break;
			      }
			    wprim->lineheight_ = eb->envinx(Xarrowht);
			    wprim->linewidth_ = eb->envinx(Xarrowwid);
			    wprim->lineatype_ = pahnum(pahlex(0, XEMPTY),
			      Rnd(eb->envinx(Xarrowhead)));
			    wprim->arcangle_ = pi * 0.5;
			    break;
			  case Xline:
			  case Xarrow:
			  case Xspline:
			  case Xmove:
			    wprim->endpos_ = wprim->aat;
			    if ((wprim->ptype == Xspline) && ($2.lexval != XEMPTY)) {
			      wprim->aradius_ = $2.xval;
			      $2.lexval = XEMPTY; }
			    if ($2.lexval != XEMPTY) { r = $2.xval; }
			    else if (wprim->ptype == Xmove) {
			      switch (wprim->direction) {
			        case Xup:
			        case Xdown:
				      r = eb->envinx(Xmoveht);
				      break;
			        case Xleft:
			        case Xright:
				      r = eb->envinx(Xmovewid);
				      break;
			        }
			      }
			    else {
			      switch (wprim->direction) {
			        case Xup:
			        case Xdown:
				      r = eb->envinx(Xlineht);
				      break;
			        case Xleft:
			        case Xright:
				      r = eb->envinx(Xlinewid);
				      break;
			        }
			      }
			    switch (wprim->direction) {
			      case Xup:
			        wprim->endpos_.ypos = wprim->aat.ypos + r;
			        break;
			      case Xdown:
			        wprim->endpos_.ypos = wprim->aat.ypos - r;
			        break;
			      case Xleft:
			        wprim->endpos_.xpos = wprim->aat.xpos - r;
			        break;
			      case Xright:
			        wprim->endpos_.xpos = wprim->aat.xpos + r;
			        break;
			      }
			    wprim->lineheight_ = eb->envinx(Xarrowht);
			    wprim->linewidth_ = eb->envinx(Xarrowwid);
			    if (wprim->ptype == Xarrow) {
			      wprim->lineatype_ = pahlex(0, Xrighthead); }
			    else { wprim->lineatype_ = pahlex(0, XEMPTY); }
			  wprim->lineatype_ = pahnum(wprim->lineatype_,
			    Rnd(eb->envinx(Xarrowhead)));
			  break;
			  }
		    }
#ifdef DDEBUG
			if (debuglevel > 0) { printobject($$.prim); }
#endif
		  }

		| stringexpr                                              /* block2 */
		{ if ((drawmode == PS) || (drawmode == PDF) || (drawmode == PSfrag)) {
			printstate = ((printstate >> 1) * 2) + 1; }
		  }

		| openblock closeblock Xrightbrack                        /* block3 */
		{ if ($1.prim != NULL) {
			envblock = $1.prim->parent;
			tail = NULL;
			getnesw($1.prim->son);
			wprim = $1.prim;
			wprim->blockwidth_ = east - west;
			wprim->blockheight_ = north - south;
			wprim->aat.xpos = (east + west) * 0.5;
			wprim->aat.ypos = (north + south) * 0.5;
			dx = envblock->here_.xpos - wprim->aat.xpos;
			dy = envblock->here_.ypos - wprim->aat.ypos;
			switch (envblock->direction) {
			  case Xright: dx += wprim->blockwidth_ * 0.5; break;
			  case Xleft: dx -= wprim->blockwidth_ * 0.5; break;
			  case Xup: dy += wprim->blockheight_ * 0.5; break;
			  case Xdown: dy -= wprim->blockheight_ * 0.5; break;
			  }
			wprim->direction = envblock->direction;
#ifdef DDEBUG
			if ((debuglevel > 0) && ($1.prim->son != NULL)) {
			  printobject($1.prim->son);
			  if ($1.prim->son->nextname != NULL) {
                printobject($1.prim->son->nextname); }
			  }
#endif
			shift($1.prim, dx, dy);
#ifdef DDEBUG
			if (debuglevel > 0) {
			  wprim = $1.prim;
			  fprintf(log_, "Block3: (north,south),(west,east)");
			  wpair(&log_,wprim->aat.ypos + (wprim->blockheight_*0.5),
				  wprim->aat.ypos - (wprim->blockheight_ * 0.5));
			  wpair(&log_,wprim->aat.xpos -(wprim->blockwidth_*0.5),
				  wprim->aat.xpos + (wprim->blockwidth_ * 0.5));
			  fprintf(log_, " here=");
			  wpair(&log_,
				  wprim->here_.xpos, wprim->here_.ypos);
			  putc('\n', log_);
			  if ($1.prim->son != NULL) {
				printobject($1.prim->son);
				if ($1.prim->son->nextname != NULL) {
				  printobject($$.prim->son->nextname); }
			    }
			  $$.prim = $1.prim;
			  snaptree($$.prim, 0);
			  putc('\n', log_);
			  }
#endif
		    }
		  }

		| Xblock                                                  /* block4 */
		{ newprim(&$$.prim, Xblock, envblock);
		  $$.prim->here_.xpos = 0.0;
		  $$.prim->here_.ypos = 0.0;
		  $$.lexval = 0;
		  }
		;

optexp	:                                                        /* optexp1 */
			{ $$.lexval = XEMPTY; }

		| expression                                             /* optexp2 */
		;

closeblock	:	elementlist optnl                            /* closeblock1 */
		{ if (envblock->blockparms.env != NULL) {
			eb = findenv(envblock->parent);
			if (envblock->envinx(Xlinethick) != eb->envinx(Xlinethick)) {
		      newprim(&prp, XLaTeX, envblock);
			  prp->lthick = eb->envinx(Xlinethick);
              queueprim( prp, envblock );
              }
		    }
		  }
		;

objectwith	:	object Xwith                                 /* objectwith1 */

		| objectwith Xdot Xlabel suffix                      /* objectwith2 */
		{ if ($1.prim != NULL) {
			if ($4.lexval != XEMPTY) {
			  attribp = &$3;
			  addsuffix(chbuf, &attribp->chbufx, &attribp->toklen,
			    $4.xval,$4.lexval,$4.yval); }
			if ($$.internal == NULL) { prp = $$.prim; }
			else { prp = $$.internal; }
			$$.internal = findplace(prp->son, chbuf, $3.chbufx, $3.toklen);
			if ($$.internal == NULL) {
			  marknotfound(855, chbuf, $3.chbufx, $3.toklen);
			  deletetree(&$$.prim); }
		    }
		  clearchbuf($3.chbufx, $3.toklen);
		  }

		| objectwith Xdot nth primobj                        /* objectwith3 */
		{ if ($1.prim != NULL) {
			if ($1.internal == NULL) { prp = $1.prim; }
			else { prp = $1.internal; }
			$$.internal = nthprimobj(prp->son, $3.toklen, $4.lexval);
			if ($$.internal == NULL) { markerror(857); deletetree(&$$.prim); }
		    }
		  }
		;

pair	:	expression Xcomma expression                           /* pair1 */
		{ $$.yval = $3.xval;
#ifdef DDEBUG
			if (debuglevel>1) prattribute("pair1",&$$);
#endif
			}

		| location shift                                           /* pair2 */
		{ if ($2.lexval != XEMPTY) {
			$$.xval += $2.xval;
			$$.yval += $2.yval; }
		  }
		;

nth	:	ncount Xnth                                                 /* nth1 */
		{ if ($1.xval <= 0.0) { markerror(856); }
		  else { $$.toklen = Rnd($1.xval); }
		  }

		| ncount Xnth Xlast                                         /* nth2 */
		{ if ($1.xval <= 0.0) { markerror(856); }
		  else { $$.toklen = -Rnd($1.xval); }
		  }

		| Xlast                                                     /* nth3 */
		{ $$.toklen = 0; }
		;

primobj	: Xprimitiv                                             /* primobj1 */

		| Xblock                                                /* primobj2 */

		| Xstring                                               /* primobj3 */

		| Xleftbrack Xrightbrack                                /* primobj4 */
		{ $$.lexval = Xblock; }
		;

shift	: /* empty */                                             /* shift1 */
		{ $$.xval = 0.0;
		  $$.yval = 0.0;
		  $$.lexval = XEMPTY;
		  }

		| shift Xplus location                                    /* shift2 */
		{ $$.xval += $3.xval;
		  $$.yval += $3.yval;
		  $$.lexval = Xfloat;
		  }

		| shift Xminus location                                   /* shift3 */
		{ $$.xval -= $3.xval;
		  $$.yval -= $3.yval;
		  $$.lexval = Xfloat;
		  }
		;

location	:	Xlparen position Xrparen                       /* location1 */
		{ $$ = $2; }

		| Xlparen position Xcomma position Xrparen             /* location2 */
		{ $$.xval = $2.xval;
		  $$.yval = $4.yval;
		  }

		| place                                                /* location3 */

		| location Xmult factor                                /* location4 */
		{ $$.xval *= $3.xval;
		  $$.yval *= $3.xval;
		  }

		| location Xdiv factor                                 /* location5 */
		{ if ($3.xval == 0.0) { markerror(852); }
		  else {
			$$.xval /= $3.xval;
			$$.yval /= $3.xval;
		    }
		  }
		;

place	:	placename                                             /* place1 */
		{ corner($1.prim, XEMPTY, &$$.xval, &$$.yval); }

		| placename Xcorner                                       /* place2 */
		{ corner($1.prim, $2.lexval, &$$.xval, &$$.yval); }

		| Xcorner placename                                       /* place3 */
		{ corner($2.prim, $1.lexval, &$2.xval, &$2.yval);
 		  $$ = $2; }

		| Xcorner Xof placename                                   /* place4 */
		{ corner($3.prim, $1.lexval, &$3.xval, &$3.yval);
 		  $$ = $3; }

		| XHere                                                   /* place5 */
		{ $$.xval = envblock->here_.xpos;
		  $$.yval = envblock->here_.ypos;
		  }
		;

factor	:	primary                                              /* factor1 */

		| Xnot primary                                           /* factor2 */
		{ if ($2.xval == 0.0) { $$.xval = 1.0; }
    	  else { $$.xval = 0.0; }
		  }

		| primary Xcaret factor                                  /* factor3 */
		{ if (($1.xval == 0.0) && ($3.xval < 0.0)) { markerror(852); }
		  else {
			j = Rnd($3.xval);
			r = j;
			if (r == $3.xval) { $$.xval = intpow($1.xval, j); }
			else if ($1.xval < 0.0) { markerror(863); $$.xval = 0.0; }
			else if ($1.xval != 0.0) { $$.xval = exp($3.xval * log($1.xval));}
			}
    	  }
		;

placename	:	Xlabel suffix                                 /* placename1 */
		{ if ($2.lexval != XEMPTY) { addsuffix(chbuf, &$1.chbufx, &$1.toklen,
                $2.xval,$2.lexval,$2.yval); }
		  prp = NULL;
		  primp = envblock;
		  while (primp != prp) {
		    prp = findplace(primp->son, chbuf, $1.chbufx, $1.toklen);
			if (prp != NULL) { primp = prp; }
			else { primp = primp->parent; }
		    }
		  if (prp == NULL) {
			marknotfound(854, chbuf, $1.chbufx, $1.toklen); }
		  clearchbuf($1.chbufx, $1.toklen);
		  $$.prim = prp;
		  }

		| nth primobj                                         /* placename2 */
		{ $$.prim = nthprimobj(envblock->son, $1.toklen, $2.lexval);
		  if ($$.prim == NULL) { markerror(857); }
#ifdef DDEBUG
		  if (debuglevel > 0) {
            fprintf(log_, "\n placename2 %dth location:",$1.toklen);
	        wpair(&log_, $$.prim->aat.xpos, $$.prim->aat.ypos);
            putc('\n', log_); fflush(log_);
            }
#endif
		  }

		| placename Xdot Xlabel suffix                        /* placename3 */
		{ if ($1.prim != NULL) {
			if ($4.lexval != XEMPTY) { addsuffix(chbuf, &$3.chbufx,
              &$3.toklen, $4.xval,$4.lexval,$4.yval); }
			primp = findplace($$.prim->son, chbuf, $3.chbufx, $3.toklen);
			if (primp == NULL) { marknotfound(855, chbuf, $3.chbufx,$3.toklen);}
			$$.prim = primp;
		    }
		  clearchbuf($3.chbufx, $3.toklen);
		  }

		| placename Xdot nth primobj                          /* placename4 */
		{ if ($1.prim != NULL) {
			$$.prim = nthprimobj($1.prim->son, $3.toklen, $4.lexval);
			if ($$.prim == NULL) { markerror(857); }
		    }
		  }
		;

ncount	:	Xfloat                                               /* ncount1 */

		| Xleftquote expression Xrightquote                      /* ncount2 */
		{ $$.xval = $2.xval; }

		| Xleftbrace expression Xrightbrace                      /* ncount3 */
		{ $$.xval = $2.xval; }
		;

logprod	:	logval                                              /* logprod1 */

		| logprod Xandand logval                                /* logprod2 */
		{ if (($1.xval == 0.0) || ($3.xval == 0.0)) { $$.xval = 0.0; }
		  else { $$.xval = 1.0; }
		  }
		;

logval	:	lcompare                                             /* logval1 */
		{ if ($1.lexval == Xstring) {
			markerror(869);
			$$.lexval = Xfloat;
			deletestringbox(&$1.prim);
		    }
		  }

		| stringexpr Xlt stringexpr                              /* logval2 */
		{ i = cmpstring($1.prim, $3.prim);
		  if (i < 0) { $$.xval = 1.0; }
		  else { $$.xval = 0.0; }
		  $$.lexval = Xfloat;
		  deletestringbox(&$3.prim);
		  deletestringbox(&$1.prim);
		  }

		| expression Xlt expression                              /* logval3 */
		{ if ($1.xval < $3.xval) { $$.xval = 1.0; }
		  else { $$.xval = 0.0; }
		  }
		;

lcompare:	expression                                         /* lcompare1 */

		| stringexpr                                           /* lcompare2 */

		| lcompare Xcompare expression                         /* lcompare3 */
		{ if ($1.lexval == Xstring) {
			markerror(869);
			bswitch = false;
			deletestringbox(&$1.prim);
		    $$.lexval = XEMPTY;
		    }
		  else {
#ifdef DDEBUG
			if (debuglevel > 0) { fprintf(log_," compare %g %d %g\n",
              $1.xval,$2.lexval-Xcompare,$3.xval); }
#endif
			switch ($2.lexval - Xcompare) {
			  case 0: bswitch = ($1.xval < $3.xval); break;
			  case 1: bswitch = ($1.xval == $3.xval); break;
			  case 2: bswitch = ($1.xval != $3.xval); break;
			  case 3: bswitch = ($1.xval >= $3.xval); break;
			  case 4: bswitch = ($1.xval <= $3.xval); break;
			  case 5: bswitch = ($1.xval > $3.xval); break;
			  default: bswitch = false; break;
			  }
		    }
		  if (bswitch) { $$.xval = 1.0; } else { $$.xval = 0.0; }
		  }

		| lcompare Xcompare stringexpr                        /* lcompare4 */
		{ if ($1.lexval != Xstring) { markerror(869); bswitch = false; }
		  else {
			i = cmpstring($1.prim, $3.prim);
			switch ($2.lexval - Xcompare) {
			  case 0: bswitch = (i < 0); break;
			  case 1: bswitch = (i == 0); break;
			  case 2: bswitch = (i != 0); break;
			  case 3: bswitch = (i >= 0); break;
			  case 4: bswitch = (i <= 0); break;
			  case 5: bswitch = (i > 0); break;
			  default: bswitch = false; break;
			  }
			deletestringbox(&$$.prim);
		    }
		  if (bswitch) { $$.xval = 1.0; } else { $$.xval = 0.0; }
		  $$.lexval = Xfloat;
		  deletestringbox(&$3.prim);
		  }
		;

primary	:	Xenvvar                                             /* primary1 */
		{ if (envblock != NULL) {
			eb = findenv(envblock);
			$$.xval = eb->envinx($1.lexval);
		    }
		  }

		| Xname suffix                                          /* primary2 */
		{ if ($2.lexval != XEMPTY) { addsuffix(chbuf,
		    &$1.chbufx, &$1.toklen, $2.xval,$2.lexval,$2.yval); }
    	  namptr = glfindname(envblock,chbuf,$1.chbufx,$1.toklen, &lastvar, &k);
    	  if (namptr == NULL) { $$.xval = 0.0; }
    	  else { $$.xval = namptr->val; }
		  clearchbuf($1.chbufx, $1.toklen);
		  }

		| Xfloat                                                /* primary3 */

		| Xlparen logexpr Xrparen                               /* primary4 */
		{ $$.xval = $2.xval; }

		| location Dotx                                        /* primary5 */

		| location Doty                                        /* primary6 */
		{ $$.xval = $1.yval; }

		| placename Xparam                                      /* primary7 */
		{ if ($1.prim != NULL) { switch ($2.lexval) {
			case Xheight:
			  $$.xval = pheight($$.prim);
			  break;
			case Xwidth:
			  $$.xval = pwidth($$.prim);
			  break;
			case Xradius:
			  wprim = $$.prim;
			  if (wprim->ptype == Xcircle) {$$.xval = wprim->circleradius_; }
			  else if (wprim->ptype == Xarc) {$$.xval = wprim->aradius_; }
			  else if (wprim->ptype == Xbox) {$$.xval = wprim->boxradius_; }
			  else { $$.xval = 0.0; markerror(858); }
			  break;
			case Xdiameter:
			  wprim = $1.prim;
			  if (wprim->ptype == Xcircle) {$$.xval = wprim->circleradius_*2; }
			  else if (wprim->ptype == Xarc) {$$.xval = wprim->aradius_*2; }
			  else { $$.xval = 0.0; markerror(858); }
			  break;
			case Xthickness:
			  wprim = $1.prim;
              switch (wprim->ptype) {
                case Xarc:
                case Xspline:
                case Xarrow:
                case Xline:
                case Xcircle:
                case Xellipse:
                case Xbox:
                  if (ismdistmax(wprim->lthick)) {
                    $$.xval = venv(wprim,Xlinethick); }
                  else { $$.xval = fabs(wprim->lthick); }
                  break;
                default:
                  $$.xval = 0.0; markerror(858);
                  break; }
			  break;
			case Xlength:
			  wprim = $1.prim; j = wprim->ptype;
              switch (j) {
  	            case Xspline:
                case Xmove:
                case Xarrow:
                case Xline:
  			      primp = $1.prim;
  			      while (primp->son != NULL) { primp = primp->son; }
  			      r = fabs(primp->endpos_.xpos - wprim->aat.xpos);
  			      s = fabs(primp->endpos_.ypos - wprim->aat.ypos);
  			      if (r == 0.0) { $$.xval = s; }
  			      else if (s == 0.0) { $$.xval = r; }
  			      else { $$.xval = sqrt((r * r) + (s * s)); }
                  break;
  			    default:
                  $$.xval = 0.0; markerror(858);
  			      break; }
			default:
              break; }
		    }
          }

		| Xrand Xlparen Xrparen                                 /* primary8 */
		{ $$.xval = ((double)random()) / randmax; }

		| Xrand Xlparen expression Xrparen                      /* primary9 */
		{ srandom(Rnd($3.xval));
		  $$.xval = ((double)random()) / randmax;
		  }

		| Xfunc1 Xlparen expression Xrparen                    /* primary10 */
		{ switch ($$.lexval) {
		    case Xabs: $$.xval = fabs($3.xval);
		      break;
		    case Xacos:
		      t = $3.xval;
		      if (fabs(t) > 1.0) { markerror(868); }
		      else { $$.xval = datan(sqrt(1 - (t * t)), t); }
		      break;
		    case Xasin:
		      t = $3.xval;
		      if (fabs(t) > 1.0) { markerror(868); }
		      else { $$.xval = datan(t, sqrt(1 - (t * t))); }
		      break;
		    case Xcos: $$.xval = cos($3.xval);
		      break;
		    case Xexp: $$.xval = exp(log(10.0) * $3.xval);
		      break;
		    case Xexpe: $$.xval = exp($3.xval);
		      break;
		    case Xint: $$.xval = (long)$3.xval;
		      break;
		    case Xlog:
		      if ($3.xval <= 0.0) { markerror(867); }
		      else { $$.xval = log($3.xval) / log(10.0); }
		      break;
		    case Xloge:
		      if ($3.xval <= 0.0) { markerror(867); }
		      else { $$.xval = log($3.xval); }
		      break;
		    case Xsign:
		      if ($3.xval >= 0.0) { $$.xval = 1.0; }
		      else { $$.xval = -1.0; }
		      break;
		    case Xsin: $$.xval = sin($3.xval);
		      break;
		    case Xsqrt:
		      if ($3.xval < 0.0) { markerror(867); }
		      else { $$.xval = sqrt($3.xval); }
		      break;
		    case Xtan:
		      t = cos($3.xval);
		      if (t == 0.0) { markerror(868); $$.xval = distmax; }
		      else { $$.xval = sin($3.xval) / t; }
		      break;
		    case Xfloor: $$.xval = Floor($3.xval);
		      break;
		    }
		  }

		| Xfunc2 Xlparen expression Xcomma expression Xrparen  /* primary11 */
		{ switch ($1.lexval) {
		    case Xatan2: $$.xval = datan($3.xval, $5.xval);
		      break;
		    case Xmax: $$.xval = Max($3.xval, $5.xval);
		      break;
		    case Xmin: $$.xval = Min($3.xval, $5.xval);
		      break;
		    case Xpmod:
		      t = $3.xval;
		      s = $5.xval;
		      if (s == 0) { markerror(871); }
		      else {
			    $$.xval = t - (s * Floor(t / s));
			    if ($$.xval < 0) { $$.xval += fabs(s); }
		        }
		      break;
		    }
		  }

		| Xlparen assignlist Xrparen                           /* primary12 */
		{ $$.xval = $2.xval; }

		| Xlparen systemcmd Xrparen                            /* primary13 */
		{ $$.xval = $2.xval; }
		;

%% /* start of programs */

void
yyerror(char const *s)
{
  boolean cap;
  markerror(799);
  cap = (*s=='s');
  if (cap) s++;                      /* Capitalize "syntax" */
#ifdef DDEBUG
  if (debuglevel > 0) { if (cap) putc('S',log_); fprintf(log_, "%s\n",s); }
#endif
  if (cap) putc('S',errout);
  fprintf(errout, "%s\n",s);
  }

							/* Get and initialize a buffer from the
							   old-buffer stack or make a new one */
void
newbuf(fbuffer **buf)
{
  fbuffer *nwbuf;
#ifdef DDEBUG
  if (debuglevel > 0) { fprintf(log_, " newbuf"); }
#endif
  if (freeinbuf == NULL) {
    *buf = malloc(sizeof(fbuffer)); if (*buf==NULL){ fatal(9); }
    (*buf)->carray = malloc(sizeof(chbufarray));
    if ((*buf)->carray==NULL){ fatal(9); }
    }
  else {
#ifdef DDEBUG
    if (debuglevel > 0) { fprintf(log_, " f"); }
#endif
    *buf = freeinbuf;
    freeinbuf = freeinbuf->nextb;
    }
  nwbuf = *buf;
  nwbuf->savedlen = 0;
  nwbuf->carray[0] = ' ';
  nwbuf->readx = 1;
  nwbuf->attrib = 0;
  nwbuf->higherb = NULL;
  nwbuf->prevb = NULL;
  nwbuf->nextb = NULL;
#ifdef DDEBUG
  if (debuglevel > 0) { logaddr(*buf); putc('\n', log_); }
#endif
}


							/* Clearing memory at end of diagram */
void
deletefreeargs(arg **a)
{
  arg *na;
  while ((*a) != NULL) {
    na = (*a)->nexta;
    disposebufs(&(*a)->argbody);
    Free(*a);
    *a = na; }
}


							/* Clearing memory at end of diagram */
void
deletefreeinbufs(fbuffer **p)
{
  fbuffer *q;
  while ((*p) != NULL) {
    q = (*p)->nextb;
    Free((*p)->carray);
    Free(*p);
    *p = q; }
}


							/* performed for each input diagram: */
void
inittwo(void)
{
  freeinbuf = NULL;
  freeseg = NULL;
  freex = 2;
  freearg = NULL;
  lastfillval = mdistmax;
  gslinethick = mdistmax;
  newprim(&envblock, Xblock, NULL);
  globalenv = envblock;
  tail = NULL;
  resetenv(0, envblock);
#ifdef DDEBUG
  if (debuglevel > 0) { printobject(envblock); }
#endif
  pyylval = &yylval;
}

void
preproduce(int p)
{
  switch (p) {
  case -2:
    inittwo();
    break;
  case -1:
    if (envblock != NULL) { envblock->direction = Xright; }
    inlogic = false;
    inbuf = NULL;
    break;
  }
}

							/* Integer power of x */
double
intpow(double x, int k)
{ /* 0^(-k) does not occur */
  /* 0^0 returns 1.0 */
  if (k == 0) { x = 1.0; return x; }
  if ((x == 0.0) || (k == 1)) { return x; }
  if (k < 0) { x = intpow(1.0 / x, -k); return x; }
							/* common enough to test for it */
  if (k == 2) { x *= x; return x; }
  if (k & 1) { x *= intpow(x, k - 1); }
  else { x = intpow(x, k >> 1); x *= x; }
  return x;
}

void
wrmacro(FILE **iou, arg *cm)
{
  fbuffer *body;
  int j, namlen;
  if (cm == NULL) { }
  else if (cm->argbody == NULL) { }
  else if (cm->argbody->carray != NULL) {
    body = cm->argbody;
    fprintf(*iou, "in macro \"");
    namlen = -(body->attrib);
    for (j = 1; j <= namlen; j++) { wchar(iou, body->carray[j]); }
    putc('"', *iou);
    }
  }
							/* Write error message with symbol found
							   and symbol expected if possible */
void
markerror(int emi) {
  int inx, i, j, k;
  fbuffer *thisbuf, *lastbuf;
  boolean scanning;
							/* Do not count warnings */
  if (emi < 900) { errcount++; }
  if (errcount > MAXERRCOUNT) { fatal(3); }
#ifdef DDEBUG
  if (debuglevel > 0) {
    fprintf(log_, "*** Markerror");
    wrbuf(inbuf,3);
    fprintf(log_, " emi=%d, lexsymb=%d:\n", emi, lexsymb);
    wrmacro( &log_, currentmacro );
    putc('\n', log_);
    }
#endif
  fprintf(errout, "\n*** dpic ");
  if (emi < 900) { fprintf(errout, "ERROR: "); }
  else { fprintf(errout, "WARNING: "); }
  wrmacro(&errout, currentmacro);
  if (currentmacro != NULL) { fprintf(errout, ", "); }
  if (inbufdepth == 0) { P__argv((char *)infname, sizeof(mstring), argct); }
  j = 0; k = FILENAMELEN;
  while (j < k) {
    if ((infname[j]==' ') || (infname[j]=='\0')) { k = j; } else { j++; } }
  if (k == 0) { fprintf(errout, "\"stdin\""); }
  else {
    fprintf(errout, "file \"");
    for (j = 0; j < k; j++) { wchar(&errout, infname[j]); }
    putc('"', errout); }
  fprintf(errout, " line %d:\n", lineno[inbufdepth]);

  if (emi < 903) {
                            /* Skip back over white space */
    thisbuf = inbuf;
    inx = inbuf->readx - 1;
    scanning = true;
    while (scanning) {
      if (inx < 1) {
	    if (thisbuf->prevb == NULL) { scanning = false; }
        else {
	      thisbuf = thisbuf->prevb;
	      if (thisbuf->savedlen < CHBUFSIZ) { inx = thisbuf->savedlen; }
	      else { inx = CHBUFSIZ; } }
        }
      else if (thisbuf->carray[inx] == etxch) { inx++; scanning = false; }
      else if (thisbuf->carray[inx] <= ' ') { inx--; }
      else { scanning = false; } }
    lastbuf = thisbuf;
#ifdef DDEBUG
    if (debuglevel > 0) {
      fprintf(log_, "Skip back white to char=");
      wchar(&log_,thisbuf->carray[inx]);
      fprintf(log_, ", inx=%d\n", inx); }
#endif
                            /* Skip back over code or tabs */
    scanning = true;
    j = inx - 1;
    while (scanning) {
	  if (j < 1) {
	    if (thisbuf->prevb == NULL) { scanning = false; }
        else {
	      thisbuf = thisbuf->prevb;
	      if (thisbuf->savedlen < CHBUFSIZ) { j = thisbuf->savedlen; }
	      else { j = CHBUFSIZ; } }
          }
      else if (thisbuf->carray[j]==etxch) { j++; scanning = false; }
      else if (isprint_(thisbuf->carray[j])||(thisbuf->carray[j]==tabch)){j--;}
	  else { j++; scanning = false; }
      }
    if (j < 1) { j = 1; }
#ifdef DDEBUG
    if (debuglevel > 0) {
      fprintf(log_, "Skip back printable to char=");
      wchar(&log_,thisbuf->carray[j]);
      fprintf(log_, ", j=%d\n", j);
	  wrbuf(thisbuf, 3); }
#endif
                          /* Write out the line or lines */
    while (thisbuf != NULL) {
	  if (thisbuf == lastbuf) { k = inx; } else { k = thisbuf->savedlen; }
	  for (i = j; i <= k; i++) { wchar(&errout, thisbuf->carray[i]); }
	  if (thisbuf == lastbuf) { thisbuf = NULL; }
	  else { thisbuf = thisbuf->nextb; j = 1; }
      }
    putc('\n', errout);
    }

  switch (emi) {
           
  case 799:                 /* syntax error */
    break;
							/* lexical error messages */
  case 800:
    fprintf(errout, "Invalid character, ignored\n");
    break;

  case 802:
    fprintf(errout, "Invalid exponent character after e in a number\n");
    break;

  case 804:
  case 806:
    fprintf(errout, "End of file while reading ");
    if (emi == 806) { fprintf(errout, "string in "); }
    switch (currprod) {
      case 1 /* elsehead1 */:
        fprintf(errout, "else");
        break;
      case 2 /* ifhead1 */:
        fprintf(errout, "if");
        break;
      case 3 /* forhead1 */:
        fprintf(errout, "for");
        break;
      case 4 /* defhead1 */:
      case 5 /* defhead2 */:
        fprintf(errout, "define");
        break;
      }
    fprintf(errout, " {...} contents\n");
    break;
  case 805:
    fprintf(errout, "End of file while evaluating macro argument\n");
    break;
  case 807:
    fprintf(errout, "Bad macro argument number\n");
    break;
							/* context error messages */
  case 851:
    fprintf(errout, "Variable not found\n");
    break;
  case 852:
    fprintf(errout, "Zero divisor not allowed\n");
    break;
  case 853:
    fprintf(errout, "Only one copy file may be open at any time\n");
    break;
  case 854:
    fprintf(errout, "Place name not found\n");
    break;
  case 855:
    fprintf(errout, "Internal name not found\n");
    break;
  case 856:
    fprintf(errout, "Invalid non-positive value for object count\n");
    break;
  case 857:
    fprintf(errout, "Enumerated or previous object not found\n");
    break;
  case 858:
    fprintf(errout, "This usage is inapplicable in this context\n");
    break;
  case 859:
    fprintf(errout, "File not readable\n");
    break;
  case 860:
    fprintf(errout, "Infinite looping not allowed\n");
    break;
  case 861:
    fprintf(errout, "Missing or blank string\n");
    break;
  case 862:
    fprintf(errout, "For ... by *() limits must have the same sign\n");
    break;
  case 863:
    fprintf(errout, "Non-integer power of negative value\n");
    break;
  case 864:
    fprintf(errout, "Incorrect number of sprintf arguments\n");
    break;
  case 865:
    fprintf(errout, "Bad sprintf format: only e, f, g allowed\n");
    break;
  case 866:
    fprintf(errout, "String exceeds max length of 4095 characters\n");
    break;
  case 867:
    fprintf(errout, "Invalid log or sqrt argument\n");
    break;
  case 868:
    fprintf(errout, "Function argument out of range\n");
    break;
  case 869:
    fprintf(errout, "Improper use of logical operator\n");
    break;
  case 870:
    fprintf(errout, "Zero value of scale not allowed\n");
    break;
  case 871:
    fprintf(errout, "Zero second argument of pmod not allowed\n");
    break;
  case 872:
    fprintf(errout, "Buffer overflow while defining macro argument\n");
    break;
  case 873:
    fprintf(errout, "Format width too large\n");
    break;
  case 874:
    fprintf(errout, "System routine snprintf error: bad formatted value\n");
    break;
  case 875:
    fprintf(errout, "Subscript out of range\n");
    break;
  case 876:
    fprintf(errout, "Failed to open sprintf output file\n");
    break;
							/* warning messages */
  case 901:
    fprintf(errout, "Safe mode: sh, copy, and print to file disallowed\n");
    break;
  case 902:
    fprintf(errout, "Output number out of range: 10e32 used\n");
    break;
  case 903:
    fprintf(errout, "Picture size adjusted to maxpswid value\n");
    break;
  case 904:
    fprintf(errout, "Picture size adjusted to maxpsht value\n");
    break;
  default:
    fprintf(errout, "Unknown error\n");
    break;
  }

  consoleflush();
}  /* markerror */


							/* Flag an object not found and complain to
							   stderr */
void
marknotfound(int eno, Char *chb, chbufinx inx, chbufinx len)
{
  int i;
#ifdef DDEBUG
  if (debuglevel > 0) {
    fprintf(log_, "Search failure %d", eno);
    if (chb != NULL) {
	  fprintf(log_, " for \"");
	  for (i = inx; i < (inx + len); i++) { wchar(&log_,chb[i]); }
	  putc('"', log_); }
    putc('\n', log_);
    }
#endif
  markerror(eno);
  fprintf(errout, "Search failure");
  if (chb != NULL) {
    fprintf(errout, " for \"");
    for (i = inx; i < (inx + len); i++) { wchar(&errout,chb[i]); }
    putc('"', errout);
    }
  putc('\n', errout);
}

							/* Hash of variable name:
   							   (ord(chr(1))+ord(chr(n-1))) mod 10 */
int
varhash(Char *chb, chbufinx chbufx, chbufinx toklen)
{
  int idx;

  if (chb == NULL) {
    idx = 0;
    return (idx - ((idx / (HASHLIM + 1)) * (HASHLIM + 1))); }
  idx = chb[chbufx];
  if (toklen > 2) { idx += chb[chbufx + toklen - 2]; }
  return (idx - ((idx / (HASHLIM + 1)) * (HASHLIM + 1)));
}

							/* Binary search for name in chain of stored
							   names */
nametype *(
findname(primitive *eb, Char *chb, chbufinx chbufx, chbufinx toklen,
	 nametype **last, int *tstval))
{
  nametype *leftptr;
  nametype *rightptr = NULL;
  int left = 0, right = 0;
  int midpt, i, hashedx;
  nametype *testname;
  hashedx = varhash(chb, chbufx, toklen);
#ifdef DDEBUG
  if (debuglevel > 0) {
    fprintf(log_, " findname|");
    for (i = chbufx; i < (chbufx + toklen); i++) { wchar(&log_,chb[i]); }
    fprintf(log_, "|:");
    if (eb == NULL) { fprintf(log_, " eb=nil"); }
    else {
      fprintf(log_, " nvars[%d]=%d", hashedx, eb->blockparms.nvars[hashedx]); }
    if (debuglevel > 1) { putc('\n', log_); }
    }
#endif
  *tstval = 1;
  *last = NULL;
  if (eb == NULL) { leftptr = NULL; }
  else {
    leftptr = eb->blockparms.vars[hashedx];
    *last = leftptr; }
							/* Check the first (highest) name */
  if (leftptr != NULL) {
    *tstval = eqstring(chb, chbufx, toklen, leftptr->segmnt, leftptr->seginx,
		    leftptr->len);
    if ((*tstval) < 0) {
	  left = 2;
	  leftptr = leftptr->nextname;
	  right = eb->blockparms.nvars[hashedx] + 1; }
    else { rightptr = leftptr; }
    }
  while (leftptr != rightptr) {
    midpt = (left + right) >> 1;
    *last = leftptr;
    for (i = left + 1; i <= midpt; i++) { *last = (*last)->nextname; }
    testname = *last;
    *tstval = eqstring(chb, chbufx, toklen, testname->segmnt, testname->seginx,testname->len);
    if ((*tstval) < 0) {
	  left = midpt + 1;
	  leftptr = (*last)->nextname;
	  continue; }
    if ((*tstval) == 0) {
	  leftptr = *last;
	  rightptr = leftptr; }
    else {
	  right = midpt;
	  rightptr = *last; }
    }
#ifdef DDEBUG
  if (debuglevel > 0) {
    if ((*tstval) == 0) { fprintf(log_," return leftptr;\n"); }
    else { fprintf(log_," return NULL;\n"); } }
#endif
  if ((*tstval) == 0) { return leftptr; }
  else { return NULL; }
}

							/* A minimal set of debug routines has been kept: */
#ifdef DDEBUG
void
logchar(Char c)
{
  fprintf(log_, "ch(%d)=\"", c);
  wchar(&log_, c);
  putc('"', log_);
}


void
wlogfl(char *nm, double v, int cr)
{
  fprintf(log_, " %s=", nm);
  if (MaxReal - fabs(v) < MaxReal * 1e-6) {
    if (v < 0) { fprintf(log_, "-MaxReal"); }
    else { fprintf(log_, "MaxReal"); }
    }
  else { wfloat(&log_, v); }
  if (cr != 0) { putc('\n', log_); }
}

void
logaddr(fbuffer *b)
{
  putc('[', log_);
  if (b != NULL) { fprintf(log_, "%d", odp(b)); }
  else { fprintf(log_, "nil"); }
  fprintf(log_, "]\n");
}

void
wrbufaddr(fbuffer *q, int job)
{
  fbuffer *r;
  boolean difa = false;
  if (q == NULL) { fprintf(log_, "[nil]"); return; }
  r = q;
  while (r->nextb != NULL) { r = r->nextb; }
  while (r->prevb != NULL) {
    difa = (difa || (r->attrib != r->prevb->attrib));
    r = r->prevb; }
  if (job <= 0) {
    r = q;
    while (r->prevb != NULL) { r = r->prevb; }
    while (r != q) {
	  fprintf(log_, "(%d", odp(r));
	  if (difa) { fprintf(log_, ":%d", r->attrib); }
	  r = r->nextb; }
    }
  fprintf(log_, "[%d:%d]", odp(q), q->attrib);
  if (job < 0) { return; }
  while (q->nextb != NULL) {
    q = q->nextb;
    fprintf(log_, "%d", odp(q));
    if (difa) { fprintf(log_, ":%d", q->attrib); }
    putc(')', log_);
    }
}

void
wrbuf(fbuffer *p, int job)
{
  int i, j, k, m;
  if (p == NULL) { fprintf(log_, " nil buffer "); return; }
  while (p != NULL) {
    if (job > 2) { fprintf(log_, " buf"); wrbufaddr(p, 0); }
    if (job > 1) {
	  fprintf(log_, " readx=%d savedlen=%d attrib=%d",
		  p->readx, p->savedlen, p->attrib); }
    j = p->readx;
    if (job > 0) { fprintf(log_, "(j=%d,savedlen=%d)", j, p->savedlen); }
    fprintf(log_, "\n|");
    if (p->carray == NULL) { fprintf(log_, "nil"); }
    else {
	  i = j;
	  while (i <= p->savedlen) {
	    if (p->carray[i] != 0) { wchar(&log_, p->carray[i]); }
	    else {
		  m = i;
		  k = p->savedlen + 1;
		  while (i < k) { if (p->carray[i] == 0) { i++; } else { k = i; } }
		  fprintf(log_, "(%dx", i - m);
		  wchar(&log_, '\0');
          fprintf(log_, ")");
		  i--; }
	    i++;
	    }
      }
    fprintf(log_, "|\n");
    p = p->nextb;
    }
  }


void
prtstval(int st)
{
  fprintf(log_, "state=%d", st);
  if ((st & 3) != 0) {
    switch (st & 3) {
      case 1: fprintf(log_, ",Xto"); break;
      case 2: fprintf(log_, ",Xfrom"); break;
      case 3: fprintf(log_, ",Xat"); break;
      }
    }
  if ((st >> 2) & 1) { fprintf(log_, ",Xchop"); }
  if ((st >> 3) & 1) { fprintf(log_, ",Xdirecton"); }
}


void
snapname(Char *chbu, chbufinx inx, chbufinx namelen)
{
  int j;
  fprintf(log_, " (%d inx=%d len=%d)|", ordp(chbu), inx, namelen);
  if (chbu == NULL) { fprintf(log_, "**nil string pointer**"); }
  else { for (j = inx; j < (inx + namelen); j++) {
    wchar(&log_,chbu[j]); } }
  putc('|', log_);
  fflush(log_);
}


void
snaptype(FILE **iou, int p)
{
  switch (p) {
    case Xbox: fprintf(*iou, "<box>"); break;
    case Xblock: fprintf(*iou, "<[]>"); break;
    case Xellipse: fprintf(*iou, "<ellipse>"); break;
    case Xcircle: fprintf(*iou, "<circle>"); break;
    case Xline: fprintf(*iou, "<line>"); break;
    case Xarrow: fprintf(*iou, "<arrow>"); break;
    case Xmove: fprintf(*iou, "<move>"); break;
    case Xspline: fprintf(*iou, "<spline>"); break;
    case Xarc: fprintf(*iou, "<arc>"); break;
    case Xstring: fprintf(*iou, "<<string>>"); break;
    case XLaTeX: fprintf(*iou, "<<LaTeX>>"); break;
    case Xlabel: fprintf(*iou, "<<Label>>"); break;
    default: fprintf(*iou, "Unknown type %3d", p); break;
    }
  fflush(*iou);
}


void
snaptree(primitive *pr, int indent)
{
  int i, j = /* 6 */ 0;
  while ((pr != NULL) && (indent <= 240)) {
    snaptype(&log_, pr->ptype);
	/* fprintf(log_,"[%d]",odp(pr)); */
    switch (pr->ptype) {
      case Xblock: i = 4; break;
      case Xbox:
      case Xarc: i = 5; break;
      case Xline:
      case Xmove: i = 6; break;
      case Xarrow: i = 7; break;
      case Xcircle:
      case Xspline: i = 8; break;
      case Xellipse:
      case XLaTeX: i = 9; break;
      case Xstring: i = 10; break;
      case Xlabel: i = 12; break;
      default: i = 3; break;
      }
    snaptree(pr->nextname, indent + i + j);
    j = 0;
    if (pr->son != NULL) { fprintf(log_, "\n%*c", indent, ' '); }
    pr = pr->son;
    }
}

void
printtext(nametype *namptr)
{
  while (namptr != NULL) {
      putc(' ', log_);
      wpair(&log_, ordp(namptr), ordp(namptr->nextname));
      fprintf(log_, " val=");
      wfloat(&log_, namptr->val);
      fflush(log_);
      snapname(namptr->segmnt, namptr->seginx, namptr->len);
      namptr = namptr->nextname;
      putc('\n', log_);
  }
}

void
printobject(primitive *primp)
{
  double xx, yy;
  int i;
  primitive *wprim;
  if (debuglevel != 0) {
    if (primp == NULL) { fprintf(log_, "Object is nil\n"); }
    else {
	  while (primp != NULL) {
	    wprim = primp;
	    fprintf(log_, "Object(%d) type=", ordp(primp));
	    snaptype(&log_, wprim->ptype);
	    fprintf(log_, "(%d)\n", wprim->ptype);
	    fprintf(log_, " Parent(%d", ordp(wprim->parent));
	    if (wprim->parent != NULL) {
		  fprintf(log_, ") Parent^.son(%d", ordp(wprim->parent->son)); }
	    fprintf(log_, ") Son(%d) Next(%d)\n",
		      ordp(wprim->son), ordp(wprim->nextname));
	    if (wprim->name != NULL) {
		  fprintf(log_, " name: ");
		  printtext(wprim->name); }
	    if (wprim->outlinep != NULL) {
		  fprintf(log_, " outline:");
		  printtext(wprim->outlinep); }
	    if (wprim->shadedp != NULL) {
		  fprintf(log_, " shaded:");
		  printtext(wprim->shadedp); }
	    if (wprim->textp != NULL) {
          fprintf(log_," textp->");
          printtext(wprim->textp); }
	    fprintf(log_, " aat");
	    wpair(&log_, wprim->aat.xpos, wprim->aat.ypos);
	    wlogfl("lparam", wprim->lparam, 0);
	    wlogfl("lthick", wprim->lthick, 0);
	    switch (wprim->direction) {
	      case Xup: fprintf(log_, " <up>"); break;
	      case Xdown: fprintf(log_, " <down>"); break;
	      case Xleft: fprintf(log_, " <left>"); break;
	      case Xright: fprintf(log_, " <right>"); break;
	      default: fprintf(log_, " dir =%d", wprim->direction); break;
	      }
	    fprintf(log_, " spec=%d(", wprim->spec);
        if (wprim->spec > 7) { fprintf(log_,"then,"); }
        logspec(wprim->spec);
        fprintf(log_,")\n");
	    fflush(log_);
	    switch (wprim->ptype) {
	      case Xbox:
	      case Xstring:
		    wlogfl("boxfill", wprim->boxfill_, 0);
		    wlogfl("boxheight", wprim->boxheight_, 0);
		    wlogfl("boxwidth", wprim->boxwidth_, 0);
		    wlogfl("boxrad", wprim->boxradius_, 0);
		    break;
	      case Xblock:
		    wlogfl("blockheight", wprim->blockheight_, 0);
		    wlogfl("blockwidth", wprim->blockwidth_, 0);
		    fprintf(log_, " here=");
		    wpair(&log_, wprim->here_.xpos, wprim->here_.ypos);
		    fprintf(log_, " vars=");
		    for (i = 0; i <= HASHLIM; i++) {
		      if (wprim->blockparms.vars[i] == NULL) {
				 fprintf(log_, " %d nil;", i);}
		      else {
				fprintf(log_, " %d %d;", i, ordp(wprim->blockparms.vars[i])); }
		      }
		    fprintf(log_, "\n env=");
		    if (wprim->blockparms.env == NULL) { fprintf(log_, "nil"); }
		    else { fprintf(log_, "%d", ordp(wprim->blockparms.env)); }
		    break;
	      case Xcircle:
		    wlogfl("cfill", wprim->circlefill_, 0);
		    wlogfl("radius", wprim->circleradius_, 0);
		    break;
	      case Xellipse:
		    wlogfl("efill", wprim->ellipsefill_, 0);
		    wlogfl("elheight", wprim->ellipseheight_, 0);
		    wlogfl("elwidth", wprim->ellipsewidth_, 0);
		    break;
	      case Xline:
	      case Xarrow:
	      case Xmove:
	      case Xspline:
		    fprintf(log_, " endpos=");
		    wpair(&log_, wprim->endpos_.xpos, wprim->endpos_.ypos);
		    wlogfl("height", wprim->lineheight_, 0);
		    wlogfl("width", wprim->linewidth_, 0);
		    wlogfl("lfill", wprim->linefill_, 0);
		    wlogfl("aradius", wprim->aradius_, 0);
		    fprintf(log_, "\n ahlex(atype)=%d", ahlex(wprim->lineatype_));
		    fprintf(log_, " ahnum(atype)=%d", ahnum(wprim->lineatype_));
		    break;
	      case Xarc:
		    fprintf(log_, " lspec=%d", lspec(wprim->spec));
		    wlogfl("lfill", wprim->linefill_, 0);
		    wlogfl("aradius", wprim->aradius_, 0);
		    fprintf(log_, " (startangle_,arcangle_)(deg)=");
		    wpair(&log_, wprim->startangle_ * 180.0 / pi,
		      wprim->arcangle_ * 180.0 / pi);
		    fprintf(log_, "\n (from)=");
		    xx = wprim->aat.xpos + (wprim->aradius_ * cos(wprim->startangle_));
		    yy = wprim->aat.ypos + (wprim->aradius_ * sin(wprim->startangle_));
		    wpair(&log_, xx, yy);
		    fprintf(log_, " (to)=");
		    xx = wprim->aat.xpos + (wprim->aradius_ *
              cos(wprim->startangle_ + wprim->arcangle_));
		    yy = wprim->aat.ypos + (wprim->aradius_ *
              sin(wprim->startangle_ + wprim->arcangle_));
		    wpair(&log_, xx, yy);
		    fprintf(log_, " ahlex(atype)=%d", ahlex(wprim->lineatype_));
		    fprintf(log_, " ahnum(atype)=%d", ahnum(wprim->lineatype_));
		    break;
	      case XLaTeX:
	      case Xlabel:
			/* blank case */
		    break;
	      default:
		    fprintf(log_, " Bad case in printobject; this cannot happen\n");
		    break;
	      }
	    putc('\n', log_);
	    fflush(log_);
	    if (wprim->ptype == Xblock) { primp = NULL; }
	    else { primp = wprim->son; }
	    }
      }
  }
  putc('\n', log_);
  fflush(log_);
}

void
prattribute(char *label, attribute *a)
{
  fprintf(log_, "attribute %s[%d]:", label, ordp(a));
  fprintf(log_, "\n lexval %4d", a->lexval);
  fprintf(log_, "  state %4d", a->state);
  fprintf(log_, "  chbufx %4d", a->chbufx);
  fprintf(log_, "  toklen %4d\n", a->toklen);
  if (a->varname != NULL) {
    fprintf(log_, " varname "); printtext(a->varname); }
  fprintf(log_, " xval %g", a->xval);
  fprintf(log_, " yval %g\n", a->yval);
  if (a->prim != NULL) {
    fprintf(log_, " prim[%d]",ordp(a->prim));
    fprintf(log_, " ptype : %4d ", a->prim->ptype);
    snaptype(&log_,a->prim->ptype); }
  putc('\n', log_);
  if (a->internal != NULL) {
    fprintf(log_, "intrtype: ");
    fprintf(log_, "%4d", a->internal->ptype);
    putc('\n', log_); }
}

void
prvars(primitive *eb)
{
  nametype *lv;
  int i = 0, x = HASHLIM + 1;
  if (eb == NULL) { fprintf(log_, "vars=nil: nil envblock"); return; }
  while (i < x) { if (eb->blockparms.vars[i] != NULL) { x = i; } else { i++; } }
  fprintf(log_, "vars=\n");
  if (x > HASHLIM) { fprintf(log_, "  None set\n"); return; }
  for (i = 0; i <= HASHLIM; i++) {
    fprintf(log_, "%d", i);
    lv = eb->blockparms.vars[i];
    if (lv == NULL) { fprintf(log_, " nil\n"); }
    while (lv != NULL) {
	  fprintf(log_, " (%d,%d)=", ordp(lv), ordp(lv->nextname));
	  snapname(lv->segmnt, lv->seginx, lv->len);
	  putc('=', log_);
	  wfloat(&log_, lv->val);
	  putc('\n', log_);
	  lv = lv->nextname;
      }
    }
  putc('\n', log_);
}
#endif

							/* Dispose of a tree of 1 or more objects */
void
deletetree(primitive **p)
{
  primitive *r, *wprim;
  int i;
#ifdef DDEBUG
    if (debuglevel > 0) { fprintf(log_, "deletetree:\n"); }
#endif
  if ((*p) != NULL) { (*p)->parent = NULL; }
  while ((*p) != NULL) {
    while (((*p)->nextname != NULL) || ((*p)->son != NULL)) {
	  r = *p;
	  if ((*p)->nextname != NULL) { *p = (*p)->nextname; r->nextname = NULL; }
	  else { *p = (*p)->son; r->son = NULL; }
	  (*p)->parent = r;
      }
    r = (*p)->parent;
    deletename(&(*p)->shadedp);
    deletename(&(*p)->outlinep);
    deletename(&(*p)->textp);
    deletename(&(*p)->name);
    wprim = *p;
    if ((wprim->ptype) == Xblock) {
#ifdef DDEBUG
      if (debuglevel > 0) { fprintf(log_, "Xblock: "); }
#endif
	  for (i = HASHLIM; i >= 0; i--) { deletename(&wprim->blockparms.vars[i]);}
	  if (wprim->blockparms.env != NULL) { Free(wprim->blockparms.env); }
      }
#ifdef DDEBUG
    if (debuglevel > 0) {fprintf(log_, "*p free(%d)\n",odp(*p)); }
#endif
    free(*p);
    *p = r;
    }
  }


							/* Store arc strtang and arcang parameters */
void
setangles(double *strtang, double *arcang, postype ctr, double xs, double ys,
	  double xf, double yf)
{
  double ra;                       /* set arc angles given centre, start, end */
  *strtang = datan(ys - ctr.ypos, xs - ctr.xpos);
  ra = principal(datan(yf - ctr.ypos, xf - ctr.xpos) - (*strtang), pi);
  if ((ra < 0.0) && ((*arcang) > 0.0)) { ra += 2.0 * pi; }
  else if ((ra > 0.0) && ((*arcang) < 0.0)) { ra -= 2.0 * pi; }
  *arcang = ra;
}


							/* Perform assignment operator */
void
eqop(double *x, int op, double y)
{
  int i, j;

  switch (op) {
  case Xeq:
  case Xcoloneq:
    *x = y;
    break;
  case Xpluseq:
    *x += y;
    break;
  case Xminuseq:
    *x -= y;
    break;
  case Xmulteq:
    *x *= y;
    break;
  case Xdiveq:
    if (y == 0) { markerror(852); }
    else { *x /= y; }
    break;
  case Xremeq:
    i = Rnd((*x));
    j = Rnd(y);
    if (j == 0) { markerror(852); *x = 0.0; }
    else { *x = i - ((i / j) * j); }
    break;
  }
}

							/* Store int value in bits 9 and above */
void
setstval(int *st, int value)
{ *st = (value * 256) + ((*st) & 255);
}

							/* Recover int value from bits 9 and above */
int
getstval(int st)
{
  return (st >> 8);
}

							/* Record application of object attribute */
void
setstflag(int *st, int value)
{
  switch (value) {
  case XEMPTY:
    *st = ((*st) >> 6) * 64;
    break;
  case Xto:
    *st = (((*st) >> 1) * 2) + 1;
    break;
  case Xfrom:
    *st = (((*st) >> 2) * 4) + ((*st) & 1) + 2;
    break;
  case Xat:
    *st = (((*st) >> 3) * 8) + ((*st) & 3) + 4;
    break;
  case Xradius:
    *st = (((*st) >> 4) * 16) + ((*st) & 7) + 8;
    break;
  case Xcw:
    *st = (((*st) >> 5) * 32) + ((*st) & 15) + 16;
    break;
  case Xccw:
    *st = (((*st) >> 6) * 64) + ((*st) & 31) + 32;
    break;
  case Xchop:
    *st = (((*st) >> 7) * 128) + ((*st) & 63) + 64;
    break;
  case Xdirecton:
    *st = (((*st) >> 8) * 256) + ((*st) & 127) + 128;
    break;
  }
}


							/* Test if attribute has been applied */
boolean
teststflag(int st, int value)
{
  boolean b = false;

  switch (value) {
  case Xto:
    b = st & 1;
    break;
  case Xfrom:
    b = (st >> 1) & 1;
    break;
  case Xat:
    b = (st >> 2) & 1;
    break;
  case Xradius:
    b = (st >> 3) & 1;
    break;
  case Xcw:
    b = (st >> 4) & 1;
    break;
  case Xccw:
    b = (st >> 5) & 1;
    break;
  case Xchop:
    b = (st >> 6) & 1;
    break;
  case Xdirecton:
    b = (st >> 7) & 1;
    break;
  }
  return b;
}

							/* String equality of primitives */
int
cmpstring(primitive *p1, primitive *p2)
{
  if ((p1 == NULL) || (p2 == NULL)) { return maxint; }
  else if (p1->textp == NULL) { return maxint; }
  else if (p2->textp == NULL) { return (-maxint); }
  else { return (
          eqstring(p1->textp->segmnt, p1->textp->seginx, p1->textp->len,
		           p2->textp->segmnt, p2->textp->seginx, p2->textp->len)); }
}


							/* Match place name with stored places */
primitive *(
findplace(primitive *p, Char *chb, chbufinx inx, chbufinx toklen))
{
  primitive *pj = NULL;
  nametype *pname;
  while (p != pj) {
    if (p->name == NULL) { p = p->nextname; }
    else {
	  pname = p->name;
	  if (eqstring(pname->segmnt,pname->seginx,pname->len,
                   chb, inx,toklen) == 0) { pj = p; }
	  else { p = p->nextname; }
      }
    }
  return p;
}

							/* Get the value of a global variable */
double
findvar(char *s, int ln)
{
  int i, k;
  nametype *last, *np;
  chbufarray tmpfmt;

  for (i = 1; i <= ln; i++) { tmpfmt[i] = s[i-1]; }
  np = findname(globalenv, tmpfmt, 1, ln, &last, &k);
  if (np == NULL) { return 0.0; }
  else { return (np->val); }
}

							/* Search for variable in this and higer scope*/
nametype *(
glfindname(primitive *eb, Char *chb, chbufinx chbufx, chbufinx toklen,
	   nametype **last, int *k))
{
  nametype *np = NULL;
  primitive *pp = NULL;
  *k = 1;
  while (eb != pp) {
    np = findname(eb, chb, chbufx, toklen, last, k);
    if (np != NULL) { pp = eb; }
    else { eb = eb->parent; }
    }
  if (eb == NULL) { marknotfound(851, chb, chbufx, toklen); }
  return np;
}


							/* Append the int string to the name string*/
void
appendsuff(Char *buf, chbufinx inx, int *len, double x)
{
  int i, j, k;
  i = Rnd(x);
  if (i < 0) { buf[inx + (*len)] = '-'; (*len)++; i = -i; }
  k = i;
  do { (*len)++; k /= 10; } while (k != 0);
  if (inx + (*len) - 1 > CHBUFSIZ) { fatal(4); }
  j = (*len) - 1;
  do {
    k = i / 10;
    buf[inx + j] = i - (k * 10) + '0';
    i = k;
    j--;
  } while (i != 0);
}

							/* Append the suffix string to the name string
							   for one or two integers */
void
addsuffix(Char *buf, chbufinx *inx, int *len, double x, int lx, double y)
{
  int i, FORLIM;
  if (chbufi + (*len) - 1 > CHBUFSIZ) { fatal(4); }
  if ((*inx) + (*len) != chbufi) {
    FORLIM = *len;
    for (i = 0; i < FORLIM; i++) {
      buf[chbufi + i] = buf[(*inx) + i];
      buf[(*inx) + i] = '\0'; }
    *inx = chbufi; }
  if ((*inx) + (*len) + 2 > CHBUFSIZ) { fatal(4); }
  buf[(*inx) + (*len)] = '[';
  (*len)++;
  appendsuff(buf, *inx, len, x);
  if (lx == Xcomma) {
    buf[(*inx) + (*len)] = ',';
    (*len)++;
    appendsuff(buf, *inx, len, y); }
  buf[(*inx) + (*len)] = ']';
  (*len)++;
  chbufi = (*inx) + (*len);
}  /* addsuffix */


							/* Implement "then" or the "to" special case */
void
appendthen(primitive **pr) {
  primitive *prp, *prq;
  for (prq=(*pr); prq->son != NULL; prq = prq->son) {}
  copyprim(prq, &prp);
  prp->parent = prq;
  prp->son = NULL;
  prp->nextname = NULL;
  prp->name = NULL;
  prp->textp = NULL;
  prp->shadedp = NULL;
  if (prp->outlinep != NULL) {  /* We have to duplicate the stored string */
    copystr(&prp->outlinep, prq->outlinep); }
  FindExitPoint(prq, &prp->aat);
  prq->son = prp;
  setthen(&prp->spec);
  *pr = prp;
}

							/* Attribute up, down, left, right */
void
lineardir(primitive *pr, double dy, double dx, int *state) {
  if (!(teststflag(*state, Xto) | teststflag(*state, Xdirecton))) {
      pr->endpos_ = pr->aat; }
  switch (pr->direction) {
  case Xup:
    pr->endpos_.ypos += dy;
    break;
  case Xdown:
    pr->endpos_.ypos -= dy;
    break;
  case Xleft:
    pr->endpos_.xpos -= dx;
    break;
  case Xright:
    pr->endpos_.xpos += dx;
    break;
  }
  setstflag(state, Xdirecton);
}

							/* Test for outline for outlined "string" */
boolean
hasoutline(int lx, boolean warn) {
  boolean hs;
  hs = ((lx == Xspline) || (lx == Xarrow) || (lx == Xline) ||
	(lx == Xarc) || (lx == Xellipse) ||
	(lx == Xcircle) || (lx == Xbox));
  if (drawmode == SVG) { hs = (hs || (lx == Xstring)); }
  if ((!hs) && warn) { markerror(858); }
  return hs;
}


							/* Test for shade for shaded "string" */
boolean
hasshade(int lx, boolean warn) {
  boolean hs;
  if ((lx == Xellipse) || (lx == Xcircle) || (lx == Xbox)) { hs = true; }
  else if ((drawmode == Pict2e) || (drawmode == TeX) || (drawmode == tTeX) ||
           (drawmode == xfig)) { hs = false; }
  else { hs = ((lx == Xspline) || (lx == Xarrow) || (lx == Xline) ||
	    (lx == Xarc)); }
  if (drawmode == SVG) { hs = (hs || (lx == Xstring)); }
  if ((!hs) && warn) { markerror(858); }
  return hs;
}


							/* Create a string struct */
void
newstr(nametype **sp) {
  nametype *namestruct;
  *sp = malloc(sizeof(nametype)); if (*sp==NULL){ fatal(9); }
  namestruct = *sp;
  namestruct->val = 0.0;
  namestruct->segmnt = NULL;
  namestruct->seginx = 0;
  namestruct->len = 0;
  namestruct->nextname = NULL;
#ifdef DDEBUG
  if (debuglevel > 0) { fprintf(log_, "newstr[%d]\n", ordp(*sp)); }
#endif
}


							/* Copy a string into freeseg */
void
storestring(nametype *outstr,
  Char *srcbuf, chbufinx psrc, chbufinx lsrc, int job)
{ int i, j;
  boolean newseg;
  if ((freeseg == NULL) || (lsrc > (CHBUFSIZ - freex + 1))) { newseg = true; }
  else { newseg = false; }
  if (newseg) {
    freeseg = malloc(sizeof(chbufarray)); if (freeseg==NULL){ fatal(9); }
#ifdef DDEBUG
    if (debuglevel>0) { fprintf(log_,
      " storestring new[%d]\n lsrc=%d freex=%d space=%d\n",
        ordp(freeseg),lsrc,freex,CHBUFSIZ-freex+1); }
#endif
    putbval(freeseg, 0);
    freex = 2; }
  if (lsrc > (CHBUFSIZ - freex + 1)) { markerror(866); fatal(4); }
  for (i = 0; i < lsrc; i++) { freeseg[freex + i] = srcbuf[psrc + i]; }
  outstr->segmnt = freeseg;
  outstr->seginx = freex;
  outstr->len = lsrc;
  j = bval(freeseg);
  putbval(freeseg, j+1);
  freex += lsrc;
#ifdef DDEBUG
  if (debuglevel > 0) { fprintf(log_,
	  "storestring to strptr %d: segmnt=%d seginx=%d links=%d freex=%d\n",
	  ordp(outstr), ordp(freeseg), outstr->seginx, bval(freeseg),
      freex);
  snapname(freeseg, outstr->seginx, outstr->len);
  fprintf(log_, " from:");
  snapname(srcbuf, psrc, lsrc);
  putc('\n', log_); }
#endif
  if (job != 0) { clearchbuf(psrc, lsrc); }
  }

							/* Duplicate a strptr and copy the body */
void
copystr(nametype **sp, nametype *ip)
{
  if (ip == NULL) { *sp = NULL; }
  else {
    newstr(sp);
    storestring(*sp, ip->segmnt, ip->seginx, ip->len, 0);
    }
}


							/* Append buf to *sp */
void
appendstring(nametype *sp, Char *buf, chbufinx px, chbufinx namelen)
{ int i, j;
  Char *tmpseg;
  int FORLIM;
  if ((sp == NULL) || (buf == NULL)) { return; }
  if ((sp->segmnt == freeseg) && (sp->seginx + sp->len == freex) &&
      (freex + namelen - 1 <= CHBUFSIZ)) {
                            /* New string fits; append to sp */
    for (i = 0; i < namelen; i++) { freeseg[freex + i] = buf[px + i]; }
    sp->len += namelen;
    freex += namelen;
    return;
    }
  if (sp->len + namelen + 2 > CHBUFSIZ) { markerror(866); return; }
  tmpseg = malloc(sizeof(chbufarray)); if (tmpseg==NULL){ fatal(9); }
                            /* Copy the existing string to tmpseg */
  FORLIM = sp->len;
  for (i = 0; i < FORLIM; i++) { tmpseg[i+2] = sp->segmnt[sp->seginx + i]; }
  j = bval(sp->segmnt);
  if (j > 1) {
    putbval(sp->segmnt, j-1);
    if ((sp->segmnt == freeseg) && (sp->seginx + sp->len == freex)) {
	  freex = sp->seginx;
	  j = 2;
	  while (freex > j) {
	    if (sp->segmnt[freex-1] == nlch) { freex--; }
	    else { j = freex; }
	    }
      }
    else {
	  FORLIM = sp->seginx + sp->len;
	  for (i = sp->seginx; i < FORLIM; i++) { sp->segmnt[i] = nlch; }
      }
    }
  else {
    if (sp->segmnt == freeseg) { freeseg = NULL; }
    Free(sp->segmnt);
    }
                            /* Append new string to tmpseg */
  if (sp->len + namelen + 1 > CHBUFSIZ) { fatal(4); }
  for (i = 0; i < namelen; i++) { tmpseg[sp->len + i + 2] = buf[px + i]; }
  freeseg = tmpseg;
  freex = sp->len + namelen + 2;
  putbval(freeseg, 1);
  sp->segmnt = freeseg;
  sp->seginx = 2;
  sp->len += namelen;
}


							/* Store or append string */
int
putstring(int ix, nametype *sp, Char *buf, chbufinx px, chbufinx namelen)
{
  if (ix <= 0) { storestring(sp, buf, px, namelen, 0); }
  else { appendstring(sp, buf, px, namelen); }
  return (ix + 1);
}


							/* Height of a primitive object */
double
pheight(primitive *pr)
{
  double ph;
  if (pr == NULL) { ph = 0.0; return ph; }
  switch (pr->ptype) {
  case Xbox:
    ph = pr->boxheight_;
    break;
  case Xstring:
    ph = pr->boxheight_;
    break;
  case Xblock:
    ph = pr->blockheight_;
    break;
  case Xellipse:
    ph = pr->ellipseheight_;
    break;
  case Xcircle:
    ph = 2.0 * pr->circleradius_;
    break;
  case Xline:
  case Xarrow:
  case Xmove:
  case Xspline:
    ph = pr->lineheight_;
    break;
  default:
    ph = 0.0;
    break;
  }
  return ph;
}


							/* Width of a primitive object */
double
pwidth(primitive *pr)
{
  double pw;

  if (pr == NULL) {
      pw = 0.0;
      return pw;
  }
  switch (pr->ptype) {

  case Xbox:
  case Xstring:
    pw = pr->boxwidth_;
    break;

  case Xblock:
    pw = pr->blockwidth_;
    break;

  case Xellipse:
    pw = pr->ellipsewidth_;
    break;

  case Xcircle:
    pw = 2.0 * pr->circleradius_;
    break;

  case Xline:
  case Xarrow:
  case Xmove:
  case Xspline:
    pw = pr->linewidth_;
    break;

  default:
    pw = 0.0;
    break;
  }
  return pw;
}


							/* The n, s, e, w values of a drawing tree */
void
neswrec(primitive *ptm)
{
  while (ptm != NULL) {
    nesw(ptm);
    if (ptm->ptype != Xblock) { neswrec(ptm->son); }
    ptm = ptm->nextname;
    }
  }


							/* Bounding box of a drawing tree */
void
getnesw(primitive *ptm)
{
  initnesw();
  neswrec(ptm);
  if (south > north) {
    south = 0.0;
    north = 0.0;
    }
  if (west > east) {
    west = 0.0;
    east = 0.0;
    }
}


							/* Test and return A(bove), B(elow),
							                   L(eft), R(ight) */
void
checkjust(nametype *tp, boolean *A, boolean *B, boolean *L, boolean *R)
{
  int i;

  if (tp == NULL) {
    *A = false;
    *B = false;
    *L = false;
    *R = false;
    return;
    }
  i = Rnd(tp->val);
  *R = i & 1;
  *L = (i >> 1) & 1;
  *B = (i >> 2) & 1;
  *A = (i >> 3) & 1;
}

							/* Return linespec, i.e.,
							   <solid>, <dotted>, <dashed>, <invis>
							   from lowest 3 bits */
int
lspec(int n)
{ /* if ((n div 16) mod 2) <> 0 then lspec := Xsolid
  else */
  return ((n & 7) + Xlinetype);
}

							/* Find the lowest block with environment
							   variables defined */
primitive *(
findenv(primitive *p))
{
  primitive *q = NULL;

  while (p != q) {
    if (p->ptype != Xblock) { p = p->parent; }
    else if (p->blockparms.env == NULL) { p = p->parent; }
    else { q = p; }
    }
  return p;
}


							/* Get the value of an environment variable */
double
venv(primitive *p, int ind)
{
  double v = 0.0;
  if ((ind <= XXenvvar) || (ind > Xlastenv)) { return v; }
  p = findenv(p);
  if (p != NULL) { v = p->blockparms.env[ind - XXenvvar - 1]; }
  return v;
}


							/* Get the value of an environment variable
							   if it has not been set locally */
double
qenv(primitive *p, int ind, double localval)
{
  double noval;
  switch (ind) {
  case Xfillval: noval = -1.0; break;
  case Xlinethick: noval = mdistmax; break;
  case Xdashwid: noval = mdistmax; break;
  default: noval = 0.0; break;
  }
  if (localval == noval) { return (venv(p, ind)); }
  else if (ind == Xlinethick) { return fabs(localval); }
  else { return localval; }
}


							/* Position from an affine transformation
							   orig + mat(cs) * [x,y]
							   Position cs is (cos t, sin t) */
postype
affine(double x, double y, postype orig, postype cs)
{
  postype tpos;

  tpos.xpos = orig.xpos + (cs.xpos * x) - (cs.ypos * y);
  tpos.ypos = orig.ypos + (cs.ypos * x) + (cs.xpos * y);
  return tpos;
}


							/* Get (cos t, sin t) of point wrt shaft */
postype
affang(postype point, postype shaft)
{
  double lgth;
  postype tpos;

  lgth = linlen(shaft.xpos - point.xpos, shaft.ypos - point.ypos);
  if (lgth == 0.0) {
    tpos.xpos = 1.0;
    tpos.ypos = 0.0; }
  else {
    tpos.xpos = (point.xpos - shaft.xpos) / lgth;
    tpos.ypos = (point.ypos - shaft.ypos) / lgth; }
  return tpos;
}

							/* Initialize parameters for routine nesw */
void
initnesw(void)
{
  south = distmax;
  north = -south;
  west = south;
  east = -west;
}


							/* Values north, south, west, east for a string
							   accounting for ljust rjust above below */
void
neswstring(primitive *pmp, double ht, double wd)
{
  boolean A, B, L, R;
  double x, y, offst;
  if (pmp == NULL) { return; }
  checkjust(pmp->textp, &A, &B, &L, &R);
  offst = venv(pmp, Xtextoffset);
  y = pmp->aat.ypos;
  if (A) { y += (ht * 0.5) + offst; }
  else if (B) { y += ((-ht) * 0.5) - offst; }
  x = pmp->aat.xpos;
  if (R) { x += ((-wd) * 0.5) - offst; }
  else if (L) { x += (wd * 0.5) + offst; }
  north = Max(north, y + (ht * 0.5));
  south = Min(south, y - (ht * 0.5));
  west = Min(west, x - (wd * 0.5));
  east = Max(east, x + (wd * 0.5));
#ifdef DDEBUG
  if (debuglevel > 0) {
    fprintf(log_, " neswstring:");
    wlogfl("aat.xpos", pmp->aat.xpos, 0);
    wlogfl("x", x, 0);
    wlogfl("y", y, 1);
    wlogfl("east", east, 0);
    wlogfl("west", west, 0);
    wlogfl("wd", wd, 1);
    wlogfl("north", north, 0);
    wlogfl("south", south, 0);
    wlogfl("ht", ht, 1); }
#endif
}


							/* Values north, south, west, east for a line
							   or arrow */
void
neswline(primitive *pmp)
{
  double aht, awd;
  postype cs, cc, cd;
  int TEMP;
  if (pmp == NULL) { return; }
  west = Min(west, Min(pmp->aat.xpos, pmp->endpos_.xpos));
  east = Max(east, Max(pmp->aat.xpos, pmp->endpos_.xpos));
  south = Min(south, Min(pmp->aat.ypos, pmp->endpos_.ypos));
  north = Max(north, Max(pmp->aat.ypos, pmp->endpos_.ypos));
  TEMP = ahlex(pmp->lineatype_);
  if ((TEMP == Xlefthead) || (TEMP == Xdoublehead)) {
    cs = affang(pmp->endpos_, pmp->aat);
    awd = qenv(pmp, Xarrowht, pmp->linewidth_);
    aht = qenv(pmp, Xarrowwid, pmp->lineheight_);
    cc = affine(aht, awd / 2, pmp->aat, cs);
    cd = affine(aht, awd / (-2), pmp->aat, cs);
    west = Min(west, Min(cc.xpos, cd.xpos));
    east = Max(east, Max(cc.xpos, cd.xpos));
    south = Min(south, Min(cc.ypos, cd.ypos));
    north = Max(north, Max(cc.ypos, cd.ypos));
    }
  TEMP = ahlex(pmp->lineatype_);
  if (!((TEMP == Xrighthead) || (TEMP == Xdoublehead))) { return; }
  cs = affang(pmp->aat, pmp->endpos_);
  awd = qenv(pmp, Xarrowht, pmp->linewidth_);
  aht = qenv(pmp, Xarrowwid, pmp->lineheight_);
  cc = affine(aht, awd / 2, pmp->endpos_, cs);
  cd = affine(aht, awd / (-2), pmp->endpos_, cs);
  west = Min(west, Min(cc.xpos, cd.xpos));
  east = Max(east, Max(cc.xpos, cd.xpos));
  south = Min(south, Min(cc.ypos, cd.ypos));
  north = Max(north, Max(cc.ypos, cd.ypos));
}


							/* Test if angle is within an arc segment */
boolean
inarc(double strt, double fin, double ang, double arcang)
{
  boolean inarctmp;

  if (arcang >= 0.0) {
    while (fin < strt) { fin += 2.0 * pi; }
    while (ang < strt) { ang += 2.0 * pi; }
    if (ang <= fin) { inarctmp = true; }
    else { inarctmp = false; }
    }
  else {
    while (fin > strt) { fin -= 2.0 * pi; }
    while (ang > strt) { ang -= 2.0 * pi; }
    if (ang >= fin) { inarctmp = true; }
    else { inarctmp = false; }
    }
  return inarctmp;
}


							/* Values north, south, east, west of an obj */
void
nesw(primitive *ptmp)
{
  double hight, wdth, sang, eang;
  if (ptmp == NULL) { return; }
  switch (ptmp->ptype) {
    case Xstring:
      hight = ptmp->boxheight_;
      wdth = ptmp->boxwidth_;
      break;
    case Xbox:
      hight = ptmp->boxheight_;
      wdth = ptmp->boxwidth_;
      break;
    case Xblock:
      hight = ptmp->blockheight_;
      wdth = ptmp->blockwidth_;
      break;
    case Xcircle:
      hight = 2.0 * ptmp->circleradius_;
      wdth = hight;
      break;
    case Xellipse:
      hight = ptmp->ellipseheight_;
      wdth = ptmp->ellipsewidth_;
      break;
    default:
      hight = 0.0;
      wdth = 0.0;
      break;
    }
  switch (ptmp->ptype) {
  case Xbox:
  case Xblock:
  case Xcircle:
  case Xellipse:
    north = Max(north, ptmp->aat.ypos + (hight * 0.5));
    south = Min(south, ptmp->aat.ypos - (hight * 0.5));
    west = Min(west, ptmp->aat.xpos - (wdth * 0.5));
    east = Max(east, ptmp->aat.xpos + (wdth * 0.5));
    break;
  case Xstring:
    if (drawmode == SVG) {
	north = Max(north, ptmp->aat.ypos + (hight * 0.5));
	south = Min(south, ptmp->aat.ypos - (hight * 0.5));
	west = Min(west, ptmp->aat.xpos - (wdth * 0.5));
	east = Max(east, ptmp->aat.xpos + (wdth * 0.5));
    }
    else {
	neswstring(ptmp, hight, wdth);
    }
    break;
  case Xline:
  case Xarrow:
  case Xmove:
  case Xspline:
    neswline(ptmp);
    break;
  case XLaTeX:
  case Xlabel:
	/* blank case */
    break;
  case Xarc:
    sang = principal(ptmp->startangle_, pi);
    eang = ptmp->startangle_ + ptmp->arcangle_;
    if (inarc(sang, eang, 0.5 * pi, ptmp->arcangle_)) {
	  north = Max(north, ptmp->aat.ypos + ptmp->aradius_); }
    else { north = Max(north,
	  ptmp->aat.ypos + (ptmp->aradius_ * Max(sin(sang), sin(eang)))); }
    if (inarc(sang, eang, (-0.5) * pi, ptmp->arcangle_)) {
	  south = Min(south, ptmp->aat.ypos - ptmp->aradius_); }
    else { south = Min(south,
	  ptmp->aat.ypos + (ptmp->aradius_ * Min(sin(sang), sin(eang)))); }
    if (inarc(sang, eang, pi, ptmp->arcangle_)) {
	  west = Min(west, ptmp->aat.xpos - ptmp->aradius_); }
    else { west = Min(west,
	  ptmp->aat.xpos + (ptmp->aradius_ * Min(cos(sang),cos(eang)))); }
    if (inarc(sang, eang, 0.0, ptmp->arcangle_)) {
	  east = Max(east, ptmp->aat.xpos + ptmp->aradius_); }
    else { east = Max(east,
	  ptmp->aat.xpos + (ptmp->aradius_ * Max(cos(sang),cos(eang)))); }
    break;
  }
#ifdef DDEBUG
  if (debuglevel > 0) {
    fprintf(log_, "nesw(%d) ptype=%d", odp(ptmp), ptmp->ptype);
    wlogfl("W", west, 0); wlogfl("S", south, 0);
    wlogfl("E", east, 0); wlogfl("N", north, 1); }
#endif
}

							/* Exit point of a primitive object */
void
FindExitPoint(primitive *pr, postype *pe)
{
  if (pr == NULL) {
      pe->xpos = 0.0;
      pe->ypos = 0.0;
      return;
  }
  if ((pr->ptype != Xblock) && (pr->son != NULL)) {
      FindExitPoint(pr->son, pe);
      return;
  }
  *pe = pr->aat;
  switch (pr->ptype) {
  case Xbox:
    switch (pr->direction) {
    case Xup:
      pe->ypos = pr->aat.ypos + (pr->boxheight_ * 0.5);
      break;
    case Xdown:
      pe->ypos = pr->aat.ypos - (pr->boxheight_ * 0.5);
      break;
    case Xleft:
      pe->xpos = pr->aat.xpos - (pr->boxwidth_ * 0.5);
      break;
    case Xright:
      pe->xpos = pr->aat.xpos + (pr->boxwidth_ * 0.5);
      break;
    }
    break;

  case Xstring:
    switch (pr->direction) {
    case Xup:
      pe->ypos = pr->aat.ypos + (pr->boxheight_ * 0.5);
      break;
    case Xdown:
      pe->ypos = pr->aat.ypos - (pr->boxheight_ * 0.5);
      break;
    case Xleft:
      pe->xpos = pr->aat.xpos - (pr->boxwidth_ * 0.5);
      break;
    case Xright:
      pe->xpos = pr->aat.xpos + (pr->boxwidth_ * 0.5);
      break;
    }
    break;

  case Xblock:
    switch (pr->direction) {
    case Xup:
      pe->ypos = pr->aat.ypos + (pr->blockheight_ * 0.5);
      break;
    case Xdown:
      pe->ypos = pr->aat.ypos - (pr->blockheight_ * 0.5);
      break;
    case Xleft:
      pe->xpos = pr->aat.xpos - (pr->blockwidth_ * 0.5);
      break;
    case Xright:
      pe->xpos = pr->aat.xpos + (pr->blockwidth_ * 0.5);
      break;
    }
    break;

  case Xcircle:
    switch (pr->direction) {
    case Xup:
      pe->ypos = pr->aat.ypos + pr->circleradius_;
      break;
    case Xdown:
      pe->ypos = pr->aat.ypos - pr->circleradius_;
      break;
    case Xleft:
      pe->xpos = pr->aat.xpos - pr->circleradius_;
      break;
    case Xright:
      pe->xpos = pr->aat.xpos + pr->circleradius_;
      break;
    }
    break;

  case Xellipse:
    switch (pr->direction) {
    case Xup:
      pe->ypos = pr->aat.ypos + (pr->ellipseheight_ * 0.5);
      break;
    case Xdown:
      pe->ypos = pr->aat.ypos - (pr->ellipseheight_ * 0.5);
      break;
    case Xleft:
      pe->xpos = pr->aat.xpos - (pr->ellipsewidth_ * 0.5);
      break;
    case Xright:
      pe->xpos = pr->aat.xpos + (pr->ellipsewidth_ * 0.5);
      break;
    }
    break;

  case Xarc:
    *pe = arcend(pr);
    break;

  case Xline:
  case Xarrow:
  case Xmove:
  case Xspline:
    *pe = pr->endpos_;
    break;

  case Xlabel:
  case XLaTeX:
	/* blank case */
    break;
  }
}

							/* Retrieve integer in first two buffer bytes */
int
bval(Char *buf)
{
  return (((int) buf[0]) << 8) + (int) buf[1] ;
}

							/* Store integer in first two buffer bytes */
void
putbval(Char *buf, int n)
{
  buf[0] = (n>>8); buf[1] = (n & 255);
}

							/* Free the space used by the name string */
void
deletename(nametype **head)
{ /*F(var head: strptr)F*/
  nametype *pn, *r;
  int j, FORLIM;
#ifdef DDEBUG
  if (debuglevel > 0) {fprintf(log_, "deletename:\n"); }
#endif
  while ((*head) != NULL) {
    pn = *head;
    r = pn;
    while (pn->nextname != NULL) { r = pn; pn = pn->nextname; }
    r->nextname = NULL;
    if (pn == (*head)) { *head = NULL; }
    if (pn->segmnt != NULL) {
	  if (bval(pn->segmnt) > 1) {
	    j = bval(pn->segmnt);
	    putbval(pn->segmnt, j - 1);
	    if ((pn->segmnt == freeseg) && (pn->seginx + pn->len == freex)) {
		  freex = pn->seginx;
		  j = 2;
		  while (freex > j) {
		    if (pn->segmnt[freex-1] == nlch) { freex--; }
		    else { j = freex; }
		    }
	      }
	    else {
		  FORLIM = pn->seginx + pn->len;
		  for (j = pn->seginx; j < FORLIM; j++) { pn->segmnt[j] = nlch; }
	      }
	    }
	  else if ((pn->segmnt == freeseg) && (freeseg != NULL)) {
#ifdef DDEBUG
        if (debuglevel > 0) {fprintf(log_, "freeseg free(%d)\n",odp(freeseg)); }
#endif
	    Free(freeseg);
	    freeseg = NULL;
	    }
	  else {
#ifdef DDEBUG
        if (debuglevel > 0) {
          fprintf(log_, "pn->segmnt free(%d)\n",odp(pn->segmnt)); }
#endif
	    Free(pn->segmnt);
        pn->segmnt = NULL;
	    }
      }
#ifdef DDEBUG
    if (debuglevel > 0) { fprintf(log_, "pn free(%d)\n",odp(pn)); }
#endif
    Free(pn);
    }
}


							/* Store svalue in low 3 bits */
void
setspec(int *specv, int svalue)
{ *specv = (((*specv) >> 3) * 8) + svalue - Xlinetype;
							/* if svalue = Xsolid then
						     specv := (specv div 32)*32 + 16 + (specv mod 16) */
}

							/* Store svalue only in low 3 bits */
void
resetspec(int *specv, int svalue)
{ *specv = 0;
  setspec(specv, svalue);
}


							/* Set bit 4 to flag a segment with a parent */
void
setthen(int *specv)
{ *specv = (((*specv) >> 4) * 16) + ((*specv) & 7) + 8;
}

							/* Create and initialize a primitive object */
void
newprim(primitive **pr, int primtype, primitive *envblk)
{
  int i;
  primitive *wprim;
  switch (primtype) {
    case Xbox:
    case Xstring:
      *pr = malloc(sizeof(Xboxprimitive)); if (*pr==NULL){ fatal(9); }
      break;
    case Xblock:
      *pr = malloc(sizeof(primitive)); if (*pr==NULL){ fatal(9); }
      break;
    case Xcircle:
      *pr = malloc(sizeof(Xcircleprimitive)); if (*pr==NULL){ fatal(9); }
      break;
    case Xellipse:
      *pr = malloc(sizeof(Xellipseprimitive)); if (*pr==NULL){ fatal(9); }
      break;
    case Xline:
    case Xarc:
    case Xarrow:
    case Xmove:
    case Xspline:
      *pr = malloc(sizeof(Xlineprimitive)); if (*pr==NULL){ fatal(9); }
      break;
    case Xlabel:
    case XLaTeX:
      *pr = malloc(sizeof(Xlabelprimitive)); if (*pr==NULL){ fatal(9); }
      break;
    }

#ifdef DDEBUG
  if (debuglevel > 0) {fprintf(log_, "newprim");
  snaptype(&log_,primtype); fprintf(log_,"[%d]\n", ordp(*pr));
  }
#endif

  wprim = *pr;
  wprim->name = NULL;
  wprim->textp = NULL;
  wprim->outlinep = NULL;
  wprim->shadedp = NULL;
  wprim->son = NULL;
  wprim->nextname = NULL;
  if (envblk == NULL) {
    wprim->parent = NULL;
    wprim->aat.xpos = 0.0;
    wprim->aat.ypos = 0.0;
    wprim->direction = Xright;
    }
  else {
    wprim->parent = envblk;
    wprim->aat = envblk->here_;
    wprim->direction = envblk->direction;
    }
  wprim->lparam = mdistmax;
  wprim->lthick = mdistmax;
  if ((primtype == Xstring) || (primtype == Xspline) ||
    (primtype == Xarc) || (primtype == Xarrow) || (primtype == Xline) ||
    (primtype == Xellipse) || (primtype == Xcircle) ||
    (primtype == Xbox)) { resetspec(&wprim->spec, Xsolid); }
  else { resetspec(&wprim->spec, Xinvis); }
  wprim->ptype = primtype;
  switch (primtype) {
    case Xbox:
    case Xstring:
      wprim->boxfill_ = -1.0;
      wprim->boxheight_ = 0.0;
      wprim->boxwidth_ = 0.0;
      wprim->boxradius_ = 0.0;
      break;
    case Xblock:
      wprim->blockheight_ = 0.0;
      wprim->blockwidth_ = 0.0;
      wprim->here_ = wprim->aat;
      for (i = 0; i <= HASHLIM; i++) {
	    wprim->blockparms.vars[i]   = NULL;
	    wprim->blockparms.nvars[i]   = 0; }
      wprim->blockparms.env = NULL;
      break;
    case Xcircle:
      wprim->circlefill_ = -1.0;
      wprim->circleradius_ = 0.0;
      break;
    case Xellipse:
      wprim->ellipsefill_ = -1.0;
      wprim->ellipseheight_ = 0.0;
      wprim->ellipsewidth_ = 0.0;
      break;
    case Xline:
    case Xarrow:
    case Xmove:
    case Xarc:
    case Xspline:
      wprim->endpos_.xpos = 0.0;
      wprim->endpos_.ypos = 0.0;
      wprim->lineheight_ = 0.0;
      wprim->linewidth_ = 0.0;
      wprim->linefill_ = -1.0;
      wprim->aradius_ = mdistmax;
      wprim->lineatype_ = pahlex(0, XEMPTY);
      break;
    case Xlabel:
    case XLaTeX:
	/* blank case */
      break;
    }
}  /* newprim */

							/* Determine drawing direction at arc end */
void
arcenddir(primitive *pr)
{
  if (pr->arcangle_ > 0.0) {
    switch (pr->direction) {
    case 0: /* blank case */
	  break;
    case Xup:
	  envblock->direction = Xleft;
	  break;
    case Xdown:
	  envblock->direction = Xright;
	  break;
    case Xleft:
	  envblock->direction = Xdown;
	  break;
    case Xright:
	  envblock->direction = Xup;
	  break;
    }
    return;
  }
  switch (pr->direction) {
  case 0: /* blank case */
    break;
  case Xup:
    envblock->direction = Xright;
    break;
  case Xdown:
    envblock->direction = Xleft;
    break;
  case Xleft:
    envblock->direction = Xup;
    break;
  case Xright:
    envblock->direction = Xdown;
    break;
  }
}


#ifdef DDEBUG
primitive *(node[10001]);
int ijx;

int
scantree(primitive *p, primitive *r)
{
int j,k;
  while ( r != NULL) {
    j = 0; k = ijx;
    node[ijx] = r;
    while (j < k) { if (r==node[j]) { k = j; } else { j++; } }
    if ( j < k ) { return 0; }
    else {
      if ( scantree(p, r->nextname) == 0) { return 0; }
      if (ijx > 10000) { return 0; }
      r = r->son;
      ijx++;
      }
    }
  return 1;
  }

int
checktree( primitive *p )
{
  int ok;
  ijx = 0;
  node[ijx] = p;
  ok = scantree(p,p);
  fprintf(log_,"ok=%d ijx=%d\n",ok,ijx);
  return ok;
  }
#endif

							/* Shift a tree by (x,y) */
void
shift(primitive *pr, double x, double y)
{
#ifdef DDEBUG
  if (debuglevel > 0) { fprintf(log_,"\nshift[%d]=",ordp(pr));
    wpair(&log_, x, y); putc('\n', log_);
    snaptree(pr,0);
    fflush(log_); }
#endif
  if ((x == 0) && (y == 0)) { return; }
  while (pr != NULL) {
    pr->aat.xpos += x;
    pr->aat.ypos += y;
    if ((pr->ptype == Xspline) || (pr->ptype == Xmove) ||
	    (pr->ptype == Xarrow) || (pr->ptype == Xline)) {
	  pr->endpos_.xpos += x;
	  pr->endpos_.ypos += y; }
    if (pr->son != NULL) { shift(pr->son, x, y); }
    pr = pr->nextname;
    }
}


							/* Scale an object */
void
scaleobj(primitive *pr, double s)
{
  primitive *wprim;
  while (pr != NULL) {
    wprim = pr;
    wprim->aat.xpos *= s;
    wprim->aat.ypos *= s;
    if (wprim->ptype == Xbox) {
	  wprim->boxheight_ *= s;
	  wprim->boxwidth_ *= s;
	  wprim->boxradius_ *= s;
      }
    else if (wprim->ptype == Xblock) {
	  wprim->blockheight_ *= s;
	  wprim->blockwidth_ *= s;
      }
    else if (wprim->ptype == Xcircle) {
	  wprim->circleradius_ *= s;
      }
    else if (wprim->ptype == Xellipse) {
	  wprim->ellipseheight_ *= s;
	  wprim->ellipsewidth_ *= s;
      }
    else if (wprim->ptype == Xarc) {
	  wprim->aradius_ *= s;
      }
    else if ((wprim->ptype == Xspline) || (wprim->ptype == Xmove) ||
	       (wprim->ptype == Xarrow) || (wprim->ptype == Xline)) {
	  wprim->endpos_.xpos *= s;
	  wprim->endpos_.ypos *= s;
      }
    if (wprim->son != NULL) {
	  scaleobj(wprim->son, s);
      }
    pr = wprim->nextname;
    }
}

							/* corner(prim,<corner>,xval,yval); Put the
							   named-corner coordinates into xval,yval   */
void
corner(primitive *pr, int lexv, double *x, double *y)
{
  primitive *pe;
  boolean sb, A, B, L, R;
  if (pr == NULL) { return; }
  *x = pr->aat.xpos;
  *y = pr->aat.ypos;
  pe = pr;
  if ((lexv == XEMPTY) &&
      ((pr->ptype == Xspline) || (pr->ptype == Xmove) ||
       (pr->ptype == Xarrow) || (pr->ptype == Xline))) {
    while (pe->son != NULL) { pe = pe->son; }
    *x = 0.5 * (pr->aat.xpos + pe->endpos_.xpos);
    *y = 0.5 * (pr->aat.ypos + pe->endpos_.ypos);
    return;
    }
  if ((lexv == XEMPTY) && (pr->ptype != Xstring) && (pr->ptype != XLaTeX)) {
      return; }
  switch (pr->ptype) {
    case Xbox:
    case Xstring:
    case Xblock:
    case Xcircle:
    case Xellipse:
    case Xarc:
      *x = pr->aat.xpos;
      *y = pr->aat.ypos;
      initnesw();
      nesw(pr);
							/* Compass corners of justified strings not
							   implemented: */
		/* if ptype = Xstring then begin
         checkjust(textp,A,B,L,R);
         offst := venv(pr,Xtextoffset);
         if L then x := x+boxwidth/2 + offst
         else if R then x := x-boxwidth/2 - offst;
         if A then y := y+boxheight/2 + offst
         else if B then y := y-boxheight/2 - offst;
         end; */
      if ((pr->ptype == Xstring) && (drawmode == SVG)) {
	    switch (lexv) {
	      case Dotn: *y = north; break;
	      case Dots: *y = south; break;
	      case Dote: *x = east; break;
	      case Dotw: *x = west; break;
	      case Dotne: *y = north; *x = east; break;
	      case Dotse: *y = south; *x = east; break;
	      case Dotsw: *y = south; *x = west; break;
	      case Dotnw: *y = north; *x = west; break;
	      case Dotc: *y = pr->aat.ypos; *x = pr->aat.xpos; break;
	      case Dotstart:
	      case Dotend: markerror(858); break;
	      }
	    checkjust(pr->textp, &A, &B, &L, &R);
	    if (L) { pr->boxradius_ = (west - east) / 2; }
	    else if (R) { pr->boxradius_ = (east - west) / 2; }
        }
      else if (((pr->ptype == Xarc) || (pr->ptype == Xcircle) ||
	      (pr->ptype == Xellipse) || (pr->ptype == Xbox)) &&
	     ((lexv == Dotnw) || (lexv == Dotsw) || (lexv == Dotse) ||
	      (lexv == Dotne))) {
	    switch (pr->ptype) {
	    case Xbox:
	      *y = Min(pr->boxradius_, Min(fabs(pr->boxheight_),
		       fabs(pr->boxwidth_)) / 2) * (1 - (1 / sqrt(2.0)));
	      *x = (pr->boxwidth_ / 2) - (*y);
	      *y = (pr->boxheight_ / 2) - (*y);
	      break;
	    case Xellipse:
	      *x = pr->ellipsewidth_ * (0.5 / sqrt(2.0));
	      *y = pr->ellipseheight_ * (0.5 / sqrt(2.0));
	      break;
	    case Xarc:
	      *x = pr->aradius_ / sqrt(2.0);
	      *y = *x;
	      break;
	    case Xcircle:
	      *x = pr->circleradius_ / sqrt(2.0);
	      *y = *x;
	      break;
	    }
	    switch (lexv) {
	    case Dotne: /* blank case */ break;
	    case Dotse: *y = -*y; break;
	    case Dotnw: *x = -*x; break;
	    case Dotsw: *x = -*x; *y = -*y; break;
	    }
	    *x = pr->aat.xpos + (*x);
	    *y = pr->aat.ypos + (*y);
        }
      else if (pr->ptype == Xarc) {
	    switch (lexv) {
	    case Dotn: *y = pr->aat.ypos + pr->aradius_; break;
	    case Dots: *y = pr->aat.ypos - pr->aradius_; break;
	    case Dote: *x = pr->aat.xpos + pr->aradius_; break;
	    case Dotw: *x = pr->aat.xpos - pr->aradius_; break;
	    case Dotc: /* blank case */ break;
	    case Dotstart:
	      *x = pr->aat.xpos + (pr->aradius_ * cos(pr->startangle_));
	      *y = pr->aat.ypos + (pr->aradius_ * sin(pr->startangle_));
	      break;
	    case Dotend:
	      *x = pr->aat.xpos +
                 (pr->aradius_ * cos(pr->startangle_+pr->arcangle_));
	      *y = pr->aat.ypos +
                 (pr->aradius_ * sin(pr->startangle_+pr->arcangle_));
	      break;
	    } }
      else {
	    switch (lexv) {
	    case Dotn: *y = north; break;
	    case Dots: *y = south; break;
	    case Dote: *x = east; break;
	    case Dotw: *x = west; break;
	    case Dotne: *y = north; *x = east; break;
	    case Dotse: *y = south; *x = east; break;
	    case Dotsw: *y = south; *x = west; break;
	    case Dotnw: *y = north; *x = west; break;
	    case Dotc: *y = pr->aat.ypos; *x = pr->aat.xpos; break;
	    case Dotstart:
	    case Dotend: markerror(858); break;
	    } }
      break;

    case Xline:
    case Xarrow:
    case Xmove:
    case Xspline:
      if (lexv != Dotstart) {
	if (lexv == Dotend) {
	    while (pe->son != NULL) { pe = pe->son; }
	    *x = pe->endpos_.xpos;
	    *y = pe->endpos_.ypos; }
	else if (lexv == Dotc) {
	    while (pe->son != NULL) { pe = pe->son; }
	    *x = 0.5 * ((*x) + pe->endpos_.xpos);
	    *y = 0.5 * ((*y) + pe->endpos_.ypos); }
	else {
	    do {
		  sb = false;
		  switch (lexv) {
		  case Dotn:
		    sb = (pe->endpos_.ypos > (*y));
		    break;
		  case Dots:
		    sb = (pe->endpos_.ypos < (*y));
		    break;
		  case Dote:
		    sb = (pe->endpos_.xpos > (*x));
		    break;
		  case Dotw:
		    sb = (pe->endpos_.xpos < (*x));
		    break;
		  case Dotne:
		    sb = (((pe->endpos_.ypos > (*y)) && (pe->endpos_.xpos >= (*x))) ||
			  ((pe->endpos_.ypos >= (*y)) && (pe->endpos_.xpos > (*x))));
		    break;
		  case Dotse:
		    sb = (((pe->endpos_.ypos < (*y)) && (pe->endpos_.xpos >= (*x))) ||
			  ((pe->endpos_.ypos <= (*y)) && (pe->endpos_.xpos > (*x))));
		    break;
		  case Dotsw:
		    sb = (((pe->endpos_.ypos < (*y)) && (pe->endpos_.xpos <= (*x))) ||
			  ((pe->endpos_.ypos <= (*y)) && (pe->endpos_.xpos < (*x))));
		    break;
		  case Dotnw:
		    sb = (((pe->endpos_.ypos > (*y)) && (pe->endpos_.xpos <= (*x))) ||
			  ((pe->endpos_.ypos >= (*y)) && (pe->endpos_.xpos < (*x))));
		    break;
		  }
		  if (sb) {
		    *x = pe->endpos_.xpos;
		    *y = pe->endpos_.ypos; }
		  pe = pe->son;
	    } while (pe != NULL);
	  }
    }
    break;

  case Xlabel:
	/* blank case */
    break;

  case XLaTeX:
    markerror(858);
    break;
  }
}


							/* The nth (or nth last) enumerated object */
primitive *(
nthprimobj(primitive *primp, int nth, int objtype))
{
  primitive *prp = NULL;
  primitive *pp;
#ifdef DDEBUG
  if (debuglevel == 2) {
    fprintf(log_, "nthprimobj in [%s] nth=%d type=%d\n",
      (primp==NULL)?"NULL":"!NULL", nth, objtype);
	snaptree(primp,0); }
#endif
  if (nth == 0) { pp = primp;
    while (pp != NULL) {
	  if ((pp->ptype) == objtype) { prp = pp; }
	  pp = pp->nextname;
      }
    }
  else { pp = primp; i = 0;
    if (nth < 0) {
      while (pp != NULL) {
	    if (pp->ptype == objtype) { i++; }
	    pp = pp->nextname; }
      nth += i + 1;
      }
#ifdef DDEBUG
    if (debuglevel > 1) { fprintf(log_," nth=%d",nth); }
#endif
    pp = primp; i = 0; prp = NULL;
    while (pp != prp) {
      if (pp->ptype == objtype) { i++; }
      if (i == nth) { prp = pp; } else { pp = pp->nextname; }
      }
    }
  return prp;
  }


							/* Reset environment vars:
							   n=0: all
							   n<0: scaled variables only
							   n>0: one var given by its lexical val*/
void
resetenv(int envval, primitive *envbl)
{
  environx i, last;

  if (envbl == NULL) { return; }
  if (envval == 0) {
    envval = XXenvvar + 1;
    last = Xlastenv;
    }
  else if (envval < 0) {
    envval = XXenvvar + 1;
    last = Xlastsc;
    }
  else { last = envval; }
  if (envbl->blockparms.env == NULL) {
    envbl->blockparms.env = malloc(sizeof(envarray));
    if (envbl->blockparms.env==NULL){ fatal(9); }

#ifdef DDEBUG
    if (debuglevel > 0) {
	  fprintf(log_, "resetenv envarray[%d]\n", ordp(envbl->blockparms.env)); }
#endif
    }
  for (i = envval - 1; i <= (last - 1); i++) {
    switch (i + 1) {
							/* scaled environment vars (in) */
      case Xarcrad: envbl->blockparms.env[i - XXenvvar] = 0.25;
	    break;
      case Xarrowht: envbl->blockparms.env[i - XXenvvar] = 0.1;
	    break;
      case Xarrowwid: envbl->blockparms.env[i - XXenvvar] = 0.05;
	    break;
      case Xboxht: envbl->blockparms.env[i - XXenvvar] = 0.5;
	    break;
      case Xboxrad: envbl->blockparms.env[i - XXenvvar] = 0.0;
	    break;
      case Xboxwid: envbl->blockparms.env[i - XXenvvar] = 0.75;
	    break;
      case Xcirclerad: envbl->blockparms.env[i - XXenvvar] = 0.25;
	    break;
      case Xdashwid: envbl->blockparms.env[i - XXenvvar] = 0.05;
	    break;
      case Xellipseht: envbl->blockparms.env[i - XXenvvar] = 0.5;
	    break;
      case Xellipsewid: envbl->blockparms.env[i - XXenvvar] = 0.75;
	    break;
      case Xlineht: envbl->blockparms.env[i - XXenvvar] = 0.5;
	    break;
      case Xlinewid: envbl->blockparms.env[i - XXenvvar] = 0.5;
	    break;
      case Xmoveht: envbl->blockparms.env[i - XXenvvar] = 0.5;
	    break;
      case Xmovewid: envbl->blockparms.env[i - XXenvvar] = 0.5;
	    break;
      case Xtextht:
	    switch (drawmode) {
	      case PDF: envbl->blockparms.env[i - XXenvvar] = DFONT / 72.0;
	        break;
	      case SVG:
	        envbl->blockparms.env[i - XXenvvar] = (DFONT / 72.0) * 0.66;
	        break;
	      default:
	        envbl->blockparms.env[i - XXenvvar] = 0.0;
	        break;
	      }
	    break;
      case Xtextoffset: envbl->blockparms.env[i - XXenvvar] = 2.0 / 72;
	    break;
      case Xtextwid: envbl->blockparms.env[i - XXenvvar] = 0.0;
	    break;
							/* The following are unscaled */
      case Xarrowhead: envbl->blockparms.env[i - XXenvvar] = 1.0;
	    break;
      case Xfillval: envbl->blockparms.env[i - XXenvvar] = 0.5;
	    break;
      case Xlinethick: envbl->blockparms.env[i - XXenvvar] = 0.8;
	    break;
      case Xmaxpsht: envbl->blockparms.env[i - XXenvvar] = 11.0;
	    break;
      case Xmaxpswid: envbl->blockparms.env[i - XXenvvar] = 8.5;
	    break;
      case Xscale: envbl->blockparms.env[i - XXenvvar] = 1.0;
	    break;
      }
    }
}


							/* Copy env vars to current scope */
void
inheritenv(primitive *envbl)
{
  environx i;
  primitive *pr;

  pr = findenv(envbl);
  if (pr == NULL) { resetenv(0, envbl); return; }
  envbl->blockparms.env = malloc(sizeof(envarray));
  if (envbl->blockparms.env==NULL){ fatal(9); }
  for (i = XXenvvar; i <= (Xlastenv - 1); i++) {
      envbl->blockparms.env[i - XXenvvar] = pr->blockparms.env[i - XXenvvar];
  }
}


							/* Execute scale = x */
void
resetscale(double x, int opr, primitive *envbl)
{
  double r, s;
  int i;

  resetenv(-1, envbl);
  r = envbl->blockparms.env[Xscale - XXenvvar - 1];
  eqop(&envbl->blockparms.env[Xscale - XXenvvar - 1], opr, x);
  s = envbl->blockparms.env[Xscale - XXenvvar - 1];
  if (s == 0.0) {
      envbl->blockparms.env[Xscale - XXenvvar - 1] = r;
      s = 1.0;
      markerror(870);
  }
  else if (r == 0.0) {
      markerror(852);
  }
  else {
      s /= r;
  }
  for (i = XXenvvar; i < Xlastsc; i++) {
      eqop(&envbl->blockparms.env[i - XXenvvar], Xmulteq, s);
  }
}


							/* .PS xv yv
							   sfact = nominal scale factor set by scale = ...
							   xsc = effective scale factor to achieve correct
  							   max picture size
							   ie (size in inches)/(desired size in inches) */
void
getscale(double xv, double yv, primitive *lp, double *sfact, double *xsc)
{
  double gs = 1.0;
  int erno = 0;
  primitive *envp;

  *sfact = gs;
  if (lp != NULL) {
    if (lp->ptype == Xblock) {
	  envp = findenv(lp);
	  if (envp->blockparms.env[Xscale - XXenvvar - 1] > 0.0) {
	    *sfact = envp->blockparms.env[Xscale - XXenvvar - 1]; }
	  if ((east > west) &&
	    ((east - west) /
          (*sfact) > envp->blockparms.env[Xmaxpswid-XXenvvar-1]) &&
	    (envp->blockparms.env[Xmaxpswid - XXenvvar - 1] > 0.0)) {
	    erno = 903;
	    gs = (east - west) /
          envp->blockparms.env[Xmaxpswid - XXenvvar - 1];
	    }
	  if ((north > south) &&
	    ((north - south) /
          (*sfact)> envp->blockparms.env[Xmaxpsht-XXenvvar-1]) &&
	    (envp->blockparms.env[Xmaxpsht - XXenvvar - 1] > 0.0)) {
	    erno = 904;
	    gs = Max(gs,(north - south) /
          envp->blockparms.env[Xmaxpsht-XXenvvar-1]);
	    }
      }
    }
  if ((xv > 0.0) && (east > west)) {
    erno = 0;
    gs = (east - west) / (*sfact) / xv;
    }
  if ((yv > 0.0) && (north > south) &&
      ((xv == 0.0) || ((north - south) / gs > yv * (*sfact)))) {
    erno = 0;
    gs = (north - south) / (*sfact) / yv;
    }
  if (erno != 0) { markerror(erno); }
  *xsc = gs * (*sfact);
}

							/* Copy primitive for use by then or same */
void
copyprim(primitive *prin, primitive **prout)
{ /* Needed because assignment of variant records is unreliable */
  int i;
  if (prin == NULL) { return; }
  newprim(prout, prin->ptype, NULL);
  (*prout)->name = prin->name;
  (*prout)->textp = prin->textp;
  (*prout)->outlinep = prin->outlinep;
  (*prout)->shadedp = prin->shadedp;
  (*prout)->parent = prin->parent;
  (*prout)->son = prin->son;
  (*prout)->nextname = prin->nextname;
  (*prout)->aat = prin->aat;
  (*prout)->lparam = prin->lparam;
  (*prout)->lthick = prin->lthick;
  (*prout)->direction = prin->direction;
  (*prout)->spec = prin->spec;
  (*prout)->ptype = prin->ptype;
  switch (prin->ptype) {
  case Xbox:
  case Xstring:
    (*prout)->boxfill_ = prin->boxfill_;
    (*prout)->boxheight_ = prin->boxheight_;
    (*prout)->boxwidth_ = prin->boxwidth_;
    (*prout)->boxradius_ = prin->boxradius_;
    break;
  case Xblock:
    (*prout)->blockheight_ = prin->blockheight_;
    (*prout)->blockwidth_ = prin->blockwidth_;
    (*prout)->here_ = prin->here_;
    for (i = 0; i <= HASHLIM; i++) {
	  (*prout)->blockparms.vars[i] = prin->blockparms.vars[i];
	  (*prout)->blockparms.nvars[i] = prin->blockparms.nvars[i]; }
    if (prin->blockparms.env != NULL) {
	  (*prout)->blockparms.env = malloc(sizeof(envarray));
	  if ((*prout)->blockparms.env==NULL){ fatal(9); }
	  for (i = XXenvvar; i < Xlastenv; i++) {
	    (*prout)->blockparms.env[i - XXenvvar] =
          prin->blockparms.env[i - XXenvvar];
	    }
      }
    break;
  case Xcircle:
    (*prout)->circlefill_ = prin->circlefill_;
    (*prout)->circleradius_ = prin->circleradius_;
    break;
  case Xellipse:
    (*prout)->ellipsefill_ = prin->ellipsefill_;
    (*prout)->ellipseheight_ = prin->ellipseheight_;
    (*prout)->ellipsewidth_ = prin->ellipsewidth_;
    break;
  case Xline:
  case Xarrow:
  case Xmove:
  case Xarc:
  case Xspline:
    (*prout)->endpos_ = prin->endpos_;
    (*prout)->lineheight_ = prin->lineheight_;
    (*prout)->linewidth_ = prin->linewidth_;
    (*prout)->linefill_ = prin->linefill_;
    (*prout)->aradius_ = prin->aradius_;
    (*prout)->lineatype_ = prin->lineatype_;
    break;
  case Xlabel:
  case XLaTeX:
	/* blank case */
    break;
  }
}


							/* Delete temporary string */
void
deletestringbox(primitive **pr)
{
  primitive *prx;
  if ((*pr) == NULL) { }
  else if ((*pr)->parent == NULL) { }
  else if ((*pr)->parent->son != NULL) {
	if ((*pr)->parent->son == (*pr)) { (*pr)->parent->son = NULL; }
	else {
	  prx = (*pr)->parent->son;
	  while ((prx->nextname != NULL) && (prx->nextname != (*pr))) {
        prx = prx->nextname;}
	  prx->nextname = NULL; }
    }
#ifdef DDEBUG
    if (debuglevel > 0) {fprintf(log_, "deletestringbox tree\n"); }
#endif
  deletetree(pr);
}

void
mkOptionVars(void)
{
    makevar("dpicopt", 7, drawmode);
    if (safemode) { i = 1; } else { i = 0; }
    makevar("optsafe",      7, i);
    makevar("optMFpic",     8, MFpic);
    makevar("optMpost",     8, MPost);
    makevar("optPDF",       6, PDF);
    makevar("optPGF",       6, PGF);
    makevar("optPict2e",    9, Pict2e);
    makevar("optPS",        5, PS);
    makevar("optPSfrag",    9, PSfrag);
    makevar("optPSTricks", 11, PSTricks);
    makevar("optSVG",       6, SVG);
    makevar("optTeX",       6, TeX);
    makevar("opttTeX",      7, tTeX);
    makevar("optxfig",      7, xfig);
    if ((drawmode == SVG) || (drawmode == PDF) || (drawmode == PS)) {
	  makevar("dptextratio", 11, 0.66);
	  makevar("dpPPI",        5, 96.0);
      }
    else if (drawmode == xfig) {
	  makevar("xfigres",  7, 1200);
	  makevar("xdispres", 8, 80);
      }
}

							/* The program equivalent of var = number */
void
makevar(char *s, int ln, double varval)
{
  nametype *vn, *lastvar, *namptr;
  int j, tstval;
#ifdef DDEBUG
  if (debuglevel > 0) { fprintf(log_, "makevar chbufi=%d\n", chbufi); }
#endif
  if (chbufi+ln-1 > CHBUFSIZ) {fatal(4);}     /* This cannot happen now */
  for (j = 0; j < ln; j++) { chbuf[chbufi + j] = s[j]; }
  vn = findname(envblock, chbuf, chbufi, ln, &lastvar, &tstval);
  newstr(&vn);
  j = varhash(chbuf, chbufi, ln);
  storestring(vn, chbuf, chbufi, ln, 1);
#ifdef DDEBUG
  if (debuglevel > 1) {
    fprintf(log_, "makevar: envblock=%d eqstr val=%d\n",
      ordp(envblock), tstval);
    fprintf(log_, " lastvar=%d", ordp(lastvar));
    if (lastvar != NULL) {
	  snapname(lastvar->segmnt, lastvar->seginx, lastvar->len); }
    putc('\n', log_);
    fprintf(log_, " vn=%d\n", ordp(vn)); }
#endif
  if (lastvar == NULL) { envblock->blockparms.vars[j] = vn; }
  else if (tstval < 0) {
    if (envblock->blockparms.vars[j]->nextname == NULL) {
	  envblock->blockparms.vars[j]->nextname = vn; }
    else {
	  vn->nextname = lastvar->nextname;
	  lastvar->nextname = vn; }
    }
  else if (lastvar == envblock->blockparms.vars[j]) {
    vn->nextname = envblock->blockparms.vars[j];
    envblock->blockparms.vars[j] = vn;
    }
  else {
    namptr = envblock->blockparms.vars[j];
    while (namptr->nextname != lastvar) { namptr = namptr->nextname; }
    namptr->nextname = vn;
    vn->nextname = lastvar;
    }
  envblock->blockparms.nvars[j]++;
  vn->val = varval;
}

void                                       /* then, arc, deferred shift */
donamedobj(attribute *a1)
{
  if (a1->prim != NULL) {
	prp = a1->prim;
	while (isthen(a1->prim)) { a1->prim = a1->prim->parent; }
#ifdef DDEBUG
	if (debuglevel < 0) { fprintf(log_," donamedobj(%d):\n",ordp(a1->prim));
      if (checktree(envblock->son) == 0) {
        fprintf(errout," checktree failure ijx=%d\n",ijx);
        return; }
	  snaptree(a1->prim,0); }
#endif
	if (prp == a1->prim) { }
	else if ((a1->prim->name == NULL) && (prp->name != NULL)) {
	  a1->prim->name = prp->name;
	  prp->name = NULL; }
	if (a1->prim->ptype == Xarc) { arcenddir(prp); }
	if (teststflag(a1->state, Xat)) {    /* deferred shift */
	    wprim = a1->prim;
	    i = getstval(a1->state);
	    if (i == Xfloat) {  /* pair at */
		  getnesw(a1->prim);
		  dx = west + a1->startchop;
		  dy = south + a1->endchop;
	      }
	    else if (a1->internal != NULL) { corner(a1->internal, i, &dx, &dy); }
	    else { corner(a1->prim, i, &dx, &dy); }
	    a1->internal = NULL;
	    if ((drawmode == SVG) && (wprim->ptype == Xstring)) {
		  ts = venv(a1->prim, Xtextoffset);
		  if (teststflag(a1->state, Xcw)) {    /* shift by arg2,arg3 */
		    switch (i) {                                   /* textpos */
		      case Dote:  dx += ts; break;
		      case Dotne: dx += ts; dy += ts; break;
		      case Dotn:  dy += ts; break;
		      case Dotnw: dx -= ts; dy += ts; break;
		      case Dotw:  dx -= ts; break;
		      case Dotsw: dx -= ts; dy -= ts; break;
		      case Dots:  dy -= ts; break;
		      case Dotse: dx += ts; dy -= ts; break;
		      }
		    }
		  shift(a1->prim, a1->xval - dx, a1->yval - dy);
	      }
	    else if (wprim->ptype != Xarc) {
		  shift(a1->prim, a1->xval - dx, a1->yval - dy); }
	    else {
		  x1 = wprim->aat.xpos +
		     (wprim->aradius_ * cos(wprim->startangle_));
							/* from */
		  z1 = wprim->aat.ypos +
		     (wprim->aradius_ * sin(wprim->startangle_));
		  if (teststflag(a1->state, Xto)) {
							/* to X from Here|Y implied */
		    if ((i != XEMPTY) && (i != Dotc)) { markerror(858); }
		    r = wprim->aat.xpos + (wprim->aradius_ *
                  cos(wprim->startangle_ + wprim->arcangle_));
		    s = wprim->aat.ypos + (wprim->aradius_ *
                  sin(wprim->startangle_ + wprim->arcangle_));
		    wprim->aat.xpos = a1->xval;
		    wprim->aat.ypos = a1->yval;
		    wprim->aradius_ = linlen(r - wprim->aat.xpos, s - wprim->aat.ypos);
		    setangles(&wprim->startangle_,
			      &wprim->arcangle_, wprim->aat, x1, z1, r, s);
		    }
		  else if (teststflag(a1->state, Xfrom)) {
		    if ((i != XEMPTY) && (i != Dotc)) { markerror(858); }
		    wprim->aat.xpos = a1->xval;
		    wprim->aat.ypos = a1->yval;
		    t = datan(z1 - wprim->aat.ypos, x1 - wprim->aat.xpos);
		    r = wprim->aat.xpos + (wprim->aradius_ * cos(t + wprim->arcangle_));
		    s = wprim->aat.ypos + (wprim->aradius_ * sin(t + wprim->arcangle_));
		    wprim->aradius_ = linlen(x1 - wprim->aat.xpos,z1 - wprim->aat.ypos);
		    setangles(&wprim->startangle_, &wprim->arcangle_, wprim->aat,
               x1, z1, r, s);
			}
		  else { shift(a1->prim, a1->xval - dx, a1->yval - dy); }
	    }
	  }
    }
}

void
doundefine( attribute *a2 )
{
    macp = findmacro(macros, chbuf, a2->chbufx, a2->toklen, &lastp);
    if (macp != NULL) {
	  if (lastp != NULL) { lastp->nexta = macp->nexta; }
	  if (macp == macros) { macros = macp->nexta; }
	  disposebufs(&macp->argbody);
	  free(macp);
	  macp = NULL; }
}

							/* Stuff the body of a for loop or a macro body
							   into p2 */
void
readfor(fbuffer *p0, int attx, fbuffer **p2, Char endch, boolean isfor)
{ /* attx: -(name length)
     p0 <> nil: append the output to this buffer. */
  int j;
  int bracelevel = 1;
  fbuffer *p;
  fbuffer *p1 = NULL;
  boolean instring = false, moreinput = true;
  Char prevch = ' ';

#ifdef DDEBUG
  if (debuglevel > 0) {
    fprintf(log_, "readfor: p0");
    if (p0 == NULL) { fprintf(log_, "=nil"); } else { fprintf(log_, "<>nil");}
    fprintf(log_, " attx(");
    if (attx < 0) { fprintf(log_, "-length)="); }
    else { fprintf(log_, "attx should be -ve):"); }
    fprintf(log_, "%5d\n", attx);
    fprintf(log_, "         p2");
    if ((*p2) == NULL) { fprintf(log_, "=nil"); }
    else { fprintf(log_, "<>nil"); }
    fprintf(log_, " endch=\"%c\" ch=\"%c\"\n", endch, ch);
    }
#endif
  if (!isfor) { inchar(); }
  while (moreinput) {
    if (p0 == NULL) { newbuf(&p); } else { p = p0; p0 = NULL; }
    p->attrib = attx;                   /* -(name length) */
    if (p1 != NULL) { p1->nextb = p; p->prevb = p1; }
    p->higherb = inbuf;
    p1 = p;
    j = CHBUFSIZ;
    if (endch == '}') { do { /* lbrace ... rbrace */
	  if (ch == bslch) { skipcontinue(instring); }
	  if (instring) {  /* do not check braces in strings */
		if ((ch == '"') && (prevch != bslch)) { instring = false; }
	    }
	  else if (ch == '#') { skiptoend(); ch = nlch; }
	  else if (ch == '{') { bracelevel++; }
	  else if (ch == '}') { bracelevel--; }
	  else if (ch == '"') { instring = true; }
	  if (bracelevel <= 0) {
		moreinput = false;
		j = p1->savedlen + 1;
		ch = nlch;
	    }
	  p1->savedlen++;
	  p1->carray[p1->savedlen] = ch;
	  prevch = ch;
	  if (moreinput) { inchar(); }
	  if (inputeof) {
        if (instring) { markerror(806); } else { markerror(804); }
		j = p1->savedlen;
		moreinput = false;
	    }
	  } while (p1->savedlen != j);
      }
    else { do { /* X ... X */
	  if (ch == bslch) { skipcontinue(instring); }
	  if (instring) {
	    if ((ch == '"') && (prevch != bslch)) { instring = false; }
	    }
	  else if (ch == endch) {
        moreinput = false; j = p1->savedlen + 1; ch = nlch; }
	  else if (ch == '#') { skiptoend(); ch = nlch; }
	  else if (ch == '"') { instring = true; }
	  p1->savedlen++;
	  p1->carray[p1->savedlen] = ch;
	  prevch = ch;
	  if (moreinput) { inchar(); }
	  if (inputeof) {
        if (instring) { markerror(806); } else { markerror(804); }
	    j = p1->savedlen;
	    moreinput = false;
	    }
      } while (p1->savedlen != j);
      }
    }
  while (p1->prevb != NULL) { p1 = p1->prevb; }
  if (isfor) { backup(); }
#ifdef DDEBUG
  if (debuglevel > 0) {
      fprintf(log_, "\nreadfor done: for/macro buffer"); wrbuf(p1, 3); }
#endif
  *p2 = p1;
}

void
queueprim(primitive *pr, primitive *envblk)
{
  primitive *pp;
  if (envblk->son == NULL) { envblk->son = pr; }
  else if (tail != NULL ) { tail->nextname = pr; }
  else {
    pp = envblk->son;
    while (pp->nextname != NULL) { pp = pp->nextname; }
    pp->nextname = pr;
    }
  tail = pr;
  }


void
clearchbuf(chbufinx bi, int ln) /* Needed in the C version */
{
  int i,j;
  if ((bi+ln) == chbufi) {
    i = bi-1; j = -1;
    while (i > j) { if (chbuf[i] == '\0') { i--; } else { j = i; } }
    chbufi = i+1; }
  else { for (i=0; i<ln; i++) { chbuf[bi+i] = '\0'; } }
  }

void
dodefhead( attribute *a0 )
{
  fbuffer *macargbody;
  Char lastc;
  macp = findmacro(macros, chbuf, a0->chbufx, a0->toklen, &lastp);
  if (macp == NULL) {
	newarg(&macp);
	if (lastp == NULL) { macros = macp; } else { lastp->nexta = macp; }
    }
  disposebufs(&(macp->argbody));
  newbuf(&(macp->argbody));
  macargbody = macp->argbody;
							/* copy the macro name */
  FORLIM = a0->toklen;
  for (i = 1; i <= FORLIM; i++) {
    macargbody->carray[i] = chbuf[a0->chbufx + i - 1]; }
  macargbody->savedlen = a0->toklen;
  macargbody->readx = a0->toklen + 1;
  clearchbuf(a0->chbufx, a0->toklen);
  skipwhite();
  if (ch == '{') { lastc = '}'; } else { lastc = ch; }
							/* append the body */
  readfor(macp->argbody, -(a0->toklen), &macp->argbody, lastc, false);
  lastm = macp->argbody;
  while (lastm->nextb != NULL) { lastm = lastm->nextb; }
  lastm->carray[lastm->savedlen] = etxch;
#ifdef DDEBUG
  if (debuglevel > 1) { putc('\n', log_);
	if (currprod == 4 /* defhead1 */) { fprintf(log_, "defhead1"); }
	else { fprintf(log_, "defhead2"); }
	wrbuf(macp->argbody, 3); }
#endif
  }

                            /* Xsprintf Xlparen stringexpr Xcomma exprlist
                               Construct the sprintf result string */
primitive *(
sprintfstring( attribute *a3, attribute *a5, int nexprs ))
{
  int exprcount, substrstart, substrend, putcount, brk;
  primitive *a0prim;
  nametype *formatstr;
  Char *fsegmnt;
  int fseginx, flen, numberlen, i;
  char fmtch;
  chbufarray tmpbuf, tmpfmt;
                            /* The output string primitive */
  newprim(&a0prim, Xstring, envblock);
  newstr(&a0prim->textp);

  eb = findenv(envblock);
#ifdef DDEBUG
  if (debuglevel > 0) {
	fprintf(log_,"\nsprintf: nexprs=%d; format string:\n",nexprs);
	printobject(a3->prim); }
#endif
  a0prim->boxheight_ = eb->envinx(Xtextht);
  a0prim->boxwidth_ = eb->envinx(Xtextwid);
  exprcount = 0;
  substrstart = 0;
  substrend = 0;
  putcount = 0;
  if (a3->prim == NULL) { /* nil */ }
  else if (a3->prim->textp == NULL) { /* nil */ }
  else {  /*-- */
	formatstr = a3->prim->textp;
    fsegmnt = formatstr->segmnt;
    fseginx = formatstr->seginx;
    flen = formatstr->len;
	while (substrend < flen) {
      if (fsegmnt[fseginx + substrend] != '%') {
        substrend++;
        if (substrend == flen) {
          putcount = putstring(putcount, a0prim->textp,
            fsegmnt, fseginx + substrstart, substrend - substrstart); }
        continue;
        }
      if (fsegmnt[fseginx + substrend + 1] == '%') {   /* %% prints %*/
        putcount = putstring(putcount, a0prim->textp,
          fsegmnt, fseginx + substrstart, substrend - substrstart + 1);
        substrend += 2;
        substrstart = substrend;
        continue;
        }
      if (exprcount >= nexprs) {  /* not enough exprs */
        markerror(864); substrend = flen; continue; }
      if (substrend > substrstart) {
        putcount = putstring(putcount, a0prim->textp,
          fsegmnt, fseginx + substrstart, substrend - substrstart);
        substrstart = substrend; }
      brk = flen;
      substrend++;
      if (fsegmnt[fseginx+substrend] == '-') { substrend++; }
      while (substrend < brk) {
	    fmtch = fsegmnt[fseginx + substrend];
        if ((fmtch=='g') || (fmtch=='f') || (fmtch=='e')) { brk = substrend; }
        else if ((fmtch=='.') || isdigit(fmtch)) { substrend++; }
        else { substrend = brk; }
        }
      if (brk == flen) { markerror(865); continue; }
      substrend++;
      if (substrend - substrstart + 1 > CHBUFSIZ) {
        markerror(873); numberlen = 0; substrend = flen; }
      else {
        for (i = substrstart; i <= (substrend - 2); i++) {
          tmpfmt[i - substrstart] = fsegmnt[fseginx + i]; }
        tmpfmt[substrend - 1 - substrstart] = 'L';
        tmpfmt[substrend - substrstart] = fsegmnt[fseginx + substrend - 1];
        tmpfmt[substrend + 1 - substrstart] = '\0';
        numberlen = snprintf((char *)tmpbuf,
          CHBUFSIZ,(char *)tmpfmt, (long double) a5->xval);
	    a5++; a5++;
        }
      if (numberlen < 0) { markerror(874); substrend = flen; }
      else if (numberlen > CHBUFSIZ) {
        markerror(874); numberlen = CHBUFSIZ; substrend = flen; }
							/* Copy tmpbuf to the string */
      if (numberlen > 0) {
        putcount = putstring(putcount, a0prim->textp, tmpbuf, 0, numberlen); }
      exprcount++;
      substrstart = substrend;
	  }
    } /*  --*/
  if (nexprs > exprcount) { markerror(864); }
  if ((drawmode == xfig) && (a0prim->boxwidth_ == 0.0)) {
	if (a0prim->boxheight_ == 0.0) {
      a0prim->boxheight_ = 0.1 * eb->envinx(Xscale); }
    if (a0prim->textp != NULL) {
      a0prim->boxwidth_ = a0prim->boxheight_ * a0prim->textp->len * 0.75; }
	}
  else if ((drawmode == PDF) && (a0prim->textp != NULL)) {
	a0prim->boxwidth_ = a0prim->boxheight_ * a0prim->textp->len * 0.6; }

  if (envblock->son == a3->prim) { envblock->son = a0prim; }
  deletestringbox(&(a3->prim));

#ifdef DDEBUG
  if (debuglevel > 0) {
    fprintf(log_,"\nsprintf result: \n"); printobject(a0prim); }
#endif
  return a0prim;
}

#ifdef DDEBUG
int ordp(void *p)       { return (p==NULL)?(int) 0 : (int) abs((long)p); }
#endif
