#include "all.h"

#include <math.h>

#include "mygraph.h"   /* Prototypes for all the graph routines */
int text_def(char *ss);
int g_psarrow(double x1, double y1, double x2, double y2, int flag);
int g_arrowline(double dx, double dy, int flag);
int g_arrowpoints(double cx,double cy,double dx,double dy, double *ax1,double *ay1
	,double *ax2,double *ay2, double *nx, double *ny);
int name_join(char *a, char *b, int j);
int box_start(void);
int box_end(void);
int g_arrow(double dx, double dy);
int run_bigfile(char *ss);
#define MAXBOX 10
extern int this_line;
extern int trace_on;
static char *box_name[MAXBOX];
static double box_y1[MAXBOX], box_x1[MAXBOX], box_y2[MAXBOX], box_x2[MAXBOX];
static int box_nobox[MAXBOX];
static long box_fill[MAXBOX];
static double box_add[MAXBOX];
static int path_clip[4],path_stroke[4];
static long path_fill[4];
static double path_x[4],path_y[4];
static int npath,nbox;
int done_open;
#define true (!false)
#define false 0
/*---------------------------------------------------------------------------*/
/* gle FILE io stuff.  (fopen fclose fread fwrite) */
#define F_MAXCHAN 5
static int f_end[F_MAXCHAN];
static char *f_buff[F_MAXCHAN];
static FILE *f_chan[F_MAXCHAN];
static int f_read[F_MAXCHAN];
static char *f_nexttok[F_MAXCHAN];
int f_getchan(void);
void f_readahead(int chn);
int f_testchan(int chn);
void siffree(char **s);
void f_getline(int chn);
char *f_gettok(int chn);
static int chn;
int f_eof(int chn);
char *f_getnext(int chn);
/*---------------------------------------------------------------------------*/
/* pos=   Offset to find the data			*/
/* idx=   For switches, which can only have one value. 	*/
/* The pos is the order the items will be placed in the pcode */
/*
/* Switches 	long 	placed in directly, 1 present, 0 not present
/* expressions 	LONG* 	pointed to, 0 if not present.
/* color/fill	LONG* 	Pointer to exp 0 if not present.
/* marker	LONG*	Pointer to exp 0 if not present.
/* lstyle 	LONG*	Pointer to exp 0 if not present.
/* font 	long* 	Pointer to string expression.
*/

extern char *mainkey[];
extern int gle_debug;
int can_fillpath;
int init_run_done;

