home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Photo CD Demo 1
/
Demo.bin
/
gle
/
gle
/
eval.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-29
|
14KB
|
541 lines
/*---------------------------------------------------------------------------*/
#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,long 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(long *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; long 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 (long 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: /* long */
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 */
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 */
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(long));
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(long *pcode,int *zcp)
{
long *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 long %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(long *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);
}