/*****************************************************************************
*   "Irit" - the 3d polygonal solid modeller.				     *
*									     *
* Written by:  Gershon Elber				Ver 0.2, Mar. 1990   *
******************************************************************************
*   Module to evaluate the binary tree generated by the InptPrsr module.     *
*   All the objects are handled the same but the numerical one, which is     *
* moved as a RealType and not as an object (only internally within this	     *
* module) as it is frequently used and consumes much less memory this way.   *
*   Note this module is par of InptPrsr module and was splited only because  *
* of text file sizes problems...					     *
*****************************************************************************/

#ifdef __MSDOS__
#include <alloc.h>
#include <graphics.h>
#include <dir.h>
#endif /* __MSDOS__ */

#include <stdio.h>
#include <ctype.h>
#include <math.h>
#include <string.h>
#include "program.h"
#include "allocatg.h"
#include "viewobjg.h"
#include "convexg.h"
#include "primitvg.h"
#include "geomat3d.h"
#include "windowsg.h"
#include "dataprsg.h"
#include "objects.h"
#include "geomvalg.h"
#include "dosintrg.h"
#include "inptprsg.h"
#include "inptprsl.h"
#include "overload.h"
#include "matherr.h"
#include "ctrl-brk.h"

#ifndef __MSDOS__
#include "xgraphic.h"
#endif /* __MSDOS__ */

#include "graphgng.h"


int IPGlblEvalError;				 /* Global used by EvalTree. */
extern char IPGlblCharData[LINE_LEN_LONG];    /* Used for both parse & eval. */

/*   I prefer to put the declarations of static functions just before the    */
/* function themselves, but the tables below needs them so...		     */
static void PrintHelp(char *HelpHeader);
static void IfCondition(RealType *Left, char *Cond, RealType *Right,
							ParseTree *PBody);
static void ForLoop(ParseTree *PLeft, ParseTree *PCond,
				   ParseTree *PRight, ParseTree *PBody);
static struct ObjectStruct *GenObjectList(ParseTree *PObjParams);
static int CountNumExpressions(ParseTree *Root);
static ParseTree *FetchExpression(ParseTree *Root, int i, int n);
static int RetrieveMathError(void);
static int CountNumParameters(ParseTree *Root);
static ParseTree *FetchParameter(ParseTree *Root, int i, int n);
static int FuncParamMismatch(ParseTree *Root);
static void LocalPrintTree(ParseTree *Root, int Level, char *Str);
static void RebindVariable(ParseTree *Root, ObjectStruct *PObj);
static int RetrieveMathError(void);

NumFuncTableType NumFuncTable[] = {
    { "ACOS",	ARCCOS,	acos,	1,	{ NUMERIC_OBJ }	},
    { "ASIN",	ARCSIN,	asin,	1,	{ NUMERIC_OBJ }	},
    { "ATAN2",	ARCTAN2, atan2,	2,	{ NUMERIC_OBJ, NUMERIC_OBJ }  },
    { "ATAN",	ARCTAN,	atan,	1,	{ NUMERIC_OBJ }	},
    { "COS",	COS,	cos,	1,	{ NUMERIC_OBJ }	},
    { "EXP",	EXP,	exp,	1,	{ NUMERIC_OBJ }	},
    { "ABS",	FABS,	fabs,	1,	{ NUMERIC_OBJ }	},
    { "LN",	LN,	log,	1,	{ NUMERIC_OBJ }	},
    { "LOG",	LOG,	log10,	1,	{ NUMERIC_OBJ }	},
    { "SIN",	SIN,	sin,	1,	{ NUMERIC_OBJ }	},
    { "SQRT",	SQRT,	sqrt,	1,	{ NUMERIC_OBJ }	},
    { "TAN",	TAN,	tan,	1,	{ NUMERIC_OBJ }	},
    { "CPOLY",	CPOLY,	GeomCountPolys,	1,	{ GEOMETRIC_OBJ } },
    { "AREA",	AREA,	GeomObjectArea,	1,	{ GEOMETRIC_OBJ } },
    { "VOLUME",	VOLUME,	GeomObjectVolume, 1,	{ GEOMETRIC_OBJ } },
    { "TIME",	TIME,	DosGetTime,	1,	{ NUMERIC_OBJ } },
};
int NumFuncTableSize = sizeof(NumFuncTable) / sizeof(NumFuncTableType);

/* Although the type of parameters is specified (for InptPrsrTypeCheck rtn)  */
/* All the parameters to the following dispatched functions are passed by    */
/* address. There is a problem in TurboC (ANSI C?) that all the real types   */
/* are passed as double, even if the are float. As RealType may be float,    */
/* the problems is hidden by passing parameters by address...		     */
ObjFuncTableType ObjFuncTable[] = {
    { "VECTOR",	VECTOR,	GenVecObject,	3,
			{ NUMERIC_OBJ,   NUMERIC_OBJ,   NUMERIC_OBJ  } },
    { "ROTX",	ROTX,	GenMatObjectRotX,	1,	{ NUMERIC_OBJ } },
    { "ROTY",	ROTY,	GenMatObjectRotY,	1,      { NUMERIC_OBJ } },
    { "ROTZ",	ROTZ,	GenMatObjectRotZ,	1,	{ NUMERIC_OBJ } },
    { "TRANS",	TRANS,	GenMatObjectTrans,	1,	{ VECTOR_OBJ } },
    { "SCALE",	SCALE,	GenMatObjectScale,	1,	{ VECTOR_OBJ } },
    { "BOX",	BOX,	GenBOXObject,		4,
			{ VECTOR_OBJ,  NUMERIC_OBJ,  NUMERIC_OBJ,  NUMERIC_OBJ  } },
    { "GBOX",	GBOX,	GenGBOXObject,		4,
			{ VECTOR_OBJ,  VECTOR_OBJ,   VECTOR_OBJ,   VECTOR_OBJ  } },
    { "CONE",	CONE,	GenCONEObject,		3,
			{ VECTOR_OBJ,  VECTOR_OBJ,   NUMERIC_OBJ  } },
    { "CYLIN",	CYLIN,	GenCYLINObject,		3,
			{ VECTOR_OBJ,  VECTOR_OBJ,   NUMERIC_OBJ  } },
    { "SPHERE",	SPHERE,	GenSPHEREObject,	2,
			{ VECTOR_OBJ,  NUMERIC_OBJ  } },
    { "TORUS",	TORUS,	GenTORUSObject,		4,
			{ VECTOR_OBJ,  VECTOR_OBJ,   NUMERIC_OBJ,  NUMERIC_OBJ  } },
    { "PLANE",	PLANE,	GenPLANEObject,		3,
			{ VECTOR_OBJ,  VECTOR_OBJ,   NUMERIC_OBJ  } },
    { "POLY",	POLY,	GenPOLYObject,		1, { OBJ_LIST_OBJ } },
    { "CROSSEC", CROSSEC, GenCROSSECObject,	1, { ANY_OBJ } },
    { "SURFREV", SURFREV, GenSURFREVObject,	1, { GEOMETRIC_OBJ } },
    { "EXTRUDE", EXTRUDE, GenEXTRUDEObject,	2,
			{ GEOMETRIC_OBJ, VECTOR_OBJ } },
    { "LIST",	LIST,	GenObjectList,		ANY_PARAM_NUM },
    { "LOAD",   LOAD,   DataPrsrGetObject,	1, { STRING_OBJ } },
    { "CONVEX",	CONVEX, ConvexPolyObjectN,	1, { GEOMETRIC_OBJ } },
};
int ObjFuncTableSize = sizeof(ObjFuncTable) / sizeof(ObjFuncTableType);