#define readval(x) eval(pcode,&cp,&x,ostr,&otyp)
#define readxy(x,y) {eval(pcode,&cp,&x,ostr,&otyp);eval(pcode,&cp,&y,ostr,&otyp);}
#define readstr(s) eval(pcode,&cp,&x,s,&otyp)
#define readlong(i) i = *(pcode+cp++)
#define readvalp(x,p) {zzcp=0; eval(p,&zzcp,&x,ostr,&otyp);}
#define dbg if ((gle_debug & 16)>0)
static int for_level,for_skip,for_loop,if_findelse,if_findendif,if_level;
for_init()
{
	for_loop = 0;
	for_level = 0;
	for_skip = 0;
	if_findelse = 0;
	if_findendif = 0;
	if_level = 0;
}
/*---------------------------------------------------------------------------*/
/* Input is pcode, output is text equiv.*/
do_pcode(int *srclin, long *pcode, int plen, int *pend)
/* srclin = The source line number */
/* pcode =  a pointer to the pcode output buffer */
/* plne =   a pointer to the length of the pcode output */
{
	double oval;
	union {double d; long l; long ll[2];} both;
	int otyp,cp=0,i,zzcp;
	static double loopstep[30];
	static int loopadr[30],nloop;
	double lll,rrr,uuu,ddd;
	char ostr[255];
	char *pss;
	char *zzz;
	int p;
	union ppboth {long l; short s[2];} bth;
	double x,y,sx,sy,ox,oy,x1,y1,x2,y2,x3,y3,a1,a2,r,z;
	int t,j,jj,ptr,ptr_fill,mask_just,mask_nostroke,marrow;
	static char ss[255],ss2[80];


	if (!init_run_done) {
		init_run_done = true;
		g_get_type(ss);
		if (strstr(ss,"FILLPATH")!=NULL) can_fillpath = true;
	}

	this_line = *srclin;
	/* dbg gprint("Gle debug %d \n ",gle_debug);
	dbg gprint("PP> ");
	dbg for (i=0; i<plen; i++) {
		bth.l = *(pcode+i);
		dbg gprint("%ld  ",bth.l);
	}
	dbg gprint("\n");
	dbg gprint("HEX> ");
	dbg for (i=0; i<plen; i++) {
		bth.l = *(pcode+i);
		dbg gprint("%lx  ",bth.l);
	}
	dbg gprint("\n");
	*/
	if (plen==0) return;
	if (*(pcode)==0) return;
	p = *(pcode+((cp)++));
	cmd_name(p,&pss);
	dbg gprint("Command %d {%s} \n",p,pss);
	sprintf(ss,"Command %d {%s} \n",p,pss);
	g_source(ss);
	if (if_findelse) {
		dbg gprint("SKIP in skip findelse \n");
		switch (p) {
			case 13 : /* else */
				if (if_level==0) {
					if_findelse = false;
				}
				break;
			case 14 : /* end xxx */
				readlong(jj);
				if (jj==6) { /* end if */
					if (if_level==0) {
						if_findelse = false;
					} else if_level--;
				}
				break;
			case 22 : /* if */
				if_level++;
				break;
		}
		return;
	}
	if (if_findendif) {
		dbg gprint("SKIP, findendif \n");
		switch (p) {
			case 14 : /* end xxx */
				readlong(jj);
				if (jj==6) { /* end if */
					if (if_level==0) {
						if_findendif = false;
					} else if_level--;
				} else gprint("Wrong end %d \n",jj);
				break;
			case 22 : /* if */
				if_level++;
				break;
		}
		return;
	}
	if (for_skip ) {
		switch (p) {
			case 47: /* until */
			case 18 : /* for */
				for_level++;
				break;
			case 30 : /* next */
				if (for_level==0) {
					for_skip = false;
				} else for_level--;
				break;
		}
		return;
	}
	if (!done_open) {
		if (p!=42 && p!=53 && p!=0) {
			gprint("No SIZE command at top of graph, assuming 10cm by 10cm\n");
			g_open(10.0,10.0);
			done_open = true;
			return;
		}
	}
	switch (p) {
	  case 53: /* comment */
	  case 0: /* blank line */
		break;
	  case 1:  /* ALINE x y ARROW both | start | end */
		readval(x);
		readval(y);
		dbg gprint("x=%f, y=%f \n",x,y);
		marrow = *(pcode + (cp++));
		dbg gprint("arrow mask %d \n",marrow);
		g_arrowline(x,y,marrow);
		break;
	  case 2:  /* AMOVE */
		readval(x);
		readval(y);
		g_move(x,y);
		break;
	  case 3: /* ARC */
		readval(r);
		readxy(a1,a2);
		g_get_xy(&ox,&oy);
		g_arc(r,a1,a2,ox,oy);
		break;
	  case 4: /* ARCTO */
		readxy(x1,y1);
		readxy(x2,y2);
		readval(r);
		g_get_xy(&ox,&oy);
		g_arcto(x1+ox,y1+oy,x2+ox+x1,y2+oy+y1,r);
		break;
	  case 51: /* Assignment  var=exp */
		readlong(jj);
		readval(x);
		if (otyp==1) var_set(jj,x);
		if (otyp==2) var_setstr(jj,ostr);
		break;
	  case 5:  /* BEGIN box | path | scale | rotate | EXTERNAL */
		g_flush();
		i = *(pcode + cp++);
		dbg gprint(" begin %d \n",i);
		switch (i) {
			case 1: /* PATH stroke fill clip */
				npath++;
				g_get_xy(&path_x[npath],&path_y[npath]);
				path_stroke[npath] = *(pcode + cp);
				ptr = *(pcode + ++cp);
				path_fill[npath] = 0;
				if (ptr) {
					readvalp(z,pcode+cp+ptr);
					memcpy(&path_fill[npath],&z,4);
				}
				path_clip[npath] = *(pcode + ++cp);
				g_set_path(true);
				g_newpath();
				break;
			case 2: /* BOX   add,fill,nobox,name */
				box_start();
				ptr = *(pcode + cp);
				if (ptr) readvalp(box_add[nbox],pcode+cp+ptr);
				ptr = *(pcode + ++cp);
				if (ptr) {
					readvalp(z,pcode+cp+ptr);
					memcpy(&box_fill[nbox],&z,4);
				}
				box_nobox[nbox] = *(pcode + ++cp);
				ptr = *(pcode + ++cp);
				if (ptr) {
					readvalp(z,pcode+cp+ptr);
					box_name[nbox] = sdup(ostr);
				}
				break;
			case 3: /* SCALE */
				readxy(x,y);
				g_gsave();
				g_scale(x,y);
				break;
			case 4: /* ROTATE */
				readval(x);
				g_gsave();
				g_rotate(x);
				break;
			case 5: /* TRANSLATE */
				readval(x); readval(y);
				g_gsave();
				g_translate(x,y);
				g_rmove(0.0,0.0);
				break;
			case 6: /* if */
			case 7: /* sub */
				gprint("odd begin %d\n",i);
				break;
			case 8: /* name */
				box_start();
				box_nobox[nbox] = true;
				readval(z);
				box_name[nbox] = sdup(ostr);
				break;
			case 9: /* text */
				ptr = *(pcode + cp);
				z = 0;
				if (ptr) readvalp(z,pcode+cp+ptr);
				begin_text(srclin,pcode,&cp,z);
				break;
			case 18: /* tab  (tabbing, table) */
				begin_tab(srclin,pcode,&cp);
				break;
			case 10: /* graph */
				begin_graph(srclin,pcode,&cp);
				break;
			case 11: /* xaxis */
			case 12: /* yaxis */
			case 13: /* x2axis */
			case 14: /* y2axis */
				break;
			case 16: /* KEY */
				begin_key(srclin,pcode,&cp);
				break;
			case 19: /* begin  clip */
				g_beginclip();
				break;
			case 17: /* ORIGIN */
				g_gsave();
				g_get_xy(&x,&y);
				g_translate(x,y);
				g_move(0.0,0.0);
				break;
			default: /* error  */
				gprint("Error, illegal begin option %d \n",i);
				break;
		}
		break;
	  case 6: /* BEZIER */
		readxy(x1,y1);
		readxy(x2,y2);
		readxy(x3,y3);
		g_bezier(x1,y1,x2,y2,x3,y3);
		break;
	  case 7:  /* BOX x y left|center|right FILL fexp NAME string */
		readval(x);
		readval(y);
		g_get_xy(&ox,&oy);
		x += ox;
		y += oy;
		dbg gprint("x=%f, y=%f \n",x,y);
		mask_just = *(pcode + cp++);
		g_dojust(&ox,&oy,&x,&y,mask_just);

		mask_nostroke = *(pcode + cp);
		ptr_fill = *(pcode + ++cp);
		if (ptr_fill) {
			readvalp(z,pcode + cp + ptr_fill);
			memcpy(&both.d,&z,sizeof(z));
			g_set_fill(both.l);
			g_box_fill(ox,oy,x,y);
		}
		if (!mask_nostroke)
			g_box_stroke(ox,oy,x,y);
		ptr = *(pcode + ++cp); /* name */
		if (ptr) {
			readvalp(z,pcode + cp + ptr);
			name_set(ostr,ox,oy,x,y);
		}
		dbg gprint("justify mask %d ",mask_just);
		dbg gprint("nostroke mask %d ",mask_nostroke);
		dbg gprint("fill pointer %d \n",ptr_fill);
		break;
	  case 52:  /* CALL or @   (nope, do this inside ASSIGN */
		readval(r);
		break;
	  case 8:  /* CIRCLE */
		readval(r);
		g_get_xy(&ox,&oy);
		sx = ox; sy = oy;
		mask_just = *(pcode + cp++);
		x = ox + r;
		y = oy + r;
		g_dojust(&ox,&oy,&x,&y,mask_just);
		g_move(ox,oy);
		mask_nostroke = *(pcode + cp++);
		ptr_fill = *(pcode + cp);
		if (ptr_fill) {
			readvalp(z,pcode + cp + ptr_fill);
			memcpy(&both.l,&z,4);
			g_set_fill(both.l);
			g_circle_fill(r);
		}
		if (!mask_nostroke)
			g_circle_stroke(r);
		g_move(sx,sy);
		break;
	  case 9: /* CLOSEPATH */
		g_closepath();
		break;
	  case 10: /* CURVE  x y x y ...  change to BEGIN CURVE ... END CURVE */
		g_curve(pcode+cp);
		break;
	  case 11: /* DEFINE  MARKER name  subname */
		break;
	  case 12: /* DFONT */
		readstr(ss);
		g_dfont(ss);
		break;
	  case 13: /* ELSE */
		if_findendif = true;
		break;
	  case 14: /* END */
		readlong(jj);
		switch (jj) {
		  case 1: /* end path  (stroke,fill,clip) */
			if (path_fill[npath]!=0) {
				g_set_fill(path_fill[npath]);
				g_fill();
			}
			if (path_stroke[npath]==true) g_stroke();
			if (path_clip[npath]==true) g_clip();
			if (npath==0) {
				gprint("Too many end path's \n");
				break;
			}
			g_move(path_x[npath],path_y[npath]);
			npath--;
			g_set_path(false);
			break;
		  case 2: /* end box */
			box_end();
			break;
		  case 3: /* end scale */
		  case 4: /* end rotate */
		  case 5: /* end translate */
			g_grestore();
			break;
		  case 6: /* end if */
			/* do nothing,  all done elsewhere I think?? */
			break;
		  case 8: /* end name */
			box_end();
			break;
		  case 19: /* clip */
			g_endclip();
			break;
		  case 18: /* tab */
		  case 9: /* text */
			break;
		  case 17: /* end origin */
			g_grestore();
			break;
	 	  default :
			gprint("Not a valid end %d \n",jj);
		}
		break;
	  case 15: /* FCLOSE */
		readval(x);
		chn = x;
		chn = f_testchan(chn);
		if (f_chan[chn]!=NULL) fclose(f_chan[chn]);
		f_chan[chn] = NULL;
		siffree(&f_buff[chn]);
		siffree(&f_nexttok[chn]);
		f_buff[chn] = NULL;
		break;
	  case 16: /* FILL */
		g_fill();
		break;
	  case 61 : /* fread CHAN a$ x   */
	  case 62 : /* freadln */
		readlong(t);
		if (t!=49) gprint("FREAD, PCODE ERROR, %d  cp %d plen %d\n",t,cp,plen);
		readlong(i);
		readlong(t);
		var_get(i,&x);
		chn = x;
		chn = f_testchan(chn);
		if (p==61 && cp>=plen) gprint("FREAD requires at least two parameters\n");
		while (cp<plen) {
			readlong(t);
			if (t!=49) gprint("FREAD2, PCODE ERROR, %d  cp %d plen %d\n",t,cp,plen);
			readlong(i); /* variable number */
			readlong(t); /* type of variable */
			if (t==1) {
				x = atof(f_gettok(chn));
				var_set(i,x);
			} else {
				var_setstr(i,f_gettok(chn));
			}
		}
		if (p==62) f_getline(chn);
		break;
	  case 63 : /* fwrite */
	  case 64 : /* fwriteln */
		strcpy(ss2,"");
		readlong(t);
		readlong(t);
		readval(x);
		chn = x;
		chn = f_testchan(chn);
		if (f_read[chn]==0) gprint("You cannot WRITE from a file open for READ {#%d %d} \n",chn,f_read[chn]);
		while (cp<plen) {
			readlong(t);
			if (t!=49) gprint("WRITE, PCODE ERROR, %d  cp %d plen %d\n",t,cp,plen);
			readlong(t);
			if (t==1) {
				readval(x);
				sprintf(ss,"%g ",x);
			} else readstr(ss);
			strcat(ss2,ss);
		}
		if (p==64) strcat(ss2,"\n");
		fprintf(f_chan[chn],"%s",ss2);
		break;
	  case 17: /* FOPEN "a.a" inchan read|write */
		readstr(ss);
		readlong(i); /* channel variable */
		readlong(jj); /* 0 = read, 1 = write */
		chn = f_getchan();
		f_read[chn] = jj;	
		var_set(i,chn);
		if (f_chan[chn]!=NULL) fclose(f_chan[chn]);
		if (jj==0) f_chan[chn] = fopen(ss,"r");
		else 	f_chan[chn] = fopen(ss,"w");
		if (f_chan[chn]==NULL) gprint("Can't open {%s}  \n",
			ss);
		dbg gprint("Opened {%s} chan %d, access %d  vari %d \n",ss,chn,jj,i);
		f_end[chn] = false;
		if (f_read[chn]==0) f_readahead(chn);
		break;
	  case 18: /* FOR   v,exp,exp,op,exp */
		if (for_loop) {
			readlong(jj);
			readval(x);
			readval(y);
			var_get(jj,&x);
			x = x + loopstep[nloop];
			var_set(jj,x);
			var_get(jj,&x);
			dbg gprint("got back %f \n",x);
			if ( (x > y  && loopstep[nloop]>=0) ||
			     (y > x  && loopstep[nloop]<=0) ) {
				for_skip = true;
				nloop--;
			}
			for_loop = false;
			break;
		}
		loopadr[++nloop] = *srclin;
		readlong(jj);	  /* variable */
		readval(x);
		readval(y);
		var_set(jj,x);
		loopstep[nloop] = 1;
		p = *(pcode + cp);
		if (p) {
			readvalp(z,pcode + cp + p);
			loopstep[nloop] = z;
		}
		break;
	  case 19: /* GOTO */
	  case 20: /* GSAVE */
		g_gsave();
		break;
	  case 54: /* GRESTORE */
		g_grestore();
		break;
	  case 21: /* ICON */
		break;
	  case 22: /* IF EXP */
		readval(x);
		dbg gprint("If expression = %f \n",x);
		if (x==0) if_findelse = true;	/* exp was false */
		break;
	  case 23: /* INCLUDE (done in pass,  already included) */
		break;
	  case 24: /* INPUT */
	  case 25: /* JOIN  str1,type,str2 */
		{
			char ss1[90];
			readval(z);
			strcpy(ss1,ostr);
			readlong(jj);
			readval(z);
			name_join(ss1,ostr,(int) jj);
		}
		break;
	  case 26: /* MARKER */
		readval(x);
		memcpy(&both.d,&x,sizeof(x));
		jj = both.l;
		g_get_hei(&z);
		y = 1;
		if (*(pcode+cp)!=0) readval(y);
		y = y * z;
		g_marker((int) both.l,y);
		break;
	  case 27: /* MOVE  name */
		readval(z);
		name_get(ostr,&ox,&oy,&x,&y);
		x = ox;
		y = oy;
		g_dojust(&ox,&oy,&x,&y,jj);
		g_move(x+(x-ox),y+(y-oy));
		break;
	  case 28: /* NARC */
		readval(r);
		readxy(a1,a2);
		g_get_xy(&ox,&oy);
		g_narc(r,a1,a2,ox,oy);
		break;
	  case 29: /* NEWPATH */
		g_newpath();
		break;
	  case 30:  /* NEXT */
		if (nloop==0) {
			gprint("Next without for\n");
			break;
		}
		*srclin = loopadr[nloop]-1;
		dbg gprint("%FOR   Setting line back to %d  nloop %d \n ",*srclin,nloop);
		for_loop = true;
		break;
	  case 31: /* PIE ,, not implemented yet */
		break;
	  case 57: /* plotter fonts */
		plotter_fonts();
		break;
	  case 58: /* bigfile "filename" */
		readstr(ss);
		strlwr(ss);		/* bit of a kludge but ... */
		run_bigfile(ss);
		break;
	  case 55: /* Postscrip fiename x y */
		readstr(ss);
	        strlwr(ss);
		readxy(x1,y1);
		g_postscript(ss,x1,y1);
		break;
	  case 32: /* PRINT */
		break;
	  case 33: /* RBEZIER */
		readxy(x1,y1);
		readxy(x2,y2);
		readxy(x3,y3);
		g_get_xy(&ox,&oy);
		x1 += ox;  x2 += ox;  x3 += ox;
		y1 += oy;  y2 += oy;  y3 += oy;
		g_bezier(x1,y1,x2,y2,x3,y3);
		break;
	  case 34: /* REGION */
		break;
	  case 50: /* RETURN exp */
		readval(x);
		sub_set_return(x);
		break;
	  case 35: /* REVERSE */
		g_reverse();
		break;
	  case 36:  /* RLINE */
		readval(x);
		readval(y);
		g_get_xy(&ox,&oy);
		marrow = *(pcode + (cp++));
		dbg gprint("RLINE getxy %f %f \n",ox,oy);
		g_arrowline(x+ox,y+oy,marrow);
		break;
	  case 37:  /* RMOVE */
		readval(x);
		readval(y);
		g_get_xy(&ox,&oy);
		g_move(x+ox,y+oy);
		break;
	  case 38: /* ROTATE */
		readval(x);
		g_rotate(x);
		break;
	  case 39: /* SAVE  name */
		g_get_xy(&x,&y);
		readval(z);
		name_set(ostr,x,y,x,y);
		break;
	  case 40: /* SCALE */
		readxy(x,y);
		g_scale(x,y);
		break;
	  case 41: /* SET */
		for (i=1;i<plen;i++) {
		cp = i+1;
		dbg gprint("set sub command %d \n",(*(pcode+i)-500));
		switch (*(pcode+i)-500) {
		/* FIDDLE CP SO THAT READVAL WORKS *** */
		  case 1: /* height */
			readval(x);
			g_set_hei(x);
			break;
		  case 2: /* font */
			readval(x);
			memcpy(&both.l,&x,4);
			g_set_font(both.l);
			break;
		  case 3: /* justify */
			readlong(jj);
			g_set_just(jj);
			break;
		  case 4: /* color */
			readval(x);
			memcpy(&both.l,&x,4);
			g_set_color(both.l);
			break;
		  case 5: /* dashlen */
			readval(x);
			g_set_line_styled(x);
			break;
		  case 6: /* dash */
			readval(x);
			i = x;
			sprintf(ss,"%d",i);
			g_set_line_style(ss);
			break;
		  case 7: /* lwidth */
			readval(x);
			g_set_line_width(x);
			break;
		  case 10: /* fontlwidth */
			readval(x);
			g_set_font_width(x);
			break;
		  case 8: /* join */
			readlong(jj);
			g_set_line_join(jj);
			break;
		  case 9: /* cap */
			readlong(jj);
			g_set_line_cap(jj);
			break;
		  default :
			gprint("Not a valid set sub command {%d} i=%d \n",*(pcode+i),i);
		  }
		i = cp-1;
		}
		break;
	  case 42: /* size x y [box]*/
		readxy(x,y);
		g_open(x,y);
		g_get_xy(&ox,&oy);
		done_open = true;
		mask_just = *(pcode + cp++);
		if (mask_just) { /* then draw box */
			g_box_stroke(ox,oy,x,y);
		}
		break;
	  case 43: /* STROKE */
		g_stroke();
		break;
	  case 44: /* SUB */
		readlong(jj);
		sub_get_startend(jj,&i,&j);
		*srclin = j;	/* skip past the subroutine */
		break;
	  case 45: /* TEXT */
		strcpy(ss,(char *) (pcode+cp));
	/*	readstr(ss); */
		g_text(ss);
		g_get_bounds(&x1,&y1,&x2,&y2);

		break;
	  case 60: /* DEFMARKER */
		break;
	  case 59: /* TEXTDEF */
		strcpy(ss,(char *) (pcode+cp));
		text_def(ss);
		break;
	  case 46: /* TRANSLATE */
		readxy(x,y);
		g_translate(x,y);
		break;
	  case 47: /* UNTIL */
		readval(x);
		if (!for_loop) loopadr[++nloop] = *srclin;
		for_loop = true;
		if (x) {for_skip = true; for_loop = false;}
		break;
	  case 48: /* WHILE */
		break;
	  case 49: /* WRITE */
		g_get_xy(&ox,&oy); 
		strcpy(ss2,"");
		while (cp<plen) {
			readlong(t);
			if (t!=49) gprint("WRITE, PCODE ERROR, %d  cp %d plen %d\n",t,cp,plen);
			readlong(t);
			if (t==1) {
				readval(x);
				sprintf(ss,"%g ",x);
			} else readstr(ss);
			strcat(ss2,ss);
		}
		g_text(ss2);
		g_move(ox,oy); 
		break;
	  default :
		gprint("Not a recognized command \n");
	}
	*pend = cp;
}
/* should be in core.c */
g_arrowline(double x2, double y2, int flag)
{
	double x1,y1;
	if ((flag&3)==0) {
		g_line(x2,y2);
		return;
	}
	g_get_xy(&x1,&y1);
	if (!can_fillpath) {
		if (flag & 1)  g_arrow(x2-x1,y2-y1);
		g_line(x2,y2);
		if (flag & 2)  g_arrow(x1-x2,y1-y2);
		return;
	}
	g_psarrow(x1,y1,x2,y2,flag);
}
g_psarrow(double x1, double y1, double x2, double y2, int flag)
{
	double ax1,ax2,ay1,ay2,dx,dy,nx,ny,nnx,nny,xx2,yy2;
	long cur_color;
	xx2 = x2; yy2 = y2;
	dx = x2-x1;  dy = y2-y1;
	g_arrowpoints(x1,y1,dx,dy,&ax1,&ay1,&ax2,&ay2,&nx,&ny);
	g_set_path(true);
	g_newpath();
	if ((flag & 1)>0) {
		g_move(ax2,ay2);
		g_line(x1,y1);
		g_line(ax1,ay1);
		g_closepath();
		x1 = nx; y1 = ny;
	}
 	g_arrowpoints(x2,y2,-dx,-dy,&ax1,&ay1,&ax2,&ay2,&nx,&ny);
	if ((flag & 2)>0) {
		g_move(ax2,ay2);
		g_line(x2,y2);
		g_line(ax1,ay1);
		g_closepath();
		xx2 = nx; yy2 = ny;
	}
	g_get_color(&cur_color);
	g_set_fill(cur_color);
	g_fill();
	g_set_path(false);
	g_newpath();
	g_move(x1,y1);
	g_line(xx2,yy2);
	g_move(x2,y2);
}
g_arrowpoints(double cx,double cy,double dx,double dy, double *ax1,
	double *ay1,double *ax2,double *ay2, double *nnx, double *nny)
{
	double radius,angle,alen,nx,ny,width,arrow_angle;
	g_get_line_width(&width);
	if (width==0) width = .02;
	arrow_angle = 10;
	if (width>.1) arrow_angle = 20;
	if (width>.3) arrow_angle = 30;
	g_get_hei(&alen);  alen = alen/2;
	if (sin(arrow_angle*3.14159/180)*alen < width/1.5) {
		alen = (width/1.5) / sin(arrow_angle*3.141592/180);
	}
	xy_polar(dx,dy,&radius,&angle);
	if (radius<0) alen = -alen;
	polar_xy(alen,angle+arrow_angle,&dx,&dy);
	*ax2 = cx+dx;  *ay2 = cy+dy;
	polar_xy(alen,angle-arrow_angle,&dx,&dy);
	*ax1 = cx+dx;  *ay1 = cy+dy;

	polar_xy(alen*cos(arrow_angle*3.141592/180),angle,&nx,&ny);
	alen = width/2;
	if (radius<0) alen = -alen;

	cx += nx; cy += ny;
	*nnx = cx; *nny = cy;
}
g_arrow(double dx, double dy)
{
	double cx,cy,radius,angle,alen;
	g_get_xy(&cx,&cy);
	xy_polar(dx,dy,&radius,&angle);
	g_get_hei(&alen);  alen = alen/2;
	if (radius<0) alen = -alen;
	polar_xy(alen,angle+10.0,&dx,&dy);
	g_line(cx+dx,cy+dy);
	g_move(cx,cy);
	polar_xy(alen,angle-10.0,&dx,&dy);
	g_line(cx+dx,cy+dy);
	g_move(cx,cy);
}

