void PrefabWithMesh_Plant::_setRotation( const wstring & attribute, const wstring & value )
{
static rotation_struct rot;
if (attribute == x_rot)
{
rot.x_rot = ValueToDouble(value);
} else if (attribute == y_rot)
{
rot.y_rot = ValueToDouble(value);
} else if (attribute == z_rot)
{
rot.z_rot = ValueToDouble(value);
} else if (attribute == closeNode)
{
if (_prefabWithMesh == NULL)
{
throw("PrefabWithMesh SetRotation: try to use uninitialized prefab");
}
_prefabWithMesh->setRotation(rot);
rot.x_rot = rot.y_rot = rot.z_rot = 0;
} else
{
throw My_Exception("PrefabPlantWithMesh _setRotation: Missing attribute type");
}
}
void PrefabWithMesh_Plant::_setScale( const wstring & attribute, const wstring & value )
{
static Vector3 scale;
if (attribute == x_scale)
{
scale.x = ValueToDouble(value);
} else if (attribute == y_scale)
{
scale.y = ValueToDouble(value);
} else if (attribute == z_scale)
{
scale.z = ValueToDouble(value);
} else if (attribute == closeNode)
{
if (_prefabWithMesh == NULL)
{
throw("PrefabWithMesh SetScale: try to use uninitialized prefab");
}
_prefabWithMesh->setScale(scale);
scale.x = scale.y = scale.z = 0.0;
} else
{
throw My_Exception("PrefabWithMesh_Plant _setScale: Missing attribute type");
}
}
globle void AdditionFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
double ftotal = 0.0;
long ltotal = 0L;
intBool useFloatTotal = FALSE;
EXPRESSION *theExpression;
DATA_OBJECT theArgument;
int pos = 1;
/*=================================================*/
/* Loop through each of the arguments adding it to */
/* a running total. If a floating point number is */
/* encountered, then do all subsequent operations */
/* using floating point values. */
/*=================================================*/
theExpression = GetFirstArgument();
while (theExpression != NULL)
{
if (! GetNumericArgument(theEnv,theExpression,"+",&theArgument,useFloatTotal,pos)) theExpression = NULL;
else theExpression = GetNextArgument(theExpression);
if (useFloatTotal)
{ ftotal += ValueToDouble(theArgument.value); }
else
{
if (theArgument.type == INTEGER)
{ ltotal += ValueToLong(theArgument.value); }
else
{
ftotal = (double) ltotal + ValueToDouble(theArgument.value);
useFloatTotal = TRUE;
}
}
pos++;
}
/*======================================================*/
/* If a floating point number was in the argument list, */
/* then return a float, otherwise return an integer. */
/*======================================================*/
if (useFloatTotal)
{
returnValue->type = FLOAT;
returnValue->value = (void *) EnvAddDouble(theEnv,ftotal);
}
else
{
returnValue->type = INTEGER;
returnValue->value = (void *) EnvAddLong(theEnv,ltotal);
}
}
static void *FindDefaultValue(
void *theEnv,
int theType,
CONSTRAINT_RECORD *theConstraints,
void *standardDefault)
{
struct expr *theList;
/*=====================================================*/
/* Look on the the allowed values list to see if there */
/* is a value of the requested type. Return the first */
/* value found of the requested type. */
/*=====================================================*/
theList = theConstraints->restrictionList;
while (theList != NULL)
{
if (theList->type == theType) return(theList->value);
theList = theList->nextArg;
}
/*=============================================================*/
/* If no specific values were available for the default value, */
/* and the type requested is a float or integer, then use the */
/* range attribute to select a default value. */
/*=============================================================*/
if (theType == INTEGER)
{
if (theConstraints->minValue->type == INTEGER)
{ return(theConstraints->minValue->value); }
else if (theConstraints->minValue->type == FLOAT)
{ return(EnvAddLong(theEnv,(long long) ValueToDouble(theConstraints->minValue->value))); }
else if (theConstraints->maxValue->type == INTEGER)
{ return(theConstraints->maxValue->value); }
else if (theConstraints->maxValue->type == FLOAT)
{ return(EnvAddLong(theEnv,(long long) ValueToDouble(theConstraints->maxValue->value))); }
}
else if (theType == FLOAT)
{
if (theConstraints->minValue->type == FLOAT)
{ return(theConstraints->minValue->value); }
else if (theConstraints->minValue->type == INTEGER)
{ return(EnvAddDouble(theEnv,(double) ValueToLong(theConstraints->minValue->value))); }
else if (theConstraints->maxValue->type == FLOAT)
{ return(theConstraints->maxValue->value); }
else if (theConstraints->maxValue->type == INTEGER)
{ return(EnvAddDouble(theEnv,(double) ValueToLong(theConstraints->maxValue->value))); }
}
/*======================================*/
/* Use the standard default value (such */
/* as nil if symbols are allowed). */
/*======================================*/
return(standardDefault);
}
globle double FloatFunction(
void *theEnv)
{
DATA_OBJECT valstruct;
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,"float",EXACTLY,1) == -1) return(0.0);
/*================================================================*/
/* Check for the correct type of argument. Note that ArgTypeCheck */
/* will convert integers to floats when a float is requested */
/* (which is the purpose of the float function). */
/*================================================================*/
if (EnvArgTypeCheck(theEnv,"float",1,FLOAT,&valstruct) == FALSE) return(0.0);
/*================================================*/
/* Return the numeric value converted to a float. */
/*================================================*/
return(ValueToDouble(valstruct.value));
}
void get_argument(void* env, int argposition, Values& values) {
DATA_OBJECT arg;
if (EnvArgTypeCheck(env, (char *)"clipsmm get_argument",
argposition, MULTIFIELD, &arg) == 0) return;
values.clear();
int end = EnvGetDOEnd(env, arg);
void *mfp = EnvGetValue(env, arg);
for (int i = EnvGetDOBegin(env, arg); i <= end; ++i) {
switch (GetMFType(mfp, i)) {
case SYMBOL:
case STRING:
case INSTANCE_NAME:
values.push_back(Value(ValueToString(GetMFValue(mfp, i))));
break;
case FLOAT:
values.push_back(Value(ValueToDouble(GetMFValue(mfp, i))));
break;
case INTEGER:
values.push_back(Value(ValueToInteger(GetMFValue(mfp, i))));
break;
default:
continue;
break;
}
}
}
void GLScreenElement::setValue(const char * key,Value value){
if(strcmp(key, "zPosition") == 0){
_zPosition = ValueToDouble(value, 0);
}
else {
GLCanvasElement::setValue(key,value);
}
}
void MovablePrefab_Plant::_setMaxAngleVelocity( const wstring & attribute, const wstring & value )
{
if (attribute == PrefabPlant::value)
{
double val;
val = ValueToDouble(value);
_MovablePrefab->setMaxAngleVelocity(val);
};
}
void MovablePrefab_Plant::_setMaxAcceleration( const wstring & attribute, const wstring & value )
{
if (attribute == PrefabPlant::value)
{
double val;
val = ValueToDouble(value);
_MovablePrefab->setMaxAcceleration(val);
};
}
unsigned long GetAtomicHashValue(
unsigned short type,
void *value,
int position)
{
unsigned long tvalue;
union
{
double fv;
void *vv;
unsigned long liv;
} fis;
switch (type)
{
case FLOAT:
fis.liv = 0;
fis.fv = ValueToDouble(value);
tvalue = fis.liv;
break;
case INTEGER:
tvalue = (unsigned long) ValueToLong(value);
break;
case EXTERNAL_ADDRESS:
fis.liv = 0;
fis.vv = ValueToExternalAddress(value);
tvalue = (unsigned long) fis.liv;
break;
case FACT_ADDRESS:
#if OBJECT_SYSTEM
case INSTANCE_ADDRESS:
#endif
fis.liv = 0;
fis.vv = value;
tvalue = (unsigned long) fis.liv;
break;
case STRING:
#if OBJECT_SYSTEM
case INSTANCE_NAME:
#endif
case SYMBOL:
tvalue = ((SYMBOL_HN *) value)->bucket;
break;
default:
tvalue = type;
}
if (position < 0) return(tvalue);
return((unsigned long) (tvalue * (((unsigned long) position) + 29)));
}
globle void ModFunction(
void *theEnv,
DATA_OBJECT_PTR result)
{
DATA_OBJECT item1, item2;
double fnum1, fnum2;
long long lnum1, lnum2;
if (EnvArgCountCheck(theEnv,"mod",EXACTLY,2) == -1)
{
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if (EnvArgTypeCheck(theEnv,"mod",1,INTEGER_OR_FLOAT,&item1) == FALSE)
{
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if (EnvArgTypeCheck(theEnv,"mod",2,INTEGER_OR_FLOAT,&item2) == FALSE)
{
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if (((item2.type == INTEGER) ? (ValueToLong(item2.value) == 0L) : FALSE) ||
((item2.type == FLOAT) ? ValueToDouble(item2.value) == 0.0 : FALSE))
{
DivideByZeroErrorMessage(theEnv,"mod");
SetEvaluationError(theEnv,TRUE);
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if ((item1.type == FLOAT) || (item2.type == FLOAT))
{
fnum1 = CoerceToDouble(item1.type,item1.value);
fnum2 = CoerceToDouble(item2.type,item2.value);
result->type = FLOAT;
result->value = (void *) EnvAddDouble(theEnv,fnum1 - (dtrunc(fnum1 / fnum2) * fnum2));
}
else
{
lnum1 = DOToLong(item1);
lnum2 = DOToLong(item2);
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,lnum1 - (lnum1 / lnum2) * lnum2);
}
}
void MovablePrefab_Plant::_setThrusterOffset( const wstring & attribute, const wstring & value )
{
if (attribute == PrefabPlant::x_pos)
{
thr_offset.x= ValueToDouble(value);
} else if (attribute == PrefabPlant::y_pos)
{
thr_offset.y = ValueToDouble(value);
} else if (attribute == PrefabPlant::z_pos)
{
thr_offset.z = ValueToDouble(value);
} else if (attribute == PrefabPlant::closeNode)
{
_MovablePrefab->setThrusterOffset(thr_offset);
} else
{
wstring tmp(L"MovablePrefab_Plant _setThrusterOffset: Missing attribute type: ");
tmp += attribute;
throw My_Exception(tmp);
}
}
void PrefabWithCollider_Plant::_setColliderOffset( const wstring & attribute, const wstring & value )
{
if (attribute == PrefabPlant::x_pos)
{
Collider_str.offset.x= ValueToDouble(value);
} else if (attribute == PrefabPlant::y_pos)
{
Collider_str.offset.y = ValueToDouble(value);
} else if (attribute == PrefabPlant::z_pos)
{
Collider_str.offset.z = ValueToDouble(value);
} else if (attribute == PrefabPlant::closeNode)
{
return;
} else
{
wstring tmp(L"PrefabWithCollider_Plant _setColliderOffset: Missing attribute type: ");
tmp += attribute;
throw My_Exception(tmp);
}
}
globle void AbsFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,"abs",EXACTLY,1) == -1)
{
returnValue->type = INTEGER;
returnValue->value = (void *) EnvAddLong(theEnv,0L);
return;
}
/*======================================*/
/* Check that the argument is a number. */
/*======================================*/
if (EnvArgTypeCheck(theEnv,"abs",1,INTEGER_OR_FLOAT,returnValue) == FALSE)
{
returnValue->type = INTEGER;
returnValue->value = (void *) EnvAddLong(theEnv,0L);
return;
}
/*==========================================*/
/* Return the absolute value of the number. */
/*==========================================*/
if (returnValue->type == INTEGER)
{
if (ValueToLong(returnValue->value) < 0L)
{ returnValue->value = (void *) EnvAddLong(theEnv,- ValueToLong(returnValue->value)); }
}
else if (ValueToDouble(returnValue->value) < 0.0)
{ returnValue->value = (void *) EnvAddDouble(theEnv,- ValueToDouble(returnValue->value)); }
}
globle long EnvRtnLong(
void *theEnv,
int argumentPosition)
{
int count = 1;
DATA_OBJECT result;
struct expr *argPtr;
/*=====================================================*/
/* Find the appropriate argument in the argument list. */
/*=====================================================*/
for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList;
(argPtr != NULL) && (count < argumentPosition);
argPtr = argPtr->nextArg)
{ count++; }
if (argPtr == NULL)
{
NonexistantError(theEnv,"RtnLong",
ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
argumentPosition);
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
return(1L);
}
/*======================================*/
/* Return the value of the nth argument */
/* if it is a float or integer. */
/*======================================*/
EvaluateExpression(theEnv,argPtr,&result);
if (result.type == FLOAT)
{ return((long) ValueToDouble(result.value)); }
else if (result.type == INTEGER)
{ return(ValueToLong(result.value)); }
/*======================================================*/
/* Generate an error if the argument is the wrong type. */
/*======================================================*/
ExpectedTypeError3(theEnv,"RtnLong",
ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
argumentPosition,"number");
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
return(1L);
}
globle long long RoundFunction(
void *theEnv)
{
DATA_OBJECT result;
if (EnvArgCountCheck(theEnv,"round",EXACTLY,1) == -1)
{ return(0LL); }
if (EnvArgTypeCheck(theEnv,"round",1,INTEGER_OR_FLOAT,&result) == FALSE)
{ return(0LL); }
if (result.type == INTEGER)
{ return(ValueToLong(result.value)); }
else
{ return((long long) ceil(ValueToDouble(result.value) - 0.5)); }
}
unsigned int GetAtomicHashValue(
int type,
void *value,
int position)
{
unsigned int tvalue;
union
{
double fv;
unsigned int liv;
} fis;
switch (type)
{
case FLOAT:
fis.fv = ValueToDouble(value);
tvalue = fis.liv;
break;
case INTEGER:
tvalue = (unsigned int) ValueToLong(value);
break;
case FACT_ADDRESS:
#if OBJECT_SYSTEM
case INSTANCE_ADDRESS:
#endif
case EXTERNAL_ADDRESS:
tvalue = (unsigned int) value;
break;
case STRING:
#if OBJECT_SYSTEM
case INSTANCE_NAME:
#endif
case SYMBOL:
tvalue = ((SYMBOL_HN *) value)->bucket;
break;
default:
tvalue = type;
}
if (position < 0) return(tvalue);
return((unsigned int) (tvalue * (position + 29)));
}
globle int ItemHashValue(
int theType,
void *theValue,
int theRange)
{
switch(theType)
{
case FLOAT:
return(HashFloat(ValueToDouble(theValue),theRange));
case INTEGER:
return(HashInteger(ValueToLong(theValue),theRange));
case SYMBOL:
case STRING:
#if OBJECT_SYSTEM
case INSTANCE_NAME:
#endif
return(HashSymbol(ValueToString(theValue),theRange));
case MULTIFIELD:
return(HashMultifield((struct multifield *) theValue,theRange));
#if DEFTEMPLATE_CONSTRUCT
case FACT_ADDRESS:
return(HashFact((struct fact *) theValue) % theRange);
#endif
case EXTERNAL_ADDRESS:
#if OBJECT_SYSTEM
case INSTANCE_ADDRESS:
#endif
return(((int) theValue) % theRange);
default:
SystemError("UTILITY",1);
return(-1L);
}
return(-1L);
}
globle int CompareNumbers(
void *theEnv,
EXEC_STATUS,
int type1,
void *vptr1,
int type2,
void *vptr2)
{
/*============================================*/
/* Handle the situation in which the values */
/* are exactly equal (same type, same value). */
/*============================================*/
if (vptr1 == vptr2) return(EQUAL);
/*=======================================*/
/* Handle the special cases for positive */
/* and negative infinity. */
/*=======================================*/
if (vptr1 == SymbolData(theEnv,execStatus)->PositiveInfinity) return(GREATER_THAN);
if (vptr1 == SymbolData(theEnv,execStatus)->NegativeInfinity) return(LESS_THAN);
if (vptr2 == SymbolData(theEnv,execStatus)->PositiveInfinity) return(LESS_THAN);
if (vptr2 == SymbolData(theEnv,execStatus)->NegativeInfinity) return(GREATER_THAN);
/*=======================*/
/* Compare two integers. */
/*=======================*/
if ((type1 == INTEGER) && (type2 == INTEGER))
{
if (ValueToLong(vptr1) < ValueToLong(vptr2))
{ return(LESS_THAN); }
else if (ValueToLong(vptr1) > ValueToLong(vptr2))
{ return(GREATER_THAN); }
return(EQUAL);
}
/*=====================*/
/* Compare two floats. */
/*=====================*/
if ((type1 == FLOAT) && (type2 == FLOAT))
{
if (ValueToDouble(vptr1) < ValueToDouble(vptr2))
{ return(LESS_THAN); }
else if (ValueToDouble(vptr1) > ValueToDouble(vptr2))
{ return(GREATER_THAN); }
return(EQUAL);
}
/*================================*/
/* Compare an integer to a float. */
/*================================*/
if ((type1 == INTEGER) && (type2 == FLOAT))
{
if (((double) ValueToLong(vptr1)) < ValueToDouble(vptr2))
{ return(LESS_THAN); }
else if (((double) ValueToLong(vptr1)) > ValueToDouble(vptr2))
{ return(GREATER_THAN); }
return(EQUAL);
}
/*================================*/
/* Compare a float to an integer. */
/*================================*/
if ((type1 == FLOAT) && (type2 == INTEGER))
{
if (ValueToDouble(vptr1) < ((double) ValueToLong(vptr2)))
{ return(LESS_THAN); }
else if (ValueToDouble(vptr1) > ((double) ValueToLong(vptr2)))
{ return(GREATER_THAN); }
return(EQUAL);
}
/*===================================*/
/* One of the arguments was invalid. */
/* Return -1 to indicate an error. */
/*===================================*/
return(-1);
}
globle void PrintAtom(
char *logicalName,
int type,
void *value)
{
char buffer[20];
switch (type)
{
case FLOAT:
PrintFloat(logicalName,ValueToDouble(value));
break;
case INTEGER:
PrintLongInteger(logicalName,ValueToLong(value));
break;
case SYMBOL:
PrintRouter(logicalName,ValueToString(value));
break;
case STRING:
if (PreserveEscapedCharacters)
{ PrintRouter(logicalName,StringPrintForm(ValueToString(value))); }
else
{
PrintRouter(logicalName,"\"");
PrintRouter(logicalName,ValueToString(value));
PrintRouter(logicalName,"\"");
}
break;
case EXTERNAL_ADDRESS:
if (AddressesToStrings) PrintRouter(logicalName,"\"");
PrintRouter(logicalName,"<Pointer-");
sprintf(buffer,"%p",value);
PrintRouter(logicalName,buffer);
PrintRouter(logicalName,">");
if (AddressesToStrings) PrintRouter(logicalName,"\"");
break;
#if OBJECT_SYSTEM
case INSTANCE_NAME:
PrintRouter(logicalName,"[");
PrintRouter(logicalName,ValueToString(value));
PrintRouter(logicalName,"]");
break;
#endif
#if FUZZY_DEFTEMPLATES
case FUZZY_VALUE:
PrintFuzzyValue(logicalName,ValueToFuzzyValue(value));
break;
#endif
case RVOID:
break;
default:
if (PrimitivesArray[type] == NULL) break;
if (PrimitivesArray[type]->longPrintFunction == NULL)
{
PrintRouter(logicalName,"<unknown atom type>");
break;
}
(*PrimitivesArray[type]->longPrintFunction)(logicalName,value);
break;
}
}
globle intBool LessThanOrEqualFunction(
void *theEnv)
{
EXPRESSION *theArgument;
DATA_OBJECT rv1, rv2;
int pos = 1;
/*=========================*/
/* Get the first argument. */
/*=========================*/
theArgument = GetFirstArgument();
if (theArgument == NULL) { return(TRUE); }
if (! GetNumericArgument(theEnv,theArgument,"<=",&rv1,FALSE,pos)) return(FALSE);
pos++;
/*====================================================*/
/* Compare each of the subsequent arguments to its */
/* predecessor. If any is greater, then return FALSE. */
/*====================================================*/
for (theArgument = GetNextArgument(theArgument);
theArgument != NULL;
theArgument = GetNextArgument(theArgument), pos++)
{
if (! GetNumericArgument(theEnv,theArgument,"<=",&rv2,FALSE,pos)) return(FALSE);
if (rv1.type == INTEGER)
{
if (rv2.type == INTEGER)
{
if (ValueToLong(rv1.value) > ValueToLong(rv2.value))
{ return(FALSE); }
}
else
{
if ((double) ValueToLong(rv1.value) > ValueToDouble(rv2.value))
{ return(FALSE); }
}
}
else
{
if (rv2.type == INTEGER)
{
if (ValueToDouble(rv1.value) > (double) ValueToLong(rv2.value))
{ return(FALSE); }
}
else
{
if (ValueToDouble(rv1.value) > ValueToDouble(rv2.value))
{ return(FALSE); }
}
}
rv1.type = rv2.type;
rv1.value = rv2.value;
}
/*======================================*/
/* Each argument was less than or equal */
/* to it predecessor. Return TRUE. */
/*======================================*/
return(TRUE);
}
globle intBool NumericNotEqualFunction(
void *theEnv,
EXEC_STATUS)
{
EXPRESSION *theArgument;
DATA_OBJECT rv1, rv2;
int pos = 1;
/*=========================*/
/* Get the first argument. */
/*=========================*/
theArgument = GetFirstArgument();
if (theArgument == NULL) { return(TRUE); }
if (! GetNumericArgument(theEnv,execStatus,theArgument,"<>",&rv1,FALSE,pos)) return(FALSE);
pos++;
/*=================================================*/
/* Compare each of the subsequent arguments to the */
/* first. If any is equal, then return FALSE. */
/*=================================================*/
for (theArgument = GetNextArgument(theArgument);
theArgument != NULL;
theArgument = GetNextArgument(theArgument), pos++)
{
if (! GetNumericArgument(theEnv,execStatus,theArgument,"<>",&rv2,FALSE,pos)) return(FALSE);
if (rv1.type == INTEGER)
{
if (rv2.type == INTEGER)
{
if (ValueToLong(rv1.value) == ValueToLong(rv2.value))
{ return(FALSE); }
}
else
{
if ((double) ValueToLong(rv1.value) == ValueToDouble(rv2.value))
{ return(FALSE); }
}
}
else
{
if (rv2.type == INTEGER)
{
if (ValueToDouble(rv1.value) == (double) ValueToLong(rv2.value))
{ return(FALSE); }
}
else
{
if (ValueToDouble(rv1.value) == ValueToDouble(rv2.value))
{ return(FALSE); }
}
}
}
/*===================================*/
/* All arguments were unequal to the */
/* first argument. Return TRUE. */
/*===================================*/
return(TRUE);
}
globle void PrintAtom(
void *theEnv,
const char *logicalName,
int type,
void *value)
{
struct externalAddressHashNode *theAddress;
char buffer[20];
switch (type)
{
case FLOAT:
PrintFloat(theEnv,logicalName,ValueToDouble(value));
break;
case INTEGER:
PrintLongInteger(theEnv,logicalName,ValueToLong(value));
break;
case SYMBOL:
EnvPrintRouter(theEnv,logicalName,ValueToString(value));
break;
case STRING:
if (PrintUtilityData(theEnv)->PreserveEscapedCharacters)
{ EnvPrintRouter(theEnv,logicalName,StringPrintForm(theEnv,ValueToString(value))); }
else
{
EnvPrintRouter(theEnv,logicalName,"\"");
EnvPrintRouter(theEnv,logicalName,ValueToString(value));
EnvPrintRouter(theEnv,logicalName,"\"");
}
break;
case DATA_OBJECT_ARRAY:
if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\"");
EnvPrintRouter(theEnv,logicalName,"<Pointer-");
gensprintf(buffer,"%p",value);
EnvPrintRouter(theEnv,logicalName,buffer);
EnvPrintRouter(theEnv,logicalName,">");
if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\"");
break;
case EXTERNAL_ADDRESS:
theAddress = (struct externalAddressHashNode *) value;
if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\"");
if ((EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type] != NULL) &&
(EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->longPrintFunction != NULL))
{ (*EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->longPrintFunction)(theEnv,logicalName,value); }
else
{
EnvPrintRouter(theEnv,logicalName,"<Pointer-");
gensprintf(buffer,"%d-",theAddress->type);
EnvPrintRouter(theEnv,logicalName,buffer);
gensprintf(buffer,"%p",ValueToExternalAddress(value));
EnvPrintRouter(theEnv,logicalName,buffer);
EnvPrintRouter(theEnv,logicalName,">");
}
if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\"");
break;
#if OBJECT_SYSTEM
case INSTANCE_NAME:
EnvPrintRouter(theEnv,logicalName,"[");
EnvPrintRouter(theEnv,logicalName,ValueToString(value));
EnvPrintRouter(theEnv,logicalName,"]");
break;
#endif
case RVOID:
break;
default:
if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break;
if (EvaluationData(theEnv)->PrimitivesArray[type]->longPrintFunction == NULL)
{
EnvPrintRouter(theEnv,logicalName,"<unknown atom type>");
break;
}
(*EvaluationData(theEnv)->PrimitivesArray[type]->longPrintFunction)(theEnv,logicalName,value);
break;
}
}
globle void MultiplicationFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
double ftotal = 1.0;
double ftmp = 0.0;
long long ltotal = 1LL;
long long ltmp = 0LL;
intBool useFloatTotal = FALSE;
EXPRESSION *theExpression;
DATA_OBJECT theArgument;
int pos = 1;
/*===================================================*/
/* Loop through each of the arguments multiplying it */
/* by a running product. If a floating point number */
/* is encountered, then do all subsequent operations */
/* using floating point values. */
/*===================================================*/
theExpression = GetFirstArgument();
while (theExpression != NULL) {
if (! GetNumericArgument(theEnv,theExpression,"*",&theArgument,useFloatTotal,pos))
theExpression = NULL;
else
theExpression = GetNextArgument(theExpression);
if (useFloatTotal) {
ftmp = ValueToDouble(theArgument.value);
if(ftmp == 0.0) {
ftotal = 0.0;
break;
} else if(ftmp != 1.0) {
ftotal *= ftmp;
}
} else {
if (theArgument.type == INTEGER) {
ltmp = ValueToLong(theArgument.value);
if(ltmp == 0LL) {
ltotal = 0LL;
break;
} else if (ltmp != 1LL) {
/* We shouldn't waste time handling multiplication by one */
ltotal *= ltmp;
}
} else {
ftmp = ValueToDouble(theArgument.value);
if(ftmp == 0.0) {
ftotal = 0.0;
break;
} else if(ftmp == 1.0) {
/* just cast as a double instead of wasting a multiply */
ftotal = (double) ltotal;
} else {
ftotal = (double) ltotal * ftmp;
}
useFloatTotal = TRUE;
}
}
pos++;
}
/*======================================================*/
/* If a floating point number was in the argument list, */
/* then return a float, otherwise return an integer. */
/*======================================================*/
if (useFloatTotal) {
returnValue->type = FLOAT;
returnValue->value = (void *) EnvAddDouble(theEnv,ftotal);
} else {
returnValue->type = INTEGER;
returnValue->value = (void *) EnvAddLong(theEnv,ltotal);
}
}
globle intBool GreaterThanFunction(
void *theEnv,
EXEC_STATUS)
{
EXPRESSION *theArgument;
DATA_OBJECT rv1, rv2;
int pos = 1;
/*=========================*/
/* Get the first argument. */
/*=========================*/
theArgument = GetFirstArgument();
if (theArgument == NULL) { return(TRUE); }
if (! GetNumericArgument(theEnv,execStatus,theArgument,">",&rv1,FALSE,pos)) return(FALSE);
pos++;
/*==========================================*/
/* Compare each of the subsequent arguments */
/* to its predecessor. If any is lesser or */
/* equal, then return FALSE. */
/*==========================================*/
for (theArgument = GetNextArgument(theArgument);
theArgument != NULL;
theArgument = GetNextArgument(theArgument), pos++)
{
if (! GetNumericArgument(theEnv,execStatus,theArgument,">",&rv2,FALSE,pos)) return(FALSE);
if (rv1.type == INTEGER)
{
if (rv2.type == INTEGER)
{
if (ValueToLong(rv1.value) <= ValueToLong(rv2.value))
{ return(FALSE); }
}
else
{
if ((double) ValueToLong(rv1.value) <= ValueToDouble(rv2.value))
{ return(FALSE); }
}
}
else
{
if (rv2.type == INTEGER)
{
if (ValueToDouble(rv1.value) <= (double) ValueToLong(rv2.value))
{ return(FALSE); }
}
else
{
if (ValueToDouble(rv1.value) <= ValueToDouble(rv2.value))
{ return(FALSE); }
}
}
rv1.type = rv2.type;
rv1.value = rv2.value;
}
/*================================*/
/* Each argument was greater than */
/* its predecessor. Return TRUE. */
/*================================*/
return(TRUE);
}
globle void MaxFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
DATA_OBJECT argValue;
int numberOfArguments, i;
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if ((numberOfArguments = EnvArgCountCheck(theEnv,"max",AT_LEAST,1)) == -1)
{
returnValue->type = INTEGER;
returnValue->value = (void *) EnvAddLong(theEnv,0L);
return;
}
/*============================================*/
/* Check that the first argument is a number. */
/*============================================*/
if (EnvArgTypeCheck(theEnv,"max",1,INTEGER_OR_FLOAT,returnValue) == FALSE)
{
returnValue->type = INTEGER;
returnValue->value = (void *) EnvAddLong(theEnv,0L);
return;
}
/*===========================================================*/
/* Loop through the remaining arguments, first checking each */
/* argument to see that it is a number, and then determining */
/* if the argument is greater than the previous arguments */
/* and is thus the maximum value. */
/*===========================================================*/
for (i = 2 ; i <= numberOfArguments ; i++)
{
if (EnvArgTypeCheck(theEnv,"max",i,INTEGER_OR_FLOAT,&argValue) == FALSE) return;
if (returnValue->type == INTEGER)
{
if (argValue.type == INTEGER)
{
if (ValueToLong(returnValue->value) < ValueToLong(argValue.value))
{
returnValue->type = argValue.type;
returnValue->value = argValue.value;
}
}
else
{
if ((double) ValueToLong(returnValue->value) <
ValueToDouble(argValue.value))
{
returnValue->type = argValue.type;
returnValue->value = argValue.value;
}
}
}
else
{
if (argValue.type == INTEGER)
{
if (ValueToDouble(returnValue->value) <
(double) ValueToLong(argValue.value))
{
returnValue->type = argValue.type;
returnValue->value = argValue.value;
}
}
else
{
if (ValueToDouble(returnValue->value) < ValueToDouble(argValue.value))
{
returnValue->type = argValue.type;
returnValue->value = argValue.value;
}
}
}
}
return;
}
static void StrOrSymCatFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue,
unsigned short returnType)
{
DATA_OBJECT theArg;
int numArgs, i, total, j;
char *theString;
SYMBOL_HN **arrayOfStrings;
SYMBOL_HN *hashPtr;
char *functionName;
/*============================================*/
/* Determine the calling function name. */
/* Store the null string or the symbol nil as */
/* the return value in the event of an error. */
/*============================================*/
SetpType(returnValue,returnType);
if (returnType == STRING)
{
functionName = "str-cat";
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));
}
else
{
functionName = "sym-cat";
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"nil"));
}
/*===============================================*/
/* Determine the number of arguments as create a */
/* string array which is large enough to store */
/* the string representation of each argument. */
/*===============================================*/
numArgs = EnvRtnArgCount(theEnv);
arrayOfStrings = (SYMBOL_HN **) gm1(theEnv,(int) sizeof(SYMBOL_HN *) * numArgs);
for (i = 0; i < numArgs; i++)
{ arrayOfStrings[i] = NULL; }
/*=============================================*/
/* Evaluate each argument and store its string */
/* representation in the string array. */
/*=============================================*/
total = 1;
for (i = 1 ; i <= numArgs ; i++)
{
EnvRtnUnknown(theEnv,i,&theArg);
switch(GetType(theArg))
{
case STRING:
#if OBJECT_SYSTEM
case INSTANCE_NAME:
#endif
case SYMBOL:
hashPtr = (SYMBOL_HN *) GetValue(theArg);
arrayOfStrings[i-1] = hashPtr;
IncrementSymbolCount(hashPtr);
break;
case FLOAT:
hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,FloatToString(theEnv,ValueToDouble(GetValue(theArg))));
arrayOfStrings[i-1] = hashPtr;
IncrementSymbolCount(hashPtr);
break;
case INTEGER:
hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,LongIntegerToString(theEnv,ValueToLong(GetValue(theArg))));
arrayOfStrings[i-1] = hashPtr;
IncrementSymbolCount(hashPtr);
break;
default:
ExpectedTypeError1(theEnv,functionName,i,"string, instance name, symbol, float, or integer");
SetEvaluationError(theEnv,TRUE);
break;
}
if (EvaluationData(theEnv)->EvaluationError)
{
for (i = 0; i < numArgs; i++)
{
if (arrayOfStrings[i] != NULL)
{ DecrementSymbolCount(theEnv,arrayOfStrings[i]); }
}
rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs);
return;
}
total += (int) strlen(ValueToString(arrayOfStrings[i - 1]));
}
/*=========================================================*/
/* Allocate the memory to store the concatenated string or */
/* symbol, then copy the values in the string array to the */
/* memory just allocated. */
/*=========================================================*/
theString = (char *) gm2(theEnv,(sizeof(char) * total));
j = 0;
for (i = 0 ; i < numArgs ; i++)
{
sprintf(&theString[j],"%s",ValueToString(arrayOfStrings[i]));
j += (int) strlen(ValueToString(arrayOfStrings[i]));
}
/*=========================================*/
/* Return the concatenated value and clean */
/* up the temporary memory used. */
/*=========================================*/
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,theString));
rm(theEnv,theString,sizeof(char) * total);
for (i = 0; i < numArgs; i++)
{
if (arrayOfStrings[i] != NULL)
{ DecrementSymbolCount(theEnv,arrayOfStrings[i]); }
}
rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs);
}
globle int EnvArgTypeCheck(
void *theEnv,
char *functionName,
int argumentPosition,
int expectedType,
DATA_OBJECT_PTR returnValue)
{
/*========================*/
/* Retrieve the argument. */
/*========================*/
EnvRtnUnknown(theEnv,argumentPosition,returnValue);
if (EvaluationData(theEnv)->EvaluationError) return(FALSE);
/*========================================*/
/* If the argument's type exactly matches */
/* the expected type, then return TRUE. */
/*========================================*/
if (returnValue->type == expectedType) return (TRUE);
/*=============================================================*/
/* Some expected types encompass more than one primitive type. */
/* If the argument's type matches one of the primitive types */
/* encompassed by the expected type, then return TRUE. */
/*=============================================================*/
if ((expectedType == INTEGER_OR_FLOAT) &&
((returnValue->type == INTEGER) || (returnValue->type == FLOAT)))
{ return(TRUE); }
if ((expectedType == SYMBOL_OR_STRING) &&
((returnValue->type == SYMBOL) || (returnValue->type == STRING)))
{ return(TRUE); }
#if OBJECT_SYSTEM
if (((expectedType == SYMBOL_OR_STRING) || (expectedType == SYMBOL)) &&
(returnValue->type == INSTANCE_NAME))
{ return(TRUE); }
if ((expectedType == INSTANCE_NAME) &&
((returnValue->type == INSTANCE_NAME) || (returnValue->type == SYMBOL)))
{ return(TRUE); }
if ((expectedType == INSTANCE_OR_INSTANCE_NAME) &&
((returnValue->type == INSTANCE_ADDRESS) ||
(returnValue->type == INSTANCE_NAME) ||
(returnValue->type == SYMBOL)))
{ return(TRUE); }
#endif
/*===========================================================*/
/* If the expected type is float and the argument's type is */
/* integer (or vice versa), then convert the argument's type */
/* to match the expected type and then return TRUE. */
/*===========================================================*/
if ((returnValue->type == INTEGER) && (expectedType == FLOAT))
{
returnValue->type = FLOAT;
returnValue->value = (void *) EnvAddDouble(theEnv,(double) ValueToLong(returnValue->value));
return(TRUE);
}
if ((returnValue->type == FLOAT) && (expectedType == INTEGER))
{
returnValue->type = INTEGER;
returnValue->value = (void *) EnvAddLong(theEnv,(long) ValueToDouble(returnValue->value));
return(TRUE);
}
/*=====================================================*/
/* The argument's type didn't match the expected type. */
/* Print an error message and return FALSE. */
/*=====================================================*/
if (expectedType == FLOAT) ExpectedTypeError1(theEnv,functionName,argumentPosition,"float");
else if (expectedType == INTEGER) ExpectedTypeError1(theEnv,functionName,argumentPosition,"integer");
else if (expectedType == SYMBOL) ExpectedTypeError1(theEnv,functionName,argumentPosition,"symbol");
else if (expectedType == STRING) ExpectedTypeError1(theEnv,functionName,argumentPosition,"string");
else if (expectedType == MULTIFIELD) ExpectedTypeError1(theEnv,functionName,argumentPosition,"multifield");
else if (expectedType == INTEGER_OR_FLOAT) ExpectedTypeError1(theEnv,functionName,argumentPosition,"integer or float");
else if (expectedType == SYMBOL_OR_STRING) ExpectedTypeError1(theEnv,functionName,argumentPosition,"symbol or string");
#if OBJECT_SYSTEM
else if (expectedType == INSTANCE_NAME) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance name");
else if (expectedType == INSTANCE_ADDRESS) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance address");
else if (expectedType == INSTANCE_OR_INSTANCE_NAME) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance address or instance name");
#endif
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
return(FALSE);
}
globle long DivFunction(
void *theEnv)
{
long total = 1L;
EXPRESSION *theExpression;
DATA_OBJECT theArgument;
int pos = 1;
long theNumber;
/*===================================================*/
/* Get the first argument. This number which will be */
/* the starting product from which all subsequent */
/* arguments will divide. */
/*===================================================*/
theExpression = GetFirstArgument();
if (theExpression != NULL)
{
if (! GetNumericArgument(theEnv,theExpression,"div",&theArgument,FALSE,pos)) theExpression = NULL;
else theExpression = GetNextArgument(theExpression);
if (theArgument.type == INTEGER)
{ total = ValueToLong(theArgument.value); }
else
{ total = (long) ValueToDouble(theArgument.value); }
pos++;
}
/*=====================================================*/
/* Loop through each of the arguments dividing it into */
/* a running product. Floats are converted to integers */
/* and each argument is checked to prevent a divide by */
/* zero error. */
/*=====================================================*/
while (theExpression != NULL)
{
if (! GetNumericArgument(theEnv,theExpression,"div",&theArgument,FALSE,pos)) theExpression = NULL;
else theExpression = GetNextArgument(theExpression);
if (theArgument.type == INTEGER) theNumber = ValueToLong(theArgument.value);
else if (theArgument.type == FLOAT) theNumber = (long) ValueToDouble(theArgument.value);
else theNumber = 1;
if (theNumber == 0L)
{
DivideByZeroErrorMessage(theEnv,"div");
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
return(1L);
}
if (theArgument.type == INTEGER)
{ total /= ValueToLong(theArgument.value); }
else
{ total = total / (long) ValueToDouble(theArgument.value); }
pos++;
}
/*======================================================*/
/* The result of the div function is always an integer. */
/*======================================================*/
return(total);
}
globle void DivisionFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
double ftotal = 1.0;
long ltotal = 1L;
intBool useFloatTotal;
EXPRESSION *theExpression;
DATA_OBJECT theArgument;
int pos = 1;
useFloatTotal = BasicMathFunctionData(theEnv)->AutoFloatDividend;
/*===================================================*/
/* Get the first argument. This number which will be */
/* the starting product from which all subsequent */
/* arguments will divide. If the auto float dividend */
/* feature is enable, then this number is converted */
/* to a float if it is an integer. */
/*===================================================*/
theExpression = GetFirstArgument();
if (theExpression != NULL)
{
if (! GetNumericArgument(theEnv,theExpression,"/",&theArgument,useFloatTotal,pos)) theExpression = NULL;
else theExpression = GetNextArgument(theExpression);
if (theArgument.type == INTEGER)
{ ltotal = ValueToLong(theArgument.value); }
else
{
ftotal = ValueToDouble(theArgument.value);
useFloatTotal = TRUE;
}
pos++;
}
/*====================================================*/
/* Loop through each of the arguments dividing it */
/* into a running product. If a floating point number */
/* is encountered, then do all subsequent operations */
/* using floating point values. Each argument is */
/* checked to prevent a divide by zero error. */
/*====================================================*/
while (theExpression != NULL)
{
if (! GetNumericArgument(theEnv,theExpression,"/",&theArgument,useFloatTotal,pos)) theExpression = NULL;
else theExpression = GetNextArgument(theExpression);
if ((theArgument.type == INTEGER) ? (ValueToLong(theArgument.value) == 0L) :
((theArgument.type == FLOAT) ? ValueToDouble(theArgument.value) == 0.0 : FALSE))
{
DivideByZeroErrorMessage(theEnv,"/");
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
returnValue->type = FLOAT;
returnValue->value = (void *) EnvAddDouble(theEnv,1.0);
return;
}
if (useFloatTotal)
{ ftotal /= ValueToDouble(theArgument.value); }
else
{
if (theArgument.type == INTEGER)
{ ltotal /= ValueToLong(theArgument.value); }
else
{
ftotal = (double) ltotal / ValueToDouble(theArgument.value);
useFloatTotal = TRUE;
}
}
pos++;
}
/*======================================================*/
/* If a floating point number was in the argument list, */
/* then return a float, otherwise return an integer. */
/*======================================================*/
if (useFloatTotal)
{
returnValue->type = FLOAT;
returnValue->value = (void *) EnvAddDouble(theEnv,ftotal);
}
else
{
returnValue->type = INTEGER;
returnValue->value = (void *) EnvAddLong(theEnv,ltotal);
}
}