/* Although the type of parameters is specified (for InptPrsrTypeCheck rtn). */
GenFuncTableType GenFuncTable[] = {
    { "EXIT",	EXIT,	MyExit,		0, },
    { "VIEW",	VIEW,	WndwViewGeomObject, 2,	{ OBJ_LIST_OBJ,	NUMERIC_OBJ } },
    { "DIR",	DIR,	DosPrintDir,	1,	{ STRING_OBJ } },
    { "CHDIR",	CHDIR,	DosChangeDir,	1,	{ STRING_OBJ } },
    { "NORMAL",	NORMAL,	ViewSetNormals,	3,
				{ NUMERIC_OBJ,	NUMERIC_OBJ, NUMERIC_OBJ } },
    { "INCLUDE", INCLUDE, FileInclude,	1,	{ STRING_OBJ } },
    { "GDUMP",	GDUMP,	DataPrsrPutObject,  2,	{ STRING_OBJ, GEOMETRIC_OBJ } },
    { "MDUMP",	MDUMP,	DataPrsrPutObject,  2,	{ STRING_OBJ, MATRIX_OBJ } },
    { "FREE",	FREEOBJ, FreeObject,	1,	{ ANY_OBJ } },
    { "INTERACT", INTERACT, InteractGeomObject, 2,	{ OBJ_LIST_OBJ, NUMERIC_OBJ } },
    { "PAUSE",	PAUSE,	WndwPause,	1,	{ NUMERIC_OBJ } },
    { "IF",	IFCOND, IfCondition,	4,
		{ NUMERIC_OBJ,	STRING_OBJ,	NUMERIC_OBJ, ANY_OBJ } },
    { "FOR",	FORLOOP, ForLoop,	4,
		{ NUMERIC_OBJ,	NUMERIC_OBJ,	NUMERIC_OBJ, ANY_OBJ } },
    { "HELP",	PRHELP,	PrintHelp,	1,	{ STRING_OBJ } },
    { "VARLIST", VARLIST, PrintObjectList,	0, },
    { "ALIAS",	ALIAS,	AliasEdit,	2,	{ STRING_OBJ, STRING_OBJ } },
    { "BEEP",	BEEP,   GGTone,		2,	{ NUMERIC_OBJ, NUMERIC_OBJ } },
    { "EDIT",	EDIT,	DosEditFile,	1,	{ STRING_OBJ } },
    { "SYSTEM",	SYSTEM,	DosSystem,	0, },
    { "LOGFILE", LOGFILE, WndwLogPrint,	1,	{ NUMERIC_OBJ } },
    { "COLOR",	COLOR,	SetGeomObjectColor, 2,	{ GEOMETRIC_OBJ, NUMERIC_OBJ } },
};
int GenFuncTableSize = sizeof(GenFuncTable) / sizeof(GenFuncTableType);

ConstantTableType ConstantTable[] = {
    { "PI",	M_PI },

    { "ON",	1.0 },
    { "TRUE",	1.0 },
    { "OFF",	0.0 },
    { "FALSE",	0.0 },

    { "BLACK",  (double) BLACK },
    { "BLUE",	(double) BLUE },
    { "GREEN",	(double) GREEN },
    { "CYAN",	(double) CYAN },
    { "RED",	(double) RED },
    { "MAGENTA", (double) MAGENTA },
    { "YELLOW", (double) YELLOW },
    { "WHITE",  (double) WHITE },
};
int ConstantTableSize = sizeof(ConstantTable) / sizeof(ConstantTableType);

/*****************************************************************************
*   Routine to do type checking to the given tree - return type if found one *
* or returns ERROR_EXPR if error in types was detected.			     *
*****************************************************************************/
int InptPrsrTypeCheck(ParseTree *Root, int Level)
{
    int Right, Left, Result;

    if (Level == 0 &&
	Root->NodeKind != PARAMETER &&	    /* What is allowed on top level. */
	Root->NodeKind != EQUAL &&
	!IS_GEN_PROCEDURE(Root->NodeKind)) {
	IPGlblEvalError = IE_ERR_NoAssignment;
	strcpy(IPGlblCharData, "");
	return ERROR_EXPR;
    }

    switch(Root->NodeKind) {
	case ARCSIN:		       /* Functions which returns Real Type: */
	case ARCCOS:
	case ARCTAN:
	case ARCTAN2:
	case COS:
	case EXP:
	case FABS:
	case LN:
	case LOG:
	case SIN:
	case SQRT:
	case TAN:
	case CPOLY:
	case AREA:
	case VOLUME:
	case TIME:
	    if (FuncParamMismatch(Root)) return ERROR_EXPR;
	    return NUMERIC_EXPR;
	case VECTOR:	      /* Object functions which returns Vector Type: */
	    if (FuncParamMismatch(Root)) return ERROR_EXPR;
	    return VECTOR_EXPR;
	case ROTX:
	case ROTY:
	case ROTZ:
	case TRANS:
	case SCALE:
	    if (FuncParamMismatch(Root)) return ERROR_EXPR;
	    return MATRIX_EXPR;
	case BOX:
	case GBOX:
	case CONE:
	case CYLIN:
	case SPHERE:
	case TORUS:
	case PLANE:
	case POLY:
	case CROSSEC:
	case SURFREV:
	case EXTRUDE:
	case LOAD:
	case CONVEX:
	    if (FuncParamMismatch(Root)) return ERROR_EXPR;
	    return GEOMETRIC_EXPR;
	case LIST:
	    if (FuncParamMismatch(Root)) return ERROR_EXPR;
	    return OBJ_LIST_EXPR;
	case EXIT:
	case SYSTEM:
	case VARLIST:
	    if (Level == 0) return NON_EXPR;
	    else {
		IPGlblEvalError = IE_ERR_TypeMismatch;
                UpdateCharError("Procedure ", Root->NodeKind);
		return ERROR_EXPR;
	    }
	case VIEW:
        case DIR:
	case CHDIR:
	case NORMAL:
	case INCLUDE:
	case GDUMP:
	case MDUMP:
	case FREEOBJ:
	case INTERACT:
	case IFCOND:
	case FORLOOP:
	case PRHELP:
	case PAUSE:
	case ALIAS:
	case BEEP:
	case EDIT:
	case LOGFILE:
	case COLOR:
	    if (Level == 0) {
		if (FuncParamMismatch(Root)) return ERROR_EXPR;
		return NON_EXPR;
	    }
	    else {
		IPGlblEvalError = IE_ERR_TypeMismatch;
                UpdateCharError("Procedure ", Root->NodeKind);
		return ERROR_EXPR;
	    }
	case PLUS:
	case MINUS:
	case MULT:
	case DIV:
	case POWER:
	    Right = InptPrsrTypeCheck(Root->Right, Level+1);
	    Left  = InptPrsrTypeCheck(Root->Left,  Level+1);
	    if (Right == ERROR_EXPR || Left == ERROR_EXPR) return ERROR_EXPR;
	    if (!OverLoadTypeCheck(Root->NodeKind, Right, Left, &Result)) {
		IPGlblEvalError = IE_ERR_TypeMismatch;
                UpdateCharError("Operator ", Root->NodeKind);
		return ERROR_EXPR;
	    }
	    else return Result;
	case UNARMINUS:
	    if ((Right = InptPrsrTypeCheck(Root->Right, Level+1)) == ERROR_EXPR)
		return ERROR_EXPR;
	    else if (!OverLoadTypeCheck(Root->NodeKind, Right, 0, &Result)) {
		IPGlblEvalError = IE_ERR_TypeMismatch;
                UpdateCharError("Operator ", Root->NodeKind);
		return ERROR_EXPR;
	    }
	    else return Result;
	case EQUAL:
	    if ((Right = InptPrsrTypeCheck(Root->Right, Level+1)) == ERROR_EXPR)
		return ERROR_EXPR;
	    if (Root->Left->NodeKind != PARAMETER) {
		IPGlblEvalError = IE_ERR_AssignLeftOp;
		InptPrsrPrintTree(Root->Left, IPGlblCharData);
		return ERROR_EXPR;
	    }
	    return Right;
	case NUMBER:
	    return NUMERIC_EXPR;
	case PARAMETER:
	    if (IS_GEOM_OBJ(Root->U.PObj)) return GEOMETRIC_EXPR;
	    else
	    if (IS_NUM_OBJ(Root->U.PObj)) return NUMERIC_EXPR;
	    else
	    if (IS_VEC_OBJ(Root->U.PObj)) return VECTOR_EXPR;
	    else
	    if (IS_MAT_OBJ(Root->U.PObj)) return MATRIX_EXPR;
	    else
	    if (IS_STR_OBJ(Root->U.PObj)) return STRING_EXPR;
	    else
	    if (IS_OLST_OBJ(Root->U.PObj)) return OBJ_LIST_EXPR;
	    else
	    if (IS_UNDEF_OBJ(Root->U.PObj)) {
		IPGlblEvalError = IE_ERR_UndefObject;
		strcpy(IPGlblCharData, Root->U.PObj->Name);
		return ERROR_EXPR;
	    }
	    IPGlblEvalError = IE_ERR_FatalError;
	    sprintf(IPGlblCharData, "Object = %s, Type %d",
				Root->U.PObj->Name, Root->U.PObj->ObjType);
	    return ERROR_EXPR;
	case STRING:
	    return STRING_EXPR;
	default:				     /* Should never happen. */
	    IPGlblEvalError = IE_ERR_FatalError;
            UpdateCharError("Token ", Root->NodeKind);
	    return ERROR_EXPR;
    }
}

/*****************************************************************************
*   Routine to evaluate	a value	of a given tree	root and parameter.	     *
* Note we change the tree itself during the evaluation process.		     *
* Also note we assume the tree is type checked (via InptPrsrTypeCheck rtn).  *
*****************************************************************************/
struct ParseTree *InptPrsrEvalTree(ParseTree *Root, int Level)
{
    char *ErrorMsg;
    struct ParseTree *TempL, *TempR, *Temp1, *Temp2, *Temp3, *Temp4;
    struct PolygonStruct *PPoly;

    switch(Root->NodeKind) {
	case ARCSIN:	   /* Real return functions with one real parameter. */
	case ARCCOS:
	case ARCTAN:
	case COS:
	case EXP:
	case FABS:
	case LN:
	case LOG:
	case SIN:
	case SQRT:
	case TAN:
	case TIME:
	    if ((TempR = InptPrsrEvalTree(Root->Right, Level+1)) == NULL)
		return NULL;
	    Root->ObjType = NUMERIC_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.R = (NumFuncTable[Root->NodeKind-NUM_FUNC_OFFSET].Func)
								(TempR->U.R);
	    if (RetrieveMathError()) return NULL;
	    return Root;

	case CPOLY:
	case AREA:
	case VOLUME:
	    if ((TempR = InptPrsrEvalTree(Root->Right, Level+1)) == NULL)
		return NULL;
	    Root->ObjType = NUMERIC_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.R = (NumFuncTable[Root->NodeKind-NUM_FUNC_OFFSET].Func)
							(TempR->U.PObj);
	    if (RetrieveMathError()) return NULL;
	    return Root;

	case ARCTAN2:	  /* Real return functions with two real parameters. */
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 2),
							Level+1)) == NULL ||
	        (Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 2),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = NUMERIC_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.R = (NumFuncTable[Root->NodeKind-NUM_FUNC_OFFSET].Func)
						      (Temp1->U.R, Temp2->U.R);
	    if (RetrieveMathError()) return NULL;
	    return Root;

	case VECTOR:  /* Object return functions with three real parameters. */
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 3),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 3),
							Level+1)) == NULL ||
		(Temp3 = InptPrsrEvalTree(FetchParameter(Root->Right, 2, 3),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = VECTOR_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		("", &Temp1->U.R, &Temp2->U.R, &Temp3->U.R,
							(ObjectStruct *) NULL);
	    return Root;

	case ROTX:
	case ROTY:
	case ROTZ:
	    if ((TempR = InptPrsrEvalTree(Root->Right, Level+1)) == NULL)
		return NULL;
	    Root->ObjType = MATRIX_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
								(&TempR->U.R);
	    if (RetrieveMathError()) return NULL;
	    return Root;

	case TRANS:
	case SCALE:
	    if ((TempR = InptPrsrEvalTree(Root->Right, Level+1)) == NULL)
		return NULL;
	    Root->ObjType = MATRIX_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
							(TempR->U.PObj->U.Vec);
	    if (RetrieveMathError()) return NULL;
	    return Root;

	case BOX:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 4),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 4),
							Level+1)) == NULL ||
		(Temp3 = InptPrsrEvalTree(FetchParameter(Root->Right, 2, 4),
							Level+1)) == NULL ||
		(Temp4 = InptPrsrEvalTree(FetchParameter(Root->Right, 3, 4),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = GEOMETRIC_OBJ;

	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		(Temp1->U.PObj->U.Vec, &Temp2->U.R, &Temp3->U.R, &Temp4->U.R);
	    return Root;

	case GBOX:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 4),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 4),
							Level+1)) == NULL ||
		(Temp3 = InptPrsrEvalTree(FetchParameter(Root->Right, 2, 4),
							Level+1)) == NULL ||
		(Temp4 = InptPrsrEvalTree(FetchParameter(Root->Right, 3, 4),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = GEOMETRIC_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		(Temp1->U.PObj->U.Vec, Temp2->U.PObj ->U.Vec,
		 Temp3->U.PObj->U.Vec, Temp4->U.PObj ->U.Vec);
	    return Root;

	case CONE:
	case CYLIN:
	case PLANE:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 3),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 3),
							Level+1)) == NULL ||
		(Temp3 = InptPrsrEvalTree(FetchParameter(Root->Right, 2, 3),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = GEOMETRIC_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		(Temp1->U.PObj->U.Vec, Temp2->U.PObj->U.Vec, &Temp3->U.R);
	    return Root;

	case SPHERE:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 2),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 2),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = GEOMETRIC_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		(Temp1->U.PObj->U.Vec, &Temp2->U.R);
	    return Root;

	case TORUS:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 4),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 4),
							Level+1)) == NULL ||
		(Temp3 = InptPrsrEvalTree(FetchParameter(Root->Right, 2, 4),
							Level+1)) == NULL ||
		(Temp4 = InptPrsrEvalTree(FetchParameter(Root->Right, 3, 4),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = GEOMETRIC_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		(Temp1->U.PObj->U.Vec, Temp2->U.PObj->U.Vec,
		 &Temp3->U.R, &Temp4->U.R);
	    return Root;

	case POLY:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 1),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = GEOMETRIC_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		(Temp1->U.PObj);
	    if (Root->U.PObj == NULL) return NULL;
	    return Root;

	case CROSSEC:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 1),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = GEOMETRIC_OBJ;
	    /* Use table entries to call the function directly. */
	    if (IS_GEOM_OBJ(Temp1 -> U.PObj))
		Root->U.PObj =
		    (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
			(Temp1->U.PObj);
	    else
		Root->U.PObj =
		    (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
			((ObjectStruct *) NULL);
	    if (Root->U.PObj == NULL) return NULL;
	    return Root;

	case EXTRUDE:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 2),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 2),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = GEOMETRIC_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		(Temp1->U.PObj, Temp2->U.PObj->U.Vec);
	    if (Root->U.PObj == NULL) return NULL;
	    return Root;

	case SURFREV:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 1),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = GEOMETRIC_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		(Temp1->U.PObj);
	    if (Root->U.PObj == NULL) return NULL;
	    return Root;

	case LOAD:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 1),
							Level+1)) == NULL)
		return NULL;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		(Temp1->U.PObj->U.Str, "");
	    if (Root->U.PObj == NULL) {
	        DataPrsrParseError(&ErrorMsg);
		IPGlblEvalError = IE_ERR_DataPrsrError;
		strcpy(IPGlblCharData, ErrorMsg);
		return NULL;
	    }
	    Root->ObjType = Root -> U.PObj -> ObjType;
	    return Root;

	case CONVEX:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 1),
							Level+1)) == NULL)
		return NULL;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		(Temp1->U.PObj);
	    Root->ObjType = Temp1 -> U.PObj -> ObjType;
	    return Root;

	case LIST:
	    Root->ObjType = OBJ_LIST_OBJ;
	    /* Use table entries to call the function directly. */
	    Root->U.PObj = (ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].Func)
		(Root -> Right);
	    if (Root->U.PObj == NULL) return NULL;
	    return Root;

	case VIEW:
	case INTERACT:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 2),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 2),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = UNDEF_OBJ;
	    /* Use table entries to call the function directly. */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)
						(Temp1->U.PObj, &Temp2->U.R);
	    return Root;

	case EXIT:
	    /* Yes - we finished for today... */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)(0);

	case PAUSE:
	case LOGFILE:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 1),
							Level+1)) == NULL)
		return NULL;
	    /* Use table entries to call the function directly. */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)(&Temp1 -> U.R);
	    Root->ObjType = UNDEF_OBJ;
	    return Root;

	case VARLIST:
	case SYSTEM:
	    /* Use table entries to call the function directly. */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)(GlblObjList);
	    Root->ObjType = UNDEF_OBJ;
	    return Root;

	case DIR:
	case CHDIR:
	case INCLUDE:
	case PRHELP:
	case EDIT:
	    if ((TempR = InptPrsrEvalTree(Root->Right, Level+1)) == NULL)
		return NULL;
	    /* Use table entries to call the function directly. */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)
			 (TempR->U.PObj->U.Str);
	    Root->ObjType = UNDEF_OBJ;
	    return Root;

	case GDUMP:
	case MDUMP:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 2),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 2),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = UNDEF_OBJ;
	    /* Use table entries to call the function directly. */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)
					(Temp1->U.PObj->U.Str, Temp2->U.PObj);
	    if (DataPrsrParseError(&ErrorMsg) != 0) {
		IPGlblEvalError = IE_ERR_DataPrsrError;
		strcpy(IPGlblCharData, ErrorMsg);
		return NULL;
	    }
	    return Root;

	case BEEP:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 2),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 2),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = UNDEF_OBJ;
	    /* Use table entries to call the function directly. */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)
					((int) Temp1->U.R, (int) Temp2->U.R);
	    return Root;

	case COLOR:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 2),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 2),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = UNDEF_OBJ;
	    /* Use table entries to call the function directly. */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)
						(Temp1->U.PObj, &Temp2->U.R);
	    return Root;

	case ALIAS:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 2),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 2),
							Level+1)) == NULL)
		return NULL;
	    Root->ObjType = UNDEF_OBJ;
	    /* Use table entries to call the function directly. */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)
				(Temp1->U.PObj->U.Str, Temp2->U.PObj->U.Str);
	    return Root;

	case FREEOBJ:
	    if ((TempR = InptPrsrEvalTree(Root->Right, Level+1)) == NULL)
		return NULL;
	    if (TempR->ObjType == NUMERIC_OBJ) {
		IPGlblEvalError = IE_ERR_TypeMismatch;
		strcpy(IPGlblCharData, "Func FREE, parameter 1");
		return Root;
	    }
	    if (strlen(TempR->U.PObj->Name) == 0) {
		IPGlblEvalError = IE_ERR_FreeSimple;
                UpdateCharError("Procedure ", FREEOBJ);
		return Root;
	    }
	    if (TempR->U.PObj->Count > 0) {
		IPGlblEvalError = IE_ERR_FreeNoRefObj;
		strcpy(IPGlblCharData, TempR->U.PObj->Name);
		return Root;
	    }
	    /* Use table entries to call the function directly. */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)
			 (TempR->U.PObj);
	    Root->ObjType = UNDEF_OBJ;
	    TempR->U.PObj = NULL;	    /* Make sure its disconnected... */
	    return Root;

	case NORMAL:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 3),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 3),
							Level+1)) == NULL ||
		(Temp3 = InptPrsrEvalTree(FetchParameter(Root->Right, 2, 3),
							Level+1)) == NULL)
		return NULL;
	    /* Use table entries to call the function directly. */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)
				(&Temp1->U.R, &Temp2->U.R, &Temp3->U.R);
	    Root->ObjType = UNDEF_OBJ;
	    return Root;

	case IFCOND:
	    if ((Temp1 = InptPrsrEvalTree(FetchParameter(Root->Right, 0, 4),
							Level+1)) == NULL ||
		(Temp2 = InptPrsrEvalTree(FetchParameter(Root->Right, 1, 4),
							Level+1)) == NULL ||
		(Temp3 = InptPrsrEvalTree(FetchParameter(Root->Right, 2, 4),
							Level+1)) == NULL)
		return NULL;
	    /* Use table entries to call the function directly. */
	    (GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].Func)
			(&Temp1->U.R, Temp2->U.PObj->U.Str, &Temp3->U.R,
					FetchParameter(Root->Right, 3, 4));
	    Root->ObjType = UNDEF_OBJ;
	    return Root;

	case FORLOOP:
	    /* Note we cannt use dispatching in the loop mechanism as we */
	    /* transfer the procedure ParseTree structures...		 */
	    ForLoop(FetchParameter(Root->Right, 0, 4),
		    FetchParameter(Root->Right, 1, 4),
		    FetchParameter(Root->Right, 2, 4),
		    FetchParameter(Root->Right, 3, 4));

	    Root->ObjType = UNDEF_OBJ;
	    return Root;

	case PLUS:
	case MINUS:
	case MULT:
	case DIV:
	case POWER:
	    Root->ObjType = NUMERIC_OBJ;
	    if (((TempR = InptPrsrEvalTree(Root->Right, Level+1)) == NULL)
	     || ((TempL = InptPrsrEvalTree(Root->Left,  Level+1)) == NULL))
		return NULL;
	    Temp1 = OverLoadEvalOper(Root, TempR, TempL,
					&IPGlblEvalError, IPGlblCharData);
	    if (RetrieveMathError()) return NULL;
	    else return Temp1;

	case UNARMINUS:
	    Root->ObjType = NUMERIC_OBJ;
	    if ((TempR = InptPrsrEvalTree(Root->Right, Level+1)) == NULL)
		return NULL;
	    Temp1 = OverLoadEvalOper(Root, TempR, NULL,
					&IPGlblEvalError, IPGlblCharData);
	    if (RetrieveMathError()) return NULL;
	    else return Temp1;

	case NUMBER:
	    Root->ObjType = NUMERIC_OBJ;
            return Root;

	case PARAMETER:
	    if (Level == 0) {	      /* If only object - print its content. */
		PrintObject(Root->U.PObj);
		Root->ObjType = Root->U.PObj->ObjType;
		return Root;
	    }
	    switch(Root->U.PObj->ObjType) {
		case NUMERIC_OBJ:   /* In numeric var case - simply copy it. */
		    Root->ObjType = NUMERIC_OBJ;
		    Root->U.R = Root->U.PObj->U.R;
		    Root->NodeKind = NUMBER; /* Disconnect the var. binding. */
		    return Root;
                case GEOMETRIC_OBJ:
                case VECTOR_OBJ:
                case MATRIX_OBJ:
                case STRING_OBJ:
		case OBJ_LIST_OBJ:
		    Root->ObjType = Root->U.PObj->ObjType;
		    return Root;
	    }

	case STRING:
	    Root->ObjType = STRING_OBJ;
            return Root;

	case EQUAL:
	    if ((TempR = InptPrsrEvalTree(Root->Right, Level+1)) == NULL)
		return NULL;
	    TempL = Root->Left;
	    PPoly = NULL;
	    if (IS_UNDEF_OBJ(TempL->U.PObj))		  /* Its new object. */
		InsertObject(TempL->U.PObj);	   /* Insert to global vars. */
	    else
	    if (IS_GEOM_OBJ(TempL->U.PObj))    /* If old var. was geometric. */
		PPoly = TempL->U.PObj->U.Pl;

	    if (IS_GEOM_NODE(TempR) ||
		IS_VEC_NODE(TempR) ||
		IS_MAT_NODE(TempR) ||
		IS_STR_NODE(TempR) ||
		IS_OLST_NODE(TempR)) {
		if (TempL -> U.PObj == TempR -> U.PObj) return TempR;/* A=A. */
		TempL->ObjType = TempR->ObjType;
		CopyObject(TempL->U.PObj, TempR->U.PObj, FALSE);
	    }
	    else if (IS_NUM_NODE(TempR)) {
		TempL->ObjType = TempL->U.PObj->ObjType = NUMERIC_OBJ;
		TempL->U.PObj->U.R = TempR->U.R;
	    }
	    if (PPoly != NULL) MyFree((char *) (PPoly), POLYGON_TYPE);

	    Root->ObjType = UNDEF_OBJ;
	    return TempR;
    }
    return NULL;				    /* Makes warning silent. */
}

/*****************************************************************************
*   Routine to print help on the given subject HelpHeader.		     *
* Note a match is if the HelpHeader in prefix of help file line.	     *
*****************************************************************************/
static void PrintHelp(char *HelpHeader)
{
    int	i, Reset = TRUE;
    char *Path, s[LINE_LEN];
    FILE *f;

    Path = searchpath(HelpFileName);

    if ((f = fopen(Path, "r")) == NULL) {
	sprintf(s, "Cann't open help file %s\n", HelpFileName);
	WndwInputWindowPutStr(s, RED);
	return;
    }

    for (i=0; i<strlen(HelpHeader); i++)
	if (islower(HelpHeader[i])) HelpHeader[i] = toupper(HelpHeader[i]);

    while (fgets(s, LINE_LEN-1, f) != NULL) {
	for (i=0; i<strlen(HelpHeader); i++)
	    if (HelpHeader[i] != s[i]) break;
	if (i >= strlen(HelpHeader)) {		  /* Found match - print it. */
	    while (fgets(s, LINE_LEN-1, f) != NULL && s[0] != '$') {
		WndwInputWindowPutStrFS(&s[1], GREEN, Reset);/* Skip char 1. */
		Reset = FALSE;
	    }
	    return;
	}
    }

    sprintf(s, "No help on %s\n", HelpHeader);
    WndwInputWindowPutStr(s, RED);
}

/*****************************************************************************
*   Routine to execute the IF structure.				     *
*****************************************************************************/
static void IfCondition(RealType *Left, char *Cond, RealType *Right,
							ParseTree *PBody)
{
    int i, NumOfExpr;

    if (strcmp(Cond, "=")  == 0 && (*Left) != (*Right)) return;
    if (strcmp(Cond, "<>") == 0 && (*Left) == (*Right)) return;
    if (strcmp(Cond, "<=") == 0 && (*Left) >  (*Right)) return;
    if (strcmp(Cond, ">=") == 0 && (*Left) <  (*Right)) return;
    if (strcmp(Cond, ">")  == 0 && (*Left) <= (*Right)) return;
    if (strcmp(Cond, "<")  == 0 && (*Left) >= (*Right)) return;

    /* If we are here, then the condition holds: */
    for(i=0; i<(NumOfExpr = CountNumExpressions(PBody)); i++) {
	InptPrsrEvalTree(FetchExpression(PBody, i, NumOfExpr), 0);
	if (WasCtrlBrk ||		 /* async. break send from the user. */
	    IPGlblEvalError) break;
    }
}

/*****************************************************************************
*   Routine to execute the FOR structure loop.				     *
*   Note that as InptPrsrEvalTree routine is destructive on its input tree,  *
* we must make a copy of the body before executing it!			     *
*   We wish we could access the loop variable directly, but the user might   *
* be stupid and free it in the loop - so me must access it by name.	     *
*****************************************************************************/
static void ForLoop(ParseTree *PStart, ParseTree *PInc,
				   ParseTree *PEnd, ParseTree *PBody)
{
    int i, NumOfExpr, LoopCount;
    char *LoopVarName = NULL;
    RealType LoopVar, StartVal, Increment, EndVal;
    ParseTree *PTemp;
    ObjectStruct *PLoopVar;

    /* Find the only two cases where loop variable is allowed - when then */
    /* given starting value is a parameter, or assignment to parameter... */
    if (PStart -> NodeKind == PARAMETER) LoopVarName = PStart -> U.PObj -> Name;
    else
    if (PStart -> NodeKind == EQUAL && PStart -> Left -> NodeKind == PARAMETER)
	LoopVarName = PStart -> Left -> U.PObj -> Name;
    /* Rebind the iteration variable to body - it might be new: */
    RebindVariable(PBody, PStart -> Left -> U.PObj);

    PStart = InptPrsrEvalTree(PStart, 1);	 /* Evaluate starting value. */
    PInc   = InptPrsrEvalTree(PInc, 1);		/* Evaluate increment value. */
    PEnd   = InptPrsrEvalTree(PEnd, 1);		      /* Evaluate end value. */
    if (IPGlblEvalError ||
	PStart == NULL || PInc == NULL || PEnd == NULL) return;
    StartVal = PStart -> U.R;
    Increment = PInc -> U.R;
    EndVal = PEnd -> U.R;

    NumOfExpr = CountNumExpressions(PBody);    /* Num. of expr. in the body. */
    for (LoopVar = StartVal, LoopCount = 0;
	(Increment > 0 ? LoopVar <= EndVal : LoopVar >= EndVal);
	LoopVar += Increment, LoopCount++) {
	if (WasCtrlBrk ||		 /* Async. break send from the user. */
	    IPGlblEvalError || GlblFatalError) return;
	if (LoopVarName != NULL) {
	    if ((PLoopVar = GetObject(LoopVarName)) != NULL &&
		 IS_NUM_OBJ(PLoopVar))
		PLoopVar -> U.R = LoopVar; /* Update loop var. */
	    else {
		IPGlblEvalError = IE_ERR_ModifIterVar;
		strcpy(IPGlblCharData, LoopVarName);
	    }
	}

	for(i=0; i<NumOfExpr; i++) {
	    PTemp = FetchExpression(PBody, i, NumOfExpr);
	    if (LoopCount == 0 && InptPrsrTypeCheck(PTemp, 0) == ERROR_EXPR)
		return;
	    else {
		if (LoopVar == EndVal) {
		    /* Use the original tree. Note we must evaluate the      */
		    /* original tree at list once as ObjType's are updated.  */
		    InptPrsrEvalTree(PTemp, 0);	 /* Eval as its top level... */
		}
		else {
		    PTemp = InptPrsrCopyTree(PTemp);
		    InptPrsrEvalTree(PTemp, 0);	 /* Eval as its top level... */
		    InptPrsrFreeTree(PTemp);	     /* Not needed any more. */
		}
	    }
	}
    }
}

/*****************************************************************************
*   Routine to create an OBJECT LIST object out of all parameters.	     *
*****************************************************************************/
static struct ObjectStruct *GenObjectList(ParseTree *PObjParams)
{
    int i, NumOfParams;
    struct ParseTree *Param;
    struct ObjectStruct *PObj;

    NumOfParams = CountNumParameters(PObjParams);
    if (NumOfParams > MAX_OBJ_LIST) {
	IPGlblEvalError = IE_ERR_ListTooLong;
	return NULL;
    }

    PObj = AllocObject("", OBJ_LIST_OBJ, NULL);

    for(i=0; i<NumOfParams; i++) {
	Param = FetchParameter(PObjParams, i, NumOfParams);
	if (Param -> NodeKind != PARAMETER) {
	    IPGlblEvalError = IE_ERR_NonParamInList;
	    MyFree((char *) PObj, OBJECT_TYPE);
	    return NULL;
	}
	if (Param -> U.PObj -> ObjType == UNDEF_OBJ) {
	    IPGlblEvalError = IE_ERR_UndefObject;
	    strcpy(IPGlblCharData, Param -> U.PObj -> Name);
	    MyFree((char *) PObj, OBJECT_TYPE);
	    return NULL;
	}
	PObj -> U.PObjList[i] = Param -> U.PObj;
	Param -> U.PObj -> Count++;        /* Increase number of references. */
    }

    if (NumOfParams < MAX_OBJ_LIST) PObj -> U.PObjList[NumOfParams] = NULL;
    return PObj;
}

/*****************************************************************************
*   Routine to count number of expressions seperated by a COLON are given    *
* in the tree ROOT. This routine is similar to CountNumParameters below.     *
*****************************************************************************/
static int CountNumExpressions(ParseTree *Root)
{
    int i=1;

    while (Root->NodeKind == COLON) {
	i++;
	Root = Root->Right;
    }
    return i;
}

/*****************************************************************************
*   Routine to fetch the i expression out of a tree represent n expressions  *
* (0 <= i < n) seperated by colonc. Similar to FetchParameter routine below. *
*****************************************************************************/
static ParseTree *FetchExpression(ParseTree *Root, int i, int n)
{
    int j;

    for (j=0; j<i; j++) Root = Root->Right;

    if (i == n-1) return Root;
    else return Root->Left;
}

/*****************************************************************************
*   Routine to retrieve math error if was one. return TRUE if was error.     *
*****************************************************************************/
static int RetrieveMathError(void)
{
    int Error;
    char *FuncName;

#ifdef __MSDOS__
    if ((Error = MathError(&FuncName)) != 0) {
	switch (Error) {
	    case DOMAIN:
		strcpy(IPGlblCharData, "DOMAIN ");
		break;
	    case SING:
		strcpy(IPGlblCharData, "SING ");
		break;
	    case OVERFLOW:
		strcpy(IPGlblCharData, "O.F. ");
		break;
	    case UNDERFLOW:
		strcpy(IPGlblCharData, "U.F. ");
		break;
	    case TLOSS:
		strcpy(IPGlblCharData, "TLOSS ");
		break;
	    default:
		strcpy(IPGlblCharData, "Undef. ");
		break;
	}
	strcat(IPGlblCharData, "error - func. ");
	strcat(IPGlblCharData, FuncName);
	IPGlblEvalError = IE_ERR_FPError;
	return TRUE;
    }
#endif /* __MSDOS__ */

    return FALSE;
}

/*****************************************************************************
*   Routine to count number of paramters where given: parameters are defined *
* as subtrees seperated by commas, i.e.: the infix form 1, 2, 3, 4 is 	     *
* represented as [1, [2, [3, 4]]] in the tree supplied to this function and  *
* 4 (number of parameters) is returned.					     *
*****************************************************************************/
static int CountNumParameters(ParseTree *Root)
{
    int i=1;

    while (Root->NodeKind == COMMA) {
	i++;
	Root = Root->Right;
    }
    return i;
}

/*****************************************************************************
*   Routine to fetch the i paramter out of a tree represent n parameters     *
* (0 <= i < n). See CountNumParameters for more description of structure.    *
* Note it is assumed the tree HAS n parameters and 0<=i<n (No input error).  *
*****************************************************************************/
static ParseTree *FetchParameter(ParseTree *Root, int i, int n)
{
    int j;

    for (j=0; j<i; j++) Root = Root->Right;

    if (i == n-1) return Root;
    else return Root->Left;
}

/*****************************************************************************
*   Routine to test number of parameters and type of them against was is     *
* defined in its global tables Num/Obj/GenFuncTable. return TRUE if mismatch *
* was detected:								     *
*****************************************************************************/
static int FuncParamMismatch(ParseTree *Root)
{
    int FuncOffset, Count, i;

    switch(Root->NodeKind) {
	case ARCSIN:		       /* Numeric (real returned) functions. */
	case ARCCOS:
	case ARCTAN:
	case ARCTAN2:
	case COS:
	case EXP:
	case FABS:
	case LN:
	case LOG:
	case SIN:
	case SQRT:
	case TAN:

	case CPOLY:
	case AREA:
	case VOLUME:
	case TIME:
	    FuncOffset = Root->NodeKind-NUM_FUNC_OFFSET;
	    if (NumFuncTable[FuncOffset].NumOfParam == ANY_PARAM_NUM)
		return FALSE;
	    /* See if number of parameters is ok: */
	    if ((Count = CountNumParameters(Root->Right)) !=
		NumFuncTable[FuncOffset].NumOfParam) {
		IPGlblEvalError = IE_ERR_NumPrmMismatch;
		sprintf(IPGlblCharData, "Func %s - %d expected, %d found",
			NumFuncTable[FuncOffset].FuncName,
			NumFuncTable[FuncOffset].NumOfParam,
			Count);
		return TRUE;
	    }
	    /* See if type of parameters is consistent: */
	    for (i=0; i<Count; i++) {
		if (NumFuncTable[FuncOffset].ParamObjType[i] == ANY_OBJ)
		    continue;
		if (NumFuncTable[FuncOffset].ParamObjType[i] !=
		    InptPrsrTypeCheck(FetchParameter(Root->Right, i, Count),
									1)) {
		    IPGlblEvalError = IE_ERR_TypeMismatch;
		    sprintf(IPGlblCharData, "Func %s, parameter %d",
			NumFuncTable[FuncOffset].FuncName, i+1);
		    return TRUE;
		}
	    }
	    return FALSE;

	case VECTOR:			     /* Object (returned) functions. */

	case ROTX:
	case ROTY:
	case ROTZ:

	case TRANS:
	case SCALE:

	case BOX:
	case GBOX:
	case CONE:
	case CYLIN:
	case SPHERE:
	case TORUS:
	case PLANE:
	case POLY:
	case CROSSEC:
	case SURFREV:
	case EXTRUDE:
	case LIST:
	case LOAD:
	case CONVEX:
	    FuncOffset = Root->NodeKind-OBJ_FUNC_OFFSET;
	    if (ObjFuncTable[FuncOffset].NumOfParam == ANY_PARAM_NUM)
		return FALSE;
	    /* See if number of parameters is ok: */
	    if ((Count = CountNumParameters(Root->Right)) !=
		ObjFuncTable[FuncOffset].NumOfParam) {
		IPGlblEvalError = IE_ERR_NumPrmMismatch;
		sprintf(IPGlblCharData, "Func %s - %d expected, %d found",
			ObjFuncTable[FuncOffset].FuncName,
			ObjFuncTable[FuncOffset].NumOfParam,
			Count);
		return TRUE;
	    }
	    /* See if type of parameters is consistent: */
	    for (i=0; i<Count; i++) {
		if (ObjFuncTable[FuncOffset].ParamObjType[i] == ANY_OBJ)
		    continue;
		if (ObjFuncTable[FuncOffset].ParamObjType[i] !=
		    InptPrsrTypeCheck(FetchParameter(Root->Right, i, Count),
									1)) {
		    IPGlblEvalError = IE_ERR_TypeMismatch;
		    sprintf(IPGlblCharData, "Func %s, parameter %d",
			ObjFuncTable[FuncOffset].FuncName, i+1);
		    return TRUE;
		}
	    }
	    return FALSE;

	case EXIT:
	case VIEW:
	case DIR:
	case CHDIR:
	case NORMAL:
	case INCLUDE:
	case GDUMP:
	case MDUMP:
	case FREEOBJ:
	case INTERACT:
	case PAUSE:
	case IFCOND:
	case FORLOOP:
	case PRHELP:
	case VARLIST:
	case ALIAS:
	case BEEP:
	case EDIT:
	case LOGFILE:
	case COLOR:
	    FuncOffset = Root->NodeKind-GEN_FUNC_OFFSET;
	    if (GenFuncTable[FuncOffset].NumOfParam == ANY_PARAM_NUM)
		return FALSE;
	    /* See if number of parameters is ok: */
	    if ((Count = CountNumParameters(Root->Right)) !=
		GenFuncTable[FuncOffset].NumOfParam) {
		IPGlblEvalError = IE_ERR_NumPrmMismatch;
		sprintf(IPGlblCharData, "Func %s - %d expected, %d found",
			GenFuncTable[FuncOffset].FuncName,
			GenFuncTable[FuncOffset].NumOfParam,
			Count);
		return TRUE;
	    }
	    /* See if type of parameters is consistent: */
	    for (i=0; i<Count; i++) {
		if (GenFuncTable[FuncOffset].ParamObjType[i] == ANY_OBJ) continue;
		if (GenFuncTable[FuncOffset].ParamObjType[i] !=
		    InptPrsrTypeCheck(FetchParameter(Root->Right, i, Count),
									1)) {
		    IPGlblEvalError = IE_ERR_TypeMismatch;
		    sprintf(IPGlblCharData, "Func %s, parameter %d",
			GenFuncTable[FuncOffset].FuncName, i+1);
		    return TRUE;
		}
	    }
	    return FALSE;
	default:
	    IPGlblEvalError = IE_ERR_FatalError;
	    UpdateCharError("Undefined function - ", Root->NodeKind);
	    return TRUE;
    }
}

/*****************************************************************************
*   Routine to free a tree - release all memory	allocated by it.	     *
*****************************************************************************/
void InptPrsrFreeTree(ParseTree *Root)
{
    char s[LINE_LEN];

    if (!Root) return;

    switch (Root -> NodeKind) {
	case ARCSIN:
	case ARCCOS:
	case ARCTAN:
	case ARCTAN2:
	case COS:
	case EXP:
	case FABS:
	case LN:
	case LOG:
	case SIN:
	case SQRT:
	case TAN:

	case CPOLY:
	case AREA:
	case VOLUME:
	case TIME:

	case VECTOR:

	case ROTX:
	case ROTY:
	case ROTZ:
	case TRANS:
	case SCALE:

	case BOX:
	case GBOX:
	case CONE:
	case CYLIN:
	case SPHERE:
	case TORUS:
	case PLANE:
	case POLY:
	case CROSSEC:
	case SURFREV:
	case EXTRUDE:
	case LIST:
	case LOAD:
	case CONVEX:

	case DIR:
	case CHDIR:
	case NORMAL:
	case INCLUDE:
	case GDUMP:
	case MDUMP:
	case FREEOBJ:
	case VIEW:
	case INTERACT:
	case IFCOND:
	case FORLOOP:
	case PRHELP:
	case PAUSE:
	case ALIAS:
	case BEEP:
	case EDIT:
	case LOGFILE:
	case COLOR:
	    InptPrsrFreeTree(Root->Right);
	    if ((Root->ObjType == VECTOR_OBJ ||
		 Root->ObjType == MATRIX_OBJ ||
		 Root->ObjType == GEOMETRIC_OBJ ||
		 Root->ObjType == OBJ_LIST_OBJ) &&
		strlen(Root->U.PObj->Name) == 0)
		MyFree((char *) Root->U.PObj, OBJECT_TYPE);/* Its temporary. */
	    MyExprFree(Root);
	    break;

	case EXIT:
	case SYSTEM:
	case VARLIST:
	    MyExprFree(Root);
	    break;

	case DIV:
	case MINUS:
	case MULT:
	case PLUS:
	case POWER:
	    InptPrsrFreeTree(Root->Right);
	    InptPrsrFreeTree(Root->Left);
	    if ((Root->ObjType == VECTOR_OBJ ||
		 Root->ObjType == MATRIX_OBJ ||
		 Root->ObjType == GEOMETRIC_OBJ ||
		 Root->ObjType == OBJ_LIST_OBJ) &&
		strlen(Root->U.PObj->Name) == 0)
		MyFree((char *) Root->U.PObj, OBJECT_TYPE);/* Its temporary. */
	    MyExprFree(Root);
	    break;

	case UNARMINUS:
	    InptPrsrFreeTree(Root->Right);
	    if ((Root->ObjType == VECTOR_OBJ ||
		 Root->ObjType == MATRIX_OBJ ||
		 Root->ObjType == GEOMETRIC_OBJ ||
		 Root->ObjType == OBJ_LIST_OBJ) &&
		strlen(Root->U.PObj->Name) == 0)
		MyFree((char *) Root->U.PObj, OBJECT_TYPE);/* Its temporary. */
	    MyExprFree(Root);
	    break;

	case COMMA:
	case COLON:
	case EQUAL:
	    InptPrsrFreeTree(Root->Right);
	    InptPrsrFreeTree(Root->Left);
	    MyExprFree(Root);
	    break;

	case NUMBER:
	    MyExprFree(Root);
	    break;

	case PARAMETER:
	    if (Root->U.PObj &&
		(Root->U.PObj->ObjType == UNDEF_OBJ ||/*No assign took place.*/
		 strlen(Root->U.PObj->Name) == 0))	   /* Its temporary. */
		MyFree((char *) Root->U.PObj, OBJECT_TYPE);
	    MyExprFree(Root);
	    break;

	case STRING:
	    MyFree((char *) Root->U.PObj, OBJECT_TYPE);/* The string object. */
	    MyExprFree(Root);
	    break;

	case TOKENSTART:
	    MyExprFree(Root);
	    break;

	case OPENPARA:
	case CLOSPARA:
	    MyExprFree(Root);
	    break;

	default:
	    /*   We might free partially build (by InptPrsr) tree when error */
	    /* is detected, and such tree may have nodes with NodeKind>=1000.*/
	    if (Root->NodeKind >= 1000) {
		MyExprFree(Root);
	    }
	    else {
		sprintf(s, "%s (%d).\n",
		    "InptPrsrFreeTree: Undefined ParseTree type to free",
		    Root -> NodeKind);
		FatalError(s);
	    }
	    break;
    }
}

/*****************************************************************************
*   Routine to print a content of ROOT (using inorder traversal):	     *
* level	holds: 0 for lowest level +/-, 1 for *, /, 2 for ^ operations.	     *
* If *str = NULL print on stderr, else on given	string Str.		     *
*****************************************************************************/
void InptPrsrPrintTree(ParseTree *Root, char *Str)
{
    strcpy(IPGlblCharData, "");			   /* Make the string empty. */

    if (Str == NULL) {
	strcpy(IPGlblCharData, "");		   /* Make the string empty. */
	LocalPrintTree(Root, 0, IPGlblCharData);       /* Copy to local str. */
	fprintf(stderr, IPGlblCharData);		     /* and print... */
    }
    else {
	strcpy(Str, "");			   /* Make the string empty. */
	LocalPrintTree(Root, 0, Str); /* Dont print to stderr - copy to str. */
    }
}

/*****************************************************************************
*   Routine to print a content of ROOT (using inorder traversal):	     *
* level	holds: 0 for lowest level +/-, 1 for *, /, 2 for ^ operations.	     *
* It is assumed Str has at list LINE_LEN_LONG places to write the expression.*
*****************************************************************************/
static void LocalPrintTree(ParseTree *Root, int Level, char *Str)
{
    int	CloseFlag = FALSE, Len;

    if (!Root) return;
    if ((Len = strlen(Str)) > LINE_LEN_LONG * 2 / 3)/* Prevent from overflow.*/
	if (Str[Len-1] == '.') return;   /* "..." was allready concatenated. */
	else {
	    strcat(Str, "...");
	    return;
	}

#   ifdef DEBUG
	strcat(Str, "[");   /* Usefull to see ALL nestings - no preceedings. */
#   endif /* DEBUG */

    switch(Root->NodeKind) {
	case ARCCOS:
	case ARCSIN:
	case ARCTAN:
	case ARCTAN2:
	case COS:
	case EXP:
	case FABS:
	case LN:
	case LOG:
	case SIN:
	case SQRT:
	case TAN:

	case CPOLY:
	case AREA:
	case VOLUME:
	case TIME:
	    Level = 0;
	    CloseFlag = TRUE;
            strcat(Str, NumFuncTable[Root->NodeKind-NUM_FUNC_OFFSET].FuncName);
	    strcat(Str, "(");
	    break;

	case VECTOR:

	case ROTX:
	case ROTY:
	case ROTZ:
	case TRANS:
	case SCALE:

	case BOX:
	case GBOX:
	case CONE:
	case CYLIN:
	case SPHERE:
	case TORUS:
	case PLANE:
	case POLY:
	case CROSSEC:
	case SURFREV:
	case EXTRUDE:
	case LIST:
	case LOAD:
	case CONVEX:
	    Level = 0;
	    CloseFlag = TRUE;
            strcat(Str, ObjFuncTable[Root->NodeKind-OBJ_FUNC_OFFSET].FuncName);
	    strcat(Str, "(");
	    break;

	case VIEW:
	case DIR:
	case CHDIR:
	case NORMAL:
	case INCLUDE:
	case GDUMP:
	case MDUMP:
	case FREEOBJ:
	case INTERACT:
	case IFCOND:
	case FORLOOP:
	case PRHELP:
	case PAUSE:
	case ALIAS:
	case BEEP:
	case EDIT:
	case LOGFILE:
	case COLOR:
	    Level = 0;
	    CloseFlag = TRUE;
            strcat(Str, GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].FuncName);
	    strcat(Str, "(");
	    break;

	case EXIT:
	case SYSTEM:
	case VARLIST:
            strcat(Str, GenFuncTable[Root->NodeKind-GEN_FUNC_OFFSET].FuncName);
	    strcat(Str, "()");		   /* procedures with no parameters. */
	    return;

	case DIV:
	    if (Level > 1) {
		strcat(Str, "(");
	        CloseFlag = TRUE;
	    }
	    Level = 1;					       /* Div Level. */
	    LocalPrintTree(Root->Left, Level, Str);
	    strcat(Str, "/");
	    break;

	case MINUS:
	    if (Level > 0) {
		strcat(Str, "(");
	        CloseFlag = TRUE;
	    }
	    Level = 0;					     /* Minus Level. */
	    LocalPrintTree(Root->Left, Level, Str);
	    strcat(Str, "-");
	    break;

	case MULT:
	    if (Level > 1) {
		strcat(Str, "(");
	        CloseFlag = TRUE;
	    }
	    Level = 1;					       /* Mul Level. */
	    LocalPrintTree(Root->Left, Level, Str);
	    strcat(Str, "*");
	    break;

	case PLUS:
	    if (Level > 0) {
		strcat(Str, "(");
	        CloseFlag = TRUE;
	    }
	    Level = 0;					      /* Plus Level. */
	    LocalPrintTree(Root->Left, Level, Str);
	    strcat(Str, "+");
	    break;

	case POWER:
	    Level = 2;					     /* Power Level. */
	    LocalPrintTree(Root->Left, Level, Str);
	    strcat(Str, "^");
	    break;

	case UNARMINUS:
	    strcat(Str, "(-");
	    Level = 0;
	    CloseFlag = TRUE;
	    break;

	case COMMA:
	    LocalPrintTree(Root->Left, Level, Str);
	    strcat(Str, ",");
	    break;

	case COLON:
	    LocalPrintTree(Root->Left, Level, Str);
	    strcat(Str, ":");
	    break;

	case EQUAL:
	    LocalPrintTree(Root->Left, Level, Str);
	    strcat(Str, "=");
	    break;

	case NUMBER:
	    sprintf(&Str[strlen(Str)], "%lg", Root->U.R);
	    break;

	case PARAMETER:
	    sprintf(&Str[strlen(Str)], "%s", Root->U.PObj->Name);
	    break;

	case STRING:
	    sprintf(&Str[strlen(Str)], "\"%s\"", Root->U.PObj->U.Str);
	    break;

	case OPENPARA:
	    strcat(Str, "(");
	    break;

	case CLOSPARA:
	    strcat(Str, ")");
	    break;

	case TOKENSTART:
	    break;

	default:
	    FatalError("LocalPrintTree: Undefined ParseTree type to print, exit");
    }
    LocalPrintTree(Root->Right, Level, Str);
    if (CloseFlag) strcat(Str, ")");

#   ifdef DEBUG
	strcat(Str, "]");   /* Usefull to see ALL nestings - no preceedings. */
#   endif /* DEBUG */
}

/*****************************************************************************
*   Routine to copy a parse tree - Generate brand new ParseTree structure    *
* but bind to non-temp variables if they are exists - their Name is not NULL *
*   This means that updating these objects in the copied tree, will affect   *
* these objects in the original tree.					     *
*****************************************************************************/
ParseTree *InptPrsrCopyTree(ParseTree *Root)
{
    struct ParseTree *NewRoot;

    if (Root == NULL) return NULL;

    NewRoot = MyExprMalloc();

    switch(Root->NodeKind) {
	case ARCSIN:
	case ARCCOS:
	case ARCTAN:
	case ARCTAN2:
	case COS:
	case EXP:
	case FABS:
	case LN:
	case LOG:
	case SIN:
	case SQRT:
	case TAN:
	case CPOLY:
	case AREA:
	case VOLUME:
	case TIME:

	case VECTOR:

	case ROTX:
	case ROTY:
	case ROTZ:
	case TRANS:
	case SCALE:

	case BOX:
	case GBOX:
	case CONE:
	case CYLIN:
	case SPHERE:
	case TORUS:
	case PLANE:
	case POLY:
	case CROSSEC:
	case SURFREV:
	case EXTRUDE:
	case LIST:
	case LOAD:
	case CONVEX:

	case VIEW:
	case DIR:
	case CHDIR:
	case NORMAL:
	case INCLUDE:
	case GDUMP:
	case MDUMP:
	case FREEOBJ:
	case INTERACT:
	case IFCOND:
	case FORLOOP:
	case PRHELP:
	case PAUSE:
	case ALIAS:
	case BEEP:
	case EDIT:
	case LOGFILE:
	case COLOR:

	case UNARMINUS:
	    NewRoot -> NodeKind = Root -> NodeKind;
	    NewRoot -> ObjType = Root -> ObjType;
	    NewRoot -> Right = InptPrsrCopyTree(Root -> Right);
	    return NewRoot;

	case EXIT:
	case SYSTEM:
	case VARLIST:
	    NewRoot -> NodeKind = Root -> NodeKind;
	    NewRoot -> ObjType = Root -> ObjType;
	    return NewRoot;

	case DIV:
	case MINUS:
	case MULT:
	case PLUS:
	case POWER:

	case COMMA:
	case COLON:
	case EQUAL:
	    NewRoot -> NodeKind = Root -> NodeKind;
	    NewRoot -> ObjType = Root -> ObjType;
	    NewRoot -> Right = InptPrsrCopyTree(Root -> Right);
	    NewRoot -> Left  = InptPrsrCopyTree(Root -> Left);
	    return NewRoot;

	case NUMBER:
	    NewRoot -> NodeKind = Root -> NodeKind;
	    NewRoot -> ObjType = Root -> ObjType;
	    NewRoot -> U.R = Root -> U.R;
	    return NewRoot;

	case PARAMETER:
	case STRING:
	    NewRoot -> NodeKind = Root -> NodeKind;
	    NewRoot -> ObjType = Root -> ObjType;
	    NewRoot -> U.PObj = Root -> U.PObj;	    /* Point on SAME object. */
	    return NewRoot;

	case TOKENSTART:
	    NewRoot -> NodeKind = Root -> NodeKind;
	    NewRoot -> ObjType = Root -> ObjType;
	    return NewRoot;

	default:
	    FatalError("InptPrsrCopyTree: Undefined ParseTree type to copy, exit\n");
    }
    return NULL;				    /* Makes warning silent. */
}

/*****************************************************************************
*  Routine to rebind a variable - given a tree, scan it and update each      *
* occurance of that variable to point to PObj.				     *
*****************************************************************************/
static void RebindVariable(ParseTree *Root, ObjectStruct *PObj)
{
    if (Root == NULL) return;

    switch(Root->NodeKind) {
	case ARCSIN:
	case ARCCOS:
	case ARCTAN:
	case ARCTAN2:
	case COS:
	case EXP:
	case FABS:
	case LN:
	case LOG:
	case SIN:
	case SQRT:
	case TAN:
	case CPOLY:
	case AREA:
	case VOLUME:
	case TIME:

	case VECTOR:

	case ROTX:
	case ROTY:
	case ROTZ:
	case TRANS:
	case SCALE:

	case BOX:
	case GBOX:
	case CONE:
	case CYLIN:
	case SPHERE:
	case TORUS:
	case PLANE:
	case POLY:
	case CROSSEC:
	case SURFREV:
	case EXTRUDE:
	case LIST:
	case LOAD:
	case CONVEX:

	case VIEW:
	case DIR:
	case CHDIR:
	case NORMAL:
	case INCLUDE:
	case GDUMP:
	case MDUMP:
	case FREEOBJ:
	case INTERACT:
	case IFCOND:
	case FORLOOP:
	case PRHELP:
	case PAUSE:
	case ALIAS:
	case BEEP:
	case EDIT:
	case LOGFILE:
	case COLOR:

	case UNARMINUS:
	    RebindVariable(Root -> Right, PObj);
	    return;

	case EXIT:
	case SYSTEM:
	case VARLIST:
	    return;

	case DIV:
	case MINUS:
	case MULT:
	case PLUS:
	case POWER:

	case COMMA:
	case COLON:
	case EQUAL:
	    RebindVariable(Root -> Right, PObj);
	    RebindVariable(Root -> Left, PObj);
	    return;

	case NUMBER:
	    return;

	case PARAMETER:
	case STRING:
	    if (strcmp(Root -> U.PObj -> Name, PObj -> Name) == 0) {
		/* I wish I cound free that, but nesting loops might try */
		/* to free the same place n times... We will loose this  */
		/* variable place if it defined for the first time. Fix  */
		/* it if you really care...				 */
		/*
		if (IS_UNDEF_OBJ(Root -> U.PObj))
		    MyFree((char *) Root->U.PObj, OBJECT_TYPE);
		*/
		Root -> U.PObj = PObj;
	    }
            return;

	case TOKENSTART:
	    return;

	default:
	    FatalError("RebindVariable: Undefined ParseTree type, exit\n");
    }
}

/*****************************************************************************
*   Routine to return evaluation error if happen one, zero elsewhere	     *
*****************************************************************************/
int InptPrsrEvalError(char **Message)
{
    int	Temp;

    *Message = IPGlblCharData;
    Temp = IPGlblEvalError;
    IPGlblEvalError = 0;
    return Temp;
}