box_start(void)
{
	g_get_bounds(&box_x1[nbox],&box_y1[nbox],&box_x2[nbox],&box_y2[nbox]);
	g_init_bounds();
	nbox++;
	box_add[nbox]=0;
	box_fill[nbox] = 0;
	box_name[nbox] = 0;
}
box_end(void)
{
	double x1,y1,x2,y2,ox,oy;
	if (nbox==0) {
		gprint("Too many end boxes \n");
		return;
	}
	g_get_bounds(&x1,&y1,&x2,&y2);
	if (x1>(x2+100)) return;
	x1 -= box_add[nbox];	y1 -= box_add[nbox];
	x2 += box_add[nbox];	y2 += box_add[nbox];
	g_get_xy(&ox,&oy);
	if (box_fill[nbox]!=0) {
		g_set_fill(box_fill[nbox]);
		g_box_fill(x1,y1,x2,y2);
	}
	if (!box_nobox[nbox]) {
		g_box_stroke(x1,y1,x2,y2);
	}
	if (box_name[nbox]!=0) {
		name_set(box_name[nbox],x1,y1,x2,y2);
		myfree(box_name[nbox]);
	}
	nbox--;
	if (box_x1[nbox] <= box_x2[nbox]) {
		g_set_bounds(box_x1[nbox],box_y1[nbox]);
		g_set_bounds(box_x2[nbox],box_y2[nbox]);
	}
	g_move(ox,oy);
}
int nm_adjust(int jj,double *sx, double *sy, double ex, double ey,
	double x1, double y1, double x2, double y2);
int nm_point(int jj,double *rx, double *ry, double x1,double y1,double x2,double y2);
int nm_split(char *s, char *n, char *p);
name_join(char *o1,char *o2,int marrow)
{
	char n1[40],n2[40],p1[9],p2[9],*ss;
	double ox,oy,sx,sy,ex,ey,x,y,x1,y1,x2,y2,x3,y3,x4,y4;
	int i,jj1,jj2;

	strupr(o1);	strupr(o2);
	if (strstr(o1,".H")!=0 || strstr(o1,".V")!=0) {
		ss = o1; o1 = o2; o2 = ss;
		if (marrow==2) marrow = 1;
		else if (marrow==1) marrow = 2;
	}
	nm_split(o1,n1,p1);
	nm_split(o2,n2,p2);

	x1 = 1e30; x3 = 1e30;
	name_get(n1,&x1,&y1,&x2,&y2);
	name_get(n2,&x3,&y3,&x4,&y4);
	if (x1==1e30 || x3 == 1e30) return;
	jj1 = pass_justify(p1);
	jj2 = pass_justify(p2);

	nm_point(jj1,&sx,&sy,x1,y1,x2,y2);
	ex = sx; ey = sy;
	nm_point(jj2,&ex,&ey,x3,y3,x4,y4);

	nm_adjust(jj1,&sx,&sy,ex,ey,x1,y1,x2,y2);
	nm_adjust(jj2,&ex,&ey,sx,sy,x3,y3,x4,y4);

	g_get_xy(&ox,&oy);
	g_move(sx,sy);
	if (marrow==2) marrow = 1;
	else if (marrow==1) marrow = 2;
	g_arrowline(ex,ey,marrow);

/* 	g_line(ex,ey);
	x = ex-sx;
	y = ey-sy;
	if (x!=0 || y!=0) {
		if (marrow & 1)  g_arrow(-x,-y);
		g_move(sx,sy);
		if (marrow & 2)  g_arrow(x,y);
		g_move(ox,oy);


	}

*/
}
nm_point(int jj,double *rx, double *ry, double x1,double y1,double x2,double y2)
{
	int jx,jy;
	double w,y,d;

	if ((jj == 0x2000)) { /* virtical */
		if (y2<*ry) *ry = y2;
		if (y1>*ry) *ry = y1;
		return;
	}
	if ((jj == 0x3000)) { /* horizontal centre   */
		if (x2<*rx) *rx = x2;
		if (x1>*rx) *rx = x1;
		return;
	}
	jx = (jj & 0xf0) / 16;
	jy = jj & 0x0f;
	d = jx * (x2-x1)/2;
	*rx = x1 + d;
	d = jy * (y2-y1)/2;
	*ry = y1 + d;
}
nm_adjust(int jj,double *sx, double *sy, double ex, double ey,
	double x1, double y1, double x2, double y2)
{
	double r1,r2,xa,da,ca,dr,dx,dy,pi,rz,r;
	pi = 3.1415925;
	if ((jj & 0xf000)==0x5000) {
		r1 = (x2-x1)/2;
		r2 = (y2-y1)/2;
			xy_polar(*sx - ex,*sy - ey,&dr,&da);
		xa = da - 180;
xxxa:		if (xa > 180) xa = xa - 180;
		if (xa < 0) xa = xa + 180;
		if ((xa<0) || (xa> 180)) goto xxxa;
		if (r1==0) return;
		ca = atan(r2/r1)*180/pi;
		if (xa < 90) {
			rz = r1/cos(pi*xa/180);
			if (xa>ca) rz = r2/sin(pi*xa/180);
		} else {
			xa = xa - 90;
			rz = r2/cos(pi*xa/180);
			if (xa>(90-ca)) rz = r1/sin(pi*xa/180);
		}
		dr = dr - rz ;
		polar_xy(dr,da,&dx,&dy);
		*sx = ex + dx;
		*sy = ey + dy;
	}
	if ((jj & 0xff00)==0x1000) {
		r = (x2-x1)/2;
		xy_polar(*sx-ex,*sy-ey,&dr,&da);
		dr = dr - r;
		polar_xy(dr,da,&dx,&dy);
		*sx = ex + dx;
		*sy = ey + dy;
	}
}
nm_split(char *s, char *n, char *p)
{
	char *d;
	d = strchr(s,'.');
	if (d!=0) {
		ncpy(n,s,d-s);
		strcpy(p,d+1);
	} else {
		strcpy(n,s);
		strcpy(p,"BO");
	}
}

