/*--------------------------------------------------------------------------*/ 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; }