#include "all.h"
#include <math.h>
#include <time.h>
#include "mygraph.h"
#include "rgb.h"
colortyp colvar;
#define true (!false)
#define false 0
char *eval_str();
int var_getstr(int varnum,char *s);
int pass_marker(char *s);
int f_eof(int chn);
/*---------------------------------------------------------------------------*/
/* bin = 10..29, binstr = 30..49, fn= 60...139, userfn=200..nnn */
/* pcode:,  1=exp,len  2=float,val 3=var,int32 4,string_var, 5=string,.../0 */
/*---------------------------------------------------------------------------*/
/* Input is exp-pcode, output is number or string */

char *binop[] = { "", "+", "-", "*", "/", "^", "=", "<", "<=", ">"
			, ">=", "<>", ".AND.", ".OR." };

struct keyw { char *word; int index; int ret,np,p[5]; } ;
extern struct keyw keywfn[] ;

double stk[60];
int stk_var[100];
char *stk_str[100];
int stk_strlen[100];
char sbuf[512];
char sbuf2[112];
int nstk=0;
extern int gle_debug;
#define dbg if ((gle_debug & 2)>0)

eval(int32 *pcode,int *cp,double *oval,char *ostr,int *otyp)
{
		/* a pointer to the pcode to execute 		*/
		/* Current point in this line of pcode 		*/
		/* place to put result number 			*/
		/* place to put result string 			*/
		/* place to put result type, 1=num, 2=str 	*/
	union {double d; int32 l[1];} both;
	char *ss2,*ss;
	int plen,i,j,l,c,cde;
	time_t today;
	double x1,y1,x2,y2;
	double xx,yy,zz;
	dbg gprint("%%EXP-START, Current point in eval %d %d \n",*cp,(int) *(pcode+(*cp)));
	dbg for (i=0;i<10;i++) gprint("%ld ",*(pcode+i));
	dbg gprint("\n");
	dbg debug_polish(pcode,cp);
	if (*(pcode+(*cp))==8) {	/*  Single constant  */
		both.l[0] = *(pcode+ ++(*cp));
		both.l[1] = 0;
		dbg gprint("Constant %ld \n",both.l[0]);
		memcpy(oval,&both.d,sizeof(both.d));
		memcpy(&both.d,oval,sizeof(both.d));
		++(*cp);
		return;
	}

	if (*(pcode+(*cp)++)!=1) {
		gprint("PCODE, Expecting expression, v=%ld cp=%d \n",*(pcode+(--*(cp))),*cp);
		return;
	}
	plen = *(pcode+*(cp));
	dbg gprint(" plen = %d ",plen);
	if (plen>1000) gprint("Expression is suspiciously long %d \n",plen);
	for (c=(*cp)+1;c<=(plen+ *cp);c++) {
	  cde = *(pcode+c);
	  dbg gprint(" c=%d ",cde);
	  switch (*(pcode+c)) {
		/* Special commands 1..9  ------------------------------- */
		case 1:	/* Start of another expression (function param) */
			c++;	/* skip over exp length */
			break;
		case 2: /* Floating point number follows */
			*otyp = 1;
			both.l[0] = *(pcode+(++c));
			both.l[1] = *(pcode+(++c));
			stk[++nstk] =  both.d;
 			dbg gprint("Got float %f %d %f \n",stk[nstk],nstk,*(pcode+(c)));
			break;
		case 3: /* Floating_point variable number follows */
			*otyp = 1;
			var_get(*(pcode+(++c)),&xx);
			dbg gprint("Got variable value %ld %f \n",*(pcode+(c)),xx);
			stk[++nstk] = xx;
			break;
		case 4: /* string variable number follows */
			*otyp = 2;
			var_getstr(*(pcode+(++c)),sbuf); nstk++;
			if (stk_str[nstk]!=NULL)  myfree(stk_str[nstk]);
			stk_str[nstk] = sdup(sbuf);
 			break;
		case 5: /* Null terminated string follows (int32 alligned) */
			*otyp = 2;
			c++;nstk++;
			strcpy(sbuf,eval_str(pcode,&c));
			if (stk_str[nstk]!=NULL)  myfree(stk_str[nstk]);
			stk_str[nstk] = sdup(sbuf);
			break;
		/* Numeric Binary operators 10..29 ----------------------- */
		case 11:  /* + */
			nstk--;
			stk[nstk] = stk[nstk+1] + stk[nstk];
			break;
		case 12:  /* - */
			stk[nstk-1] = stk[nstk-1] - stk[nstk];
			nstk--;
			break;
		case 13:  /* * */
			stk[nstk-1] = stk[nstk-1] * stk[nstk];
			nstk--;
			break;
		case 14:  /* / */
			if (stk[nstk]==0) {
				gprint("Divide by zero %g %g \n",
					stk[nstk-1],stk[nstk]);
			} else {
				stk[nstk-1] = stk[nstk-1] / stk[nstk];
			}
			nstk--;
			break;
		case 15:  /* ^ */
			stk[nstk-1] = pow(stk[nstk-1],stk[nstk]);
			nstk--;
			break;
		case 16:  /* = */
			nstk--;
			if (stk[nstk] == stk[nstk+1]) stk[nstk]=true;
			else stk[nstk]=false;
			break;
		case 17:  /* <   */
			nstk--;
			if (stk[nstk] < stk[nstk+1]) stk[nstk]=true;
			else stk[nstk]=false;
			break;
		case 18:  /* <=  */
			nstk--;
			if (stk[nstk] <= stk[nstk+1]) stk[nstk]=true;
			else stk[nstk]=false;
			break;
		case 19:  /* >   */
			nstk--;
			if (stk[nstk] > stk[nstk+1]) stk[nstk]=true;
			else stk[nstk]=false;
			break;
		case 20:  /* >=  */
			nstk--;
			if (stk[nstk] >= stk[nstk+1]) stk[nstk]=true;
			else stk[nstk]=false;
			break;
		case 21:  /*  <>  */
			nstk--;
			if (stk[nstk] != stk[nstk+1]) stk[nstk]=true;
			else stk[nstk]=false;
			break;
		case 22:  /* .AND.  */
			nstk--;
			if (stk[nstk] && stk[nstk+1]) stk[nstk]=true;
			else stk[nstk]=false;
			break;
		case 23:  /* .OR.   */
			nstk--;
			if (stk[nstk] || stk[nstk+1]) stk[nstk]=true;
			else stk[nstk]=false;
			break;
		/* String Binary operators 30..49 ----------------------- */
		case 31:  /* + */
			*otyp = 2;
			nstk--;
			if (stk_str[nstk]!=NULL) strcpy(sbuf,stk_str[nstk]);
			if (stk_str[nstk+1]!=NULL) strcat(sbuf,stk_str[nstk+1]);
			if (stk_str[nstk] != NULL) myfree(stk_str[nstk]);
			stk_str[nstk] = sdup(sbuf);
			break;
		case 32:  /* - */
			break;
		case 33:  /* * */
			break;
		case 34:  /* / */
			break;
		case 35:  /* ^ */
			break;
		case 36:  /* = */
			*otyp = 1;
			nstk--;
			if (strcmp(stk_str[nstk],stk_str[nstk+1])==0)
				stk[nstk]=true;
			else
				stk[nstk]=false;
			break;
		case 37:  /* <   */
			break;
		case 38:  /* <=  */
			break;
		case 39:  /* >   */
			break;
		case 40:  /* >=  */
			break;
		case 41:  /* .AND.  */
			break;
		case 42:  /* .OR.   */
			break;

		/* Built in functions 60..199 ----------------------------- */
		case 61: /* unary plus */
			break;
		case 62: /* unary minus */
			stk[nstk] = -stk[nstk];
			break;
		case 63: /* abs */
			stk[nstk] = fabs(stk[nstk]);
			break;
		case 64: /* atn */
			stk[nstk] = atan(stk[nstk]);
			break;
		case 113: /* ACOS */
			stk[nstk] = acos(stk[nstk]);
			break;
		case 114: /* ASIN */
			stk[nstk] = asin(stk[nstk]);
			break;
		case 65: /* cos */
			stk[nstk] = cos(stk[nstk]);
			break;
		case 66: /* date$ */
			*otyp = 2;
			time(&today);
			strcpy(sbuf2,ctime(&today));
			strcpy(sbuf,sbuf2);
			strcpy(sbuf+11,sbuf2+20);
			sbuf[strlen(sbuf)-1] = 0;
			setdstr(&stk_str[++nstk],sbuf);
			break;
		case 111: /* device$ */
			*otyp = 2;
			g_get_type(sbuf2);
			setdstr(&stk_str[++nstk],sbuf2);
			break;
		case 115: /* feof(chan) */
			stk[nstk] = f_eof((int) stk[nstk]);
			break;
		case 67: /* exp */
			stk[nstk] = exp(stk[nstk]);
			break;
		case 68: /* fix*/
			stk[nstk] = floor(stk[nstk]);
			break;
		case 69: /* height */
			break;
		case 70: /* int (??int32) */
			stk[nstk] = floor(fabs(stk[nstk]))
				*( (stk[nstk]>=0)?1:-1 ) ;
			break;
		case 112: /* CHR$() */
			*otyp = 2;
			sprintf(sbuf,"%c",(int) stk[nstk]);
			setdstr(&stk_str[nstk],sbuf);
			break;
		case 71: /* left$ */
			*otyp = 2;
			ncpy(sbuf,stk_str[nstk-1],(int) stk[nstk]);
			setdstr(&stk_str[--nstk],sbuf);
			break;
		case 72: /* len */
			*otyp = 1;
			stk[nstk] = strlen(stk_str[nstk]);
			break;
		case 73: /* log */
			stk[nstk] = log(stk[nstk]);
			break;
		case 74: /* log10 */
			stk[nstk] = log10(stk[nstk]);
			break;
		case 75: /* not */
			stk[nstk] = !(stk[nstk]);
			break;
		case 76: /* num$ */
			*otyp = 2;
			sprintf(sbuf,"%g ",stk[nstk]);
			if (stk_str[nstk] != NULL) myfree(stk_str[nstk]);
			stk_str[nstk] = sdup(sbuf);
			break;
		case 77: /* num1$ */
			*otyp = 2;
			sprintf(sbuf,"%g",stk[nstk]);
			if (stk_str[nstk] != NULL) myfree(stk_str[nstk]);
			stk_str[nstk] = sdup(sbuf);
			break;
		case 78: /* pageheight */
			break;
		case 79: /* pagewidth */
			break;
		case 80: /* pos */
			*otyp = 1;
			i = stk[nstk];
			if (i<=0) i = 1;
			ss = stk_str[nstk-2];
			ss2 = strstr(ss+i-1,stk_str[nstk-1]);
			if (ss2!=NULL) 	i = ss2-ss+1;
			else 		i = 0;
			nstk -= 2;
			stk[nstk] = i;
			break;
		case 81: /* right$ */
			*otyp = 2;
			strcpy(sbuf,stk_str[nstk-1] + (int) stk[nstk] - 1);
			setdstr(&stk_str[--nstk],sbuf);
			break;
		case 82: /* rnd */   
			stk[nstk] = ((double) rand()/(double)RAND_MAX)*stk[nstk];
			break;
		case 83: /* seg$ */
			*otyp = 2;
			strcpy(sbuf,stk_str[nstk-2] + (int) stk[nstk-1] - 1);
			ncpy(sbuf2,sbuf,(int) stk[nstk] -  stk[nstk-1] + 1);
			nstk-=2;
			setdstr(&stk_str[nstk],sbuf2);
			break;
		case 84: /* sgn */
			if (stk[nstk]>=0) stk[nstk] = 1;
			else stk[nstk] = -1;
			break;
		case 85: /* sin */
			stk[nstk] = sin(stk[nstk]);
			break;
		case 86: /* sqr */
			stk[nstk] = stk[nstk] * stk[nstk];
			break;
		case 87: /* sqrt */
			stk[nstk] = sqrt(stk[nstk]);
			break;
		case 88: /* tan */
			stk[nstk] = tan(stk[nstk]);
			break;
		case 89: /* tdepth */
			*otyp = 1;
			g_get_xy(&xx,&yy);
			g_measure(stk_str[nstk],&x1,&x2,&y2,&y1);
			stk[nstk] = y1;
			break;
		case 90: /* theight */
			*otyp = 1;
			g_get_xy(&xx,&yy);
			g_measure(stk_str[nstk],&x1,&x2,&y2,&y1);
			stk[nstk] = y2;
			break;
		case 91: /* time$ */
			*otyp = 2;
			time(&today);
			ncpy(sbuf,ctime(&today)+11,9);
			setdstr(&stk_str[++nstk],sbuf);
			break;
		case 92: /* twidth */
			*otyp = 1;
			g_measure(stk_str[nstk],&x1,&x2,&y1,&y2);
			stk[nstk] = x2-x1;
			break;
		case 93: /* val */
			break;
		case 94: /* width */
			break;
		case 95: /* xend */
			*otyp = 1;
			stk[++nstk] = tex_xend();
			break;
		case 96: /* xgraph */
			*otyp = 1;
			stk[nstk] = graph_xgraph(stk[nstk]);
			break;
		case 97: /* xmax */
			break;
		case 98: /* xmin */
			break;
		case 99: /* xpos */
			*otyp = 1;
			g_get_xy(&xx,&yy);
			stk[++nstk] = xx;
			break;
		case 100: /* yend */
			stk[++nstk] = tex_yend();
			*otyp = 1;
			break;
		case 101: /* ygraph */
			stk[nstk] = graph_ygraph(stk[nstk]);
			*otyp = 1;
			break;
		case 102: /* ymax */
			break;
		case 103: /* ymin */
			break;
		case 104: /* ypos */
			g_get_xy(&xx,&yy);
			*otyp = 1;
			stk[++nstk] = yy;
			break;
		case 105: /* CVTGREY(.5) */
			colvar.b[B_F] = 1;
			colvar.b[B_R] = floor(stk[nstk]*255);
			colvar.b[B_G] = colvar.b[B_R];
			colvar.b[B_B] = colvar.b[B_R];
			both.l[0] = colvar.l;
			both.l[1] = 0;
			memcpy(&stk[nstk],&both.d,sizeof(double));
			break;
		case 106: /* CVTINT(2) */
			*otyp = 1;
			both.l[0] = floor(stk[nstk]);
			both.l[1] = 0;
			memcpy(&stk[nstk],&both.d,sizeof(double));
			break;
		case 108: /* CVTMARKER(m$) */
			*otyp = 1;
			strupr(stk_str[nstk]);
			both.l[0] = pass_marker(stk_str[nstk]);
			both.l[1] = 0;
			memcpy(&stk[nstk],&both.d,sizeof(double));
			break;
		case 110: /* CVTFONT(m$) */
			*otyp = 1;
			strupr(stk_str[nstk]);
			both.l[0] = pass_font(stk_str[nstk]);
			both.l[1] = 0;
			memcpy(&stk[nstk],&both.d,sizeof(double));
			break;
		case 109: /* CVTCOLOR(c$) */
			*otyp = 1;
			strupr(stk_str[nstk]);
			if (strchr(stk_str[nstk],'$')!=NULL) {
				gprint("Error in color name {%s} \n",stk_str[nstk]);
				break;
			}
			both.l[0] = pass_color(stk_str[nstk]);
			both.l[1] = 0;
			memcpy(&stk[nstk],&both.d,sizeof(double));
			break;
		case 107: /* CVTrGB(.4,.4,.2) */
			colvar.b[B_F] = 1;
			colvar.b[B_B] = floor(stk[nstk]*255);
			colvar.b[B_G] = floor(stk[nstk-1]*255);
			colvar.b[B_R] = floor(stk[nstk-2]*255);
			nstk -= 2;
			both.l[0] = colvar.l;
			both.l[1] = 0;
			memcpy(&both.l[0],&colvar.l,sizeof(int32));
			memcpy(&stk[nstk],&both.d,sizeof(double));
			break;
		/* User function 200..nnn , or error */
		default:
			  /* Is it a user defined function */
			if (*(pcode+c)>200)  {
	/*			pass the address of some numbers */
	/*			pass address of variables if possible*/
				sub_call(*(pcode+c)-200,stk,stk_str,&nstk,otyp);
			}
			else gprint("Unrecognised pcode exp prim %d at position=%d \n",*(pcode+c),c);
			break;
	  }
	}
	dbg gprint("RESULT ISa ==== %d [1] %f   [nstk] %f \n",nstk,stk[1],stk[nstk]);
	memcpy( oval,&(stk[nstk]),sizeof(double));
	dbg gprint("RESULT ISb ==== %d [1] %f   [nstk] %f \n",nstk,stk[1],stk[nstk]);
	dbg gprint("oval %g \n",*oval);
	*ostr = '\0';
	if (*otyp==2) if (stk_str[nstk]!=NULL) strcpy(ostr,stk_str[nstk]);
	if (*otyp==2) dbg gprint("Evaluated string = {%s} \n",ostr);
	nstk--;
	if (nstk<0) {
 		gprint("Stack stuffed up in EVAL %d \n",nstk);
		nstk = 0;
	}
	*cp = *cp + plen + 1;
}

debug_polish(int32 *pcode,int *zcp)
{
	int32 *cp,cpval;
	int plen,i,j,c,cde;
	cpval = *zcp;
	cp = &cpval;
	if (*(pcode+(*cp)++)!=1) {
		gprint("Expecting expression, v=%d \n",(int) *(pcode+--(*cp)) );
		return;
	}
	plen = *(pcode+*(cp));
	gprint("Expression length %d current point %d \n",plen,(int) *cp);
	if (plen>1000) gprint("Expession is suspiciously int32 %d \n",plen);
	for (c=(*cp)+1;(c-*cp)<=plen;c++) {
	  cde = *(pcode+c);
	gprint("Code=%d ",cde);
		if (cde==0) {
			gprint("# ZERO \n");
		} else if (cde==1) {
			gprint("# Expression, length ??? \n");
			c++;
		} else if (cde==2) {
			gprint("# Floating point number %8x \n",*(pcode+(++c)));
			c++;	/* because it's a DOUBLE which is a quad word */
		} else if (cde==3) {
			gprint("# Variable \n");  c++;
		} else if (cde==4) {
			gprint("# String Variable \n"); c++;
		} else if (cde==5) {
			c++;
			gprint("# String constant {%s} \n",eval_str(pcode,&c));
		} else if (cde<29) {
			gprint("# Binary operator {%s} \n",binop[cde-10]);
		} else if (cde<49) {
			gprint("# Binary string op {%s} \n",binop[cde-30]);
		} else if (cde<200) {
			gprint("# Built in function (with salt) {%s} \n",keywfn[cde-60].word);
		} else {
			gprint("# User defined function %d \n",cde);
		}

	}
}

char *eval_str(int32 *pcode,int *plen)
{
	char *s;
	int sl;
	s = (char *) (pcode+*plen);
	sl = strlen(s)+1;
	sl = ((sl + 3) & 0xfffc);
	*plen = *plen + sl/4 - 1;
	return s;
}

setdstr(char **s,char *in)
{
	if (*s != NULL) myfree(*s);
	*s = sdup(in);
}