int f_getchan(void)
{
	int i;
	for (i=0; i<F_MAXCHAN; i++) {
		if (f_chan[i]==NULL) {
			return i;
		}
	}
	gprint("Fatal error, ran out of file handles, don't open so many\n");
	return 0;
}
void f_getline(int chn)
{
	char buff[1002];
	if (f_chan[chn]==NULL) {return;}
	if (f_read[chn]!=0) gprint("You cannot read from a file open for WRITe #%d %d \n",chn,f_read[chn]);
	if (fgets(buff,1000,f_chan[chn])==NULL) {
		f_end[chn] = true;
	}
	if (feof(f_chan[chn])) f_end[chn] = true;
	if (f_buff[chn]!=NULL) myfree(f_buff[chn]);
	f_buff[chn] = sdup(buff);
}
int f_eof(int chn)
{
	return f_end[chn];
}
char *f_gettok(int chn)
{
	static char thistok[80];
	if (f_end[chn]) gprint("Reading past end of file %d\n",chn);
	strcpy(thistok,f_nexttok[chn]);
	f_readahead(chn);
	return thistok;
}
void f_init()
{
	int i;
	for (i=0;i<F_MAXCHAN; i++) {
		if (f_chan[i] != NULL) {fclose(f_chan[i]); f_chan[i] = NULL;}
		siffree(&f_buff[i]);
		siffree(&f_nexttok[chn]);
	}
}
void f_readahead(chn)
{
	siffree(&f_nexttok[chn]);
	f_nexttok[chn] = sdup(f_getnext(chn));
}	
char *f_getnext(int chn)
{
	char *s;
	int blen;
	static char tk[81];
	if (f_buff[chn]==NULL) f_getline(chn);
	tk[0] = 0;
try_again:
	if (f_buff[chn]==NULL) return tk;
	blen = strlen(f_buff[chn]);
	s = strtok(f_buff[chn]," ,=\t\n\x0a\x0c\x0d");	
	if (s==NULL) goto next_line;
	strcpy(tk,s);
	if (strlen(s)==blen) f_buff[0] = 0;
	else strcpy(f_buff[chn],s+1+strlen(s));
	if (*s == '"' || *s == '!' || *s == ';') goto next_line;
	return tk;
next_line:
	if (f_eof(chn)) return tk;
	f_getline(chn);
	goto try_again;
}
void siffree(char **s) 
{
	if (*s != NULL) myfree(*s);
	*s = NULL;
}
int f_testchan(int chn)
{
	if (chn<0 || chn>F_MAXCHAN) {
		gprint("Error in channel number %d\n",chn);
		return 0;
	}
	return chn;
}