/*--------------------------------------------------------------------------*/
int sci_TCL_ExistArray(char *fname,unsigned long l)
{
static int l1,n1,m1;
static int l2,n2,m2;
int ValRet=0;
Tcl_Interp *TCLinterpreter=NULL;
CheckRhs(1,2);
CheckLhs(1,1);
if (GetType(1) == sci_strings)
{
char *VarName=NULL;
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
VarName=cstk(l1);
if (!existsGlobalInterp())
{
Scierror(999,_("%s: Error main TCL interpreter not initialized.\n"),fname);
return 0;
}
if (Rhs==2)
{
/* two arguments given - get a pointer on the slave interpreter */
if (GetType(2) == sci_strings)
{
GetRhsVar(2,STRING_DATATYPE,&m2,&n2,&l2);
TCLinterpreter=Tcl_GetSlave(getTclInterp(),cstk(l2));
if (TCLinterpreter==NULL)
{
Scierror(999,_("%s: No such slave interpreter.\n"),fname);
return 0;
}
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d: String expected.\n"), fname, 2);
return 0;
}
}
else
{
/* only one argument given - use the main interpreter */
TCLinterpreter=getTclInterp();
}
ValRet=TCL_ArrayExist(TCLinterpreter,VarName);
releaseTclInterp();
n1=1;
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
if ( ValRet )
{
*istk(l1)=(int)(TRUE);
}
else
{
*istk(l1)=(int)(FALSE);
}
LhsVar(1)=Rhs+1;
PutLhsVar();
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_TCL_UnsetVar(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int* piAddrl1 = NULL;
int* piAddrl2 = NULL;
char* l2 = NULL;
static int n1, m1;
static int n2, m2;
Tcl_Interp *TCLinterpreter = NULL;
CheckInputArgument(pvApiCtx, 1, 2);
CheckOutputArgument(pvApiCtx, 1, 1);
if (checkInputArgumentType(pvApiCtx, 1, sci_strings))
{
int paramoutINT = 0;
char *VarName = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getAllocatedSingleString(pvApiCtx, piAddrl1, &VarName))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 1);
return 1;
}
if (!existsGlobalInterp())
{
freeAllocatedSingleString(VarName);
Scierror(999, _("%s: Error main TCL interpreter not initialized.\n"), fname);
return 0;
}
if (nbInputArgument(pvApiCtx) == 2)
{
// two arguments given - get a pointer on the slave interpreter
if (checkInputArgumentType(pvApiCtx, 2, sci_strings))
{
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrl2);
if (sciErr.iErr)
{
freeAllocatedSingleString(VarName);
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
if (getAllocatedSingleString(pvApiCtx, piAddrl2, &l2))
{
freeAllocatedSingleString(VarName);
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 2);
return 1;
}
TCLinterpreter = Tcl_GetSlave(getTclInterp(), (l2));
freeAllocatedSingleString(l2);
releaseTclInterp();
if (TCLinterpreter == NULL)
{
freeAllocatedSingleString(VarName);
Scierror(999, _("%s: No such slave interpreter.\n"), fname);
return 0;
}
}
else
{
freeAllocatedSingleString(VarName);
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 2);
return 0;
}
}
else
{
// only one argument given - use the main interpreter
TCLinterpreter = getTclInterp();
}
paramoutINT = (int)(Tcl_UnsetVar(TCLinterpreter, VarName, TCL_GLOBAL_ONLY) != TCL_ERROR);
freeAllocatedSingleString(VarName);
if (createScalarBoolean(pvApiCtx, nbInputArgument(pvApiCtx) + 1, paramoutINT))
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else
{
releaseTclInterp();
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
return 0;
}
releaseTclInterp();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_TCL_UpVar (char *fname,unsigned long l)
{
CheckRhs(2,3);
CheckLhs(0,1);
if ( (GetType(1) == sci_strings) && (GetType(2) == sci_strings) )
{
int m1 = 0, n1 = 0, l1 = 0;
int m2 = 0, n2 = 0, l2 = 0;
Tcl_Interp *TCLinterpreter = NULL;
char *sourceName = NULL, *destName = NULL;
int *paramoutINT = (int*)MALLOC(sizeof(int));
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
sourceName = cstk(l1);
GetRhsVar(2,STRING_DATATYPE,&m2,&n2,&l2);
destName = cstk(l2);
if (getTclInterp() == NULL)
{
releaseTclInterp();
Scierror(999,_("%s: Error main TCL interpreter not initialized.\n"),fname);
return 0;
}
releaseTclInterp();
if (Rhs == 3)
{
int m3 = 0, n3 = 0, l3 = 0;
/* three arguments given - get a pointer on the slave interpreter */
if (GetType(3) == sci_strings)
{
GetRhsVar(3,STRING_DATATYPE,&m3,&n3,&l3);
TCLinterpreter = Tcl_GetSlave(getTclInterp() ,cstk(l3));
releaseTclInterp();
if (TCLinterpreter == NULL)
{
Scierror(999,_("%s: No such slave interpreter.\n"),fname);
return 0;
}
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d: String expected.\n"),fname, 3);
return 0;
}
}
else
{
/* only two arguments given - use the main interpreter */
TCLinterpreter = getTclInterp();
releaseTclInterp();
}
if ( Tcl_GetVar(TCLinterpreter, sourceName, TCL_GLOBAL_ONLY) )
{
if ( Tcl_UpVar(TCLinterpreter,"#0", sourceName, destName, TCL_GLOBAL_ONLY) == TCL_ERROR )
{
*paramoutINT = (int)(FALSE);
}
else
{
*paramoutINT = (int)(TRUE);
}
}
else
{
*paramoutINT = (int)(FALSE);
}
n1 = 1;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_BOOLEAN_DATATYPE, &n1, &n1, ¶moutINT);
LhsVar(1) = Rhs+1;
if (paramoutINT) {FREE(paramoutINT); paramoutINT = NULL;}
PutLhsVar();
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d or #%d: String expected.\n"),fname, 1, 2);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_TCL_SetVar(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int* piAddrl2 = NULL;
char* l2 = NULL;
int* piAddrl1 = NULL;
int* piAddrStr = NULL;
char *VarName = NULL;
static int n1, m1;
static int n2, m2;
int paramoutINT = 0;
Tcl_Interp *TCLinterpreter = NULL;
CheckInputArgument(pvApiCtx, 2, 3);
CheckOutputArgument(pvApiCtx, 0, 1);
if (getTclInterp() == NULL)
{
releaseTclInterp();
Scierror(999, _("%s: Error main TCL interpreter not initialized.\n"), fname);
return 0;
}
releaseTclInterp();
if (nbInputArgument(pvApiCtx) == 3)
{
// three arguments given - get a pointer on the slave interpreter
if (checkInputArgumentType(pvApiCtx, 3, sci_strings))
{
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 3.
if (getAllocatedSingleString(pvApiCtx, piAddrl2, &l2))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 3);
return 1;
}
TCLinterpreter = Tcl_GetSlave(getTclInterp(), (l2));
freeAllocatedSingleString(l2);
if (TCLinterpreter == NULL)
{
releaseTclInterp();
Scierror(999, _("%s: No such slave interpreter.\n"), fname);
return 0;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 3);
return 0;
}
}
else
{
// only two arguments given - use the main interpreter
TCLinterpreter = getTclInterp();
}
if (checkInputArgumentType(pvApiCtx, 1, sci_strings) && checkInputArgumentType(pvApiCtx, 2, sci_strings))
{
char **Str = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getAllocatedSingleString(pvApiCtx, piAddrl1, &VarName))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 1);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrStr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of string at position 2.
if (getAllocatedMatrixOfString(pvApiCtx, piAddrStr, &m1, &n1, &Str))
{
Scierror(202, _("%s: Wrong type for argument #%d: String matrix expected.\n"), fname, 2);
return 1;
}
// Efface valeur precedente
Tcl_UnsetVar(TCLinterpreter, VarName, TCL_GLOBAL_ONLY);
if ( (m1 == 1) && (n1 == 1) )
{
paramoutINT = SetVarAString(TCLinterpreter, VarName, Str);
}
else
{
paramoutINT = SetVarStrings(TCLinterpreter, VarName, Str, m1, n1);
}
freeAllocatedSingleString(VarName);
freeAllocatedMatrixOfString(m1, n1, Str);
}
else if (checkInputArgumentType(pvApiCtx, 1, sci_strings) && checkInputArgumentType(pvApiCtx, 2, sci_matrix))
{
#define COMPLEX 1
int *header = NULL;
int Cmplx;
double* l1 = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getAllocatedSingleString(pvApiCtx, piAddrl1, &VarName))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 1);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
freeAllocatedSingleString(VarName);
return 1;
}
if (isVarComplex(pvApiCtx, piAddrl1))
{
Scierror(999, _("This function doesn't work with Complex.\n"));
freeAllocatedSingleString(VarName);
releaseTclInterp();
return 0;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrl1, &m1, &n1, &l1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 2);
freeAllocatedSingleString(VarName);
return 1;
}
if ( (m1 == 0) && (n1 == 0) )
{
Scierror(999, _("[] doesn't work with Tcl/Tk.\n"));
freeAllocatedSingleString(VarName);
releaseTclInterp();
return 0;
}
if ( (m1 == 1) && (n1 == 1) )
{
paramoutINT = SetVarScalar(TCLinterpreter, VarName, *l1);
}
else
{
paramoutINT = SetVarMatrix(TCLinterpreter, VarName, l1, m1, n1);
}
freeAllocatedSingleString(VarName);
}
else
{
if ((!checkInputArgumentType(pvApiCtx, 1, sci_strings)))
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname , 1);
}
if ((!checkInputArgumentType(pvApiCtx, 2, sci_matrix)))
{
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix expected.\n"), fname , 2);
}
releaseTclInterp();
return 0;
}
if (createScalarBoolean(pvApiCtx, nbInputArgument(pvApiCtx) + 1, paramoutINT))
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
releaseTclInterp();
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_TCL_DeleteInterp(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int* piAddrl2 = NULL;
char* l2 = NULL;
CheckInputArgument(pvApiCtx, 0, 1);
CheckOutputArgument(pvApiCtx, 1, 1);
if (nbInputArgument(pvApiCtx) == 1)
{
if (!existsGlobalInterp())
{
Scierror(999, _("%s: Error main TCL interpreter not initialized.\n"), fname);
return 0;
}
if (checkInputArgumentType(pvApiCtx, 1, sci_strings))
{
static int n2, m2;
Tcl_Interp *TCLinterpreter = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getAllocatedSingleString(pvApiCtx, piAddrl2, &l2))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 1);
return 1;
}
TCLinterpreter = Tcl_GetSlave(getTclInterp(), (l2));
freeAllocatedSingleString(l2);
releaseTclInterp();
if (TCLinterpreter == NULL)
{
Scierror(999, _("%s: No such slave interpreter.\n"), fname);
return 0;
}
else
{
Tcl_DeleteInterp(TCLinterpreter);
TCLinterpreter = NULL;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
return 0;
}
}
else // nbInputArgument(pvApiCtx) == 0
{
releaseTclInterp();
CloseTCLsci();
InitializeTclTk();
}
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}