// fann_randomize_weights Give each connection a random weight between min_weight and max_weight
int sci_fann_randomize_weights(char * fname)
{
int * pi_minweight_addr = NULL;
int * pi_maxweight_addr = NULL;
int res;
double minweight = 0.0, maxweight = 0.0;
struct fann * result_ann = NULL;
SciErr _sciErr;
if ((Rhs!=3)&&(Lhs!=1))
{
Scierror(999,"%s usage: ann_out = %s(ann_in, weight_min, weight_max)", fname, fname);
return 0;
}
// Get the ann
res = detect_fannlist(1);
if (res==-1) return 0;
result_ann = createCFannStructFromScilabFannStruct(1,&res);
if (res==-1) return 0;
if (result_ann==NULL)
{
Scierror(999,"%s: Problem while creating the fann scilab structure\n",fname);
return 0;
}
_sciErr = getVarAddressFromPosition(pvApiCtx, 2, &pi_minweight_addr);
if (_sciErr.iErr)
{
printError(&_sciErr, 0);
return 0;
}
getScalarDouble(pvApiCtx, pi_minweight_addr, &minweight);
_sciErr = getVarAddressFromPosition(pvApiCtx, 3, &pi_maxweight_addr);
if (_sciErr.iErr)
{
printError(&_sciErr, 0);
return 0;
}
getScalarDouble(pvApiCtx, pi_maxweight_addr, &maxweight);
fann_randomize_weights(result_ann,(fann_type)minweight,(fann_type)maxweight);
res = createScilabFannStructFromCFannStruct(result_ann, Rhs + 1);
if (res==-1) return 0;
LhsVar(1) = Rhs + 1;
return 0;
}
int getIntFromScilab(int argNum, int *dest)
{
SciErr sciErr;
int iRet,*varAddress;
double inputDouble;
const char errMsg[]="Wrong type for input argument #%d: An integer is expected.\n";
const int errNum=999;
//same steps as above
sciErr = getVarAddressFromPosition(pvApiCtx, argNum, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if ( !isDoubleType(pvApiCtx,varAddress) || isVarComplex(pvApiCtx,varAddress) )
{
Scierror(errNum,errMsg,argNum);
return 1;
}
iRet = getScalarDouble(pvApiCtx, varAddress, &inputDouble);
//check that an int is stored in the double by casting and recasting
if(iRet || ((double)((int)inputDouble))!=inputDouble)
{
Scierror(errNum,errMsg,argNum);
return 1;
}
*dest=(int)inputDouble;
return 0;
}
int getDoubleFromScilab(int argNum, double *dest)
{
//data declarations
SciErr sciErr;
int iRet,*varAddress;
const char errMsg[]="Wrong type for input argument #%d: A double is expected.\n";
const int errNum=999;
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, argNum, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
//check that it is a non-complex double
if ( !isDoubleType(pvApiCtx,varAddress) || isVarComplex(pvApiCtx,varAddress) )
{
Scierror(errNum,errMsg,argNum);
return 1;
}
//retrieve and store
iRet = getScalarDouble(pvApiCtx, varAddress, dest);
if(iRet)
{
Scierror(errNum,errMsg,argNum);
return 1;
}
return 0;
}
int sci_sym_set_dbl_param(char *fname, unsigned long fname_len){
// Error management variable
SciErr sciErr1,sciErr2;
double status=1.0;//assume error status
double num;//to store the value of the double parameter to be set
int output;//output parameter for the symphomy setting double parameter function
int *piAddressVarOne = NULL;//pointer used to access first argument of the function
int *piAddressVarTwo=NULL;//pointer used to access second argument of the function
char variable_name[100];//string to hold the name of variable's value to be set
char *ptr=variable_name;//pointer to point to address of the variable name
CheckInputArgument(pvApiCtx, 2, 2);//Check we have exactly two argument as input or not
CheckOutputArgument(pvApiCtx, 1, 1);//Check we have exactly no argument on output side or not
//load address of 1st argument into piAddressVarOne
sciErr1 = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
sciErr2 = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
//check whether there is an error or not.
if (sciErr1.iErr){
printError(&sciErr1, 0);
return 0;
}
if (sciErr2.iErr){
printError(&sciErr2, 0);
return 0;
}
//read the value in that pointer pointing to variable name
int err1=getAllocatedSingleString(pvApiCtx, piAddressVarOne, &ptr);
//read the value of the variable to be set as a double value
int err2=getScalarDouble(pvApiCtx, piAddressVarTwo, &num);
//ensure that environment is active
if(global_sym_env==NULL){
sciprint("Error: Symphony environment not initialized. Please run 'sym_open()' first.\n");
}
else {
output=sym_set_dbl_param(global_sym_env,ptr,num);//symphony function to set the variable name pointed by the ptr pointer to the double value stored in 'value' variable.
if(output==FUNCTION_TERMINATED_NORMALLY){
sciprint("setting of double parameter function executed successfully\n");
status=0.0;
}
else
sciprint("Function did not execute successfully...check your inputs!!!\n");
}
int e=createScalarDouble(pvApiCtx,nbInputArgument(pvApiCtx)+1,status);
if (e){
AssignOutputVariable(pvApiCtx, 1) = 0;
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
int sci_sym_setObjSense(char *fname){
//error management variable
SciErr sciErr;
int iRet;
//data declarations
int *varAddress;
double objSense;
//ensure that environment is active
if(global_sym_env==NULL){
sciprint("Error: Symphony environment not initialized. Please run 'sym_open()' first.\n");
return 1;
}
//code to check arguments and get them
CheckInputArgument(pvApiCtx,1,1) ;
CheckOutputArgument(pvApiCtx,1,1) ;
//code to process input
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if ( !isDoubleType(pvApiCtx,varAddress) || isVarComplex(pvApiCtx,varAddress) )
{
Scierror(999, "Wrong type for input argument #1:\nEither 1 (sym_minimize) or -1 (sym_maximize) is expected.\n");
return 1;
}
iRet = getScalarDouble(pvApiCtx, varAddress, &objSense);
if(iRet || (objSense!=-1 && objSense!=1))
{
Scierror(999, "Wrong type for input argument #1:\nEither 1 (sym_minimize) or -1 (sym_maximize) is expected.\n");
return 1;
}
iRet=sym_set_obj_sense(global_sym_env,objSense);
if(iRet==FUNCTION_TERMINATED_ABNORMALLY){
Scierror(999, "An error occured.\n");
return 1;
}else{
if(objSense==1)
sciprint("The solver has been set to minimize the objective.\n");
else
sciprint("The solver has been set to maximize the objective.\n");
}
//code to give output
if(return0toScilab())
return 1;
return 0;
}
/*--------------------------------------------------------------------------*/
char getIntegerValue(void* _pvCtx, int _iPos)
{
SciErr sciErr;
int* piAddr = NULL;
double dblVal;
//get var address
sciErr = getVarAddressFromPosition(_pvCtx, _iPos, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), "sorder", _iPos);
return 1;
}
getScalarDouble(_pvCtx, piAddr, &dblVal);
return (char)dblVal;
}
// =============================================================================
double csv_getArgumentAsScalarDouble(void* _pvCtx, int _iVar,
const char *fname, int *iErr)
{
SciErr sciErr;
double dValue = 0.;
int *piAddressVar = NULL;
int m = 0, n = 0;
int iType = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, _iVar, &piAddressVar);
if (sciErr.iErr)
{
printError(&sciErr, 0);
*iErr = sciErr.iErr;
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVar, &iType);
if (sciErr.iErr)
{
printError(&sciErr, 0);
*iErr = sciErr.iErr;
return 0;
}
if (iType != sci_matrix)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A double expected.\n"), fname, _iVar);
*iErr = API_ERROR_INVALID_TYPE;
return 0;
}
*iErr = checkVarDimension(pvApiCtx, piAddressVar, 1, 1);
if (*iErr == 0 )
{
*iErr = API_ERROR_CHECK_VAR_DIMENSION;
Scierror(999, _("%s: Wrong size for input argument #%d: A double expected.\n"), fname, _iVar);
return 0;
}
*iErr = getScalarDouble(pvApiCtx, piAddressVar, &dValue);
return dValue;
}
/*--------------------------------------------------------------------------*/
int getStackArgumentAsBoolean(void* _pvCtx, int* _piAddr)
{
if (isScalar(_pvCtx, _piAddr))
{
if (isDoubleType(_pvCtx, _piAddr))
{
double dbl = 0;
getScalarDouble(_pvCtx, _piAddr, &dbl);
return ((int)dbl == 0 ? FALSE : TRUE);
}
else if (isBooleanType(_pvCtx, _piAddr))
{
int i = 0;
getScalarBoolean(_pvCtx, _piAddr, &i);
return (i == 0 ? FALSE : TRUE);
}
else if (isStringType(_pvCtx, _piAddr))
{
int ret = 0;
char* pst = NULL;
if (getAllocatedSingleString(_pvCtx, _piAddr, &pst))
{
return -1;
}
if (stricmp(pst, "on") == 0)
{
ret = TRUE;
}
freeAllocatedSingleString(pst);
return ret;
}
}
return -1;
}
int sci_matfile_varreadnext(char *fname, void* pvApiCtx)
{
mat_t *matfile = NULL;
matvar_t *matvar = NULL;
int fileIndex = 0;
int returnedClass = 0, var_type;
int * fd_addr = NULL;
double tmp_dbl;
SciErr sciErr;
CheckRhs(1, 1);
CheckLhs(1, 3);
/* Input argument is the index of the file to read */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &fd_addr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, fd_addr, &var_type);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if (var_type == sci_matrix)
{
getScalarDouble(pvApiCtx, fd_addr, &tmp_dbl);
if (!isScalar(pvApiCtx, fd_addr))
{
Scierror(999, _("%s: Wrong size for first input argument: Single double expected.\n"), fname);
return FALSE;
}
fileIndex = (int)tmp_dbl;
}
else
{
Scierror(999, _("%s: Wrong type for first input argument: Double expected.\n"), fname);
return FALSE;
}
/* Gets the corresponding matfile */
matfile_manager(MATFILEMANAGER_GETFILE, &fileIndex, &matfile);
if (matfile == NULL)
{
Scierror(999, _("%s: Invalid file identifier.\n"), fname);
return FALSE;
}
matvar = Mat_VarReadNext(matfile);
if ((matvar == NULL) || (matvar->name == NULL))
{
/* Return empty name */
createSingleString(pvApiCtx, Rhs + 1, "\0");
LhsVar(1) = Rhs + 1;
if (Lhs >= 2)
{
/* Return empty value */
createEmptyMatrix(pvApiCtx, Rhs + 2);
LhsVar(2) = Rhs + 2;
}
if (Lhs == 3)
{
/* Return error flag instead of variable class */
createScalarDouble(pvApiCtx, Rhs + 3, NO_MORE_VARIABLES);
LhsVar(3) = Rhs + 3;
}
PutLhsVar();
return TRUE;
}
/* To be sure isComplex is 0 or 1 */
matvar->isComplex = matvar->isComplex != 0;
/* Return the variable name */
createSingleString(pvApiCtx, Rhs + 1, matvar->name);
LhsVar(1) = Rhs + 1;
returnedClass = matvar->class_type;
if (Lhs >= 2)
{
/* Return the values */
if (!CreateMatlabVariable(pvApiCtx, Rhs + 2, matvar, NULL, -1)) /* Could not Create Variable */
{
sciprint("Do not know how to read a variable of class %d.\n", matvar->class_type);
returnedClass = UNKNOWN_VARIABLE_TYPE;
}
LhsVar(2) = Rhs + 2;
}
if (Lhs == 3)
{
/* Create class return value */
createScalarDouble(pvApiCtx, Rhs + 3, returnedClass);
LhsVar(3) = Rhs + 3;
}
Mat_VarFree(matvar);
PutLhsVar();
return TRUE;
}
int sci_eigs(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int *piAddressVarOne = NULL;
int iRowsOne = 0;
int iColsOne = 0;
double elemt1 = 0;
double elemt2 = 0;
double* Areal = NULL;
doublecomplex* Acplx = NULL;
int Asym = 1;
int Acomplex = 0;
int N = 0;
int *piAddressVarTwo = NULL;
int iTypeVarTwo = 0;
int iRowsTwo = 0;
int iColsTwo = 0;
double* Breal = NULL;
doublecomplex* Bcplx = NULL;
int Bcomplex = 0;
int matB = 0;
int *piAddressVarThree = NULL;
double dblNEV = 0;
int iNEV = 0;
int *piAddressVarFour = NULL;
int iTypeVarFour = 0;
int iRowsFour = 0;
int iColsFour = 0;
char* pstData = NULL;
doublecomplex SIGMA;
int *piAddressVarFive = NULL;
double dblMAXITER = 0;
int *piAddressVarSix = NULL;
double dblTOL = 0;
int *piAddressVarSeven = NULL;
int TypeVarSeven = 0;
int RowsSeven = 0;
int ColsSeven = 0;
double* dblNCV = NULL;
int *piAddressVarEight = NULL;
int iTypeVarEight = 0;
double dblCHOLB = 0;
int iCHOLB = 0;
int *piAddressVarNine = NULL;
int iTypeVarNine = 0;
int iRowsNine = 0;
int iColsNine = 0;
double* RESID = NULL;
doublecomplex* RESIDC = NULL;
int *piAddressVarTen = NULL;
int iINFO = 0;
int RVEC = 0;
// Output arguments
double* eigenvalue = NULL;
double* eigenvector = NULL;
doublecomplex* eigenvalueC = NULL;
doublecomplex* eigenvectorC = NULL;
double* mat_eigenvalue = NULL;
doublecomplex* mat_eigenvalueC = NULL;
int INFO_EUPD = 0;
int error = 0;
int iErr = 0;
int i = 0;
int j = 0;
CheckInputArgument(pvApiCtx, 1, 10);
CheckOutputArgument(pvApiCtx, 0, 2);
/****************************************
* First variable : A *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
sciErr = getVarDimension(pvApiCtx, piAddressVarOne, &iRowsOne, &iColsOne);
//check if A is a square matrix
if (iRowsOne * iColsOne == 1 || iRowsOne != iColsOne)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A square matrix expected.\n"), "eigs", 1);
return 1;
}
N = iRowsOne;
//check if A is complex
if (isVarComplex(pvApiCtx, piAddressVarOne))
{
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddressVarOne, &iRowsOne, &iColsOne, &Acplx);
Acomplex = 1;
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &iRowsOne, &iColsOne, &Areal);
for (i = 0; i < iColsOne; i++)
{
for (j = 0; j < i; j++)
{
elemt1 = Areal[j + i * iColsOne];
elemt2 = Areal[j * iColsOne + i];
if (fabs(elemt1 - elemt2) > 0)
{
Asym = 0;
break;
}
}
if (Asym == 0)
{
break;
}
}
}
/****************************************
* Second variable : B *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddressVarTwo, &iTypeVarTwo);
if (sciErr.iErr || iTypeVarTwo != sci_matrix)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: An empty matrix or full or sparse square matrix expected.\n"), "eigs", 2);
return 1;
}
sciErr = getVarDimension(pvApiCtx, piAddressVarTwo, &iRowsTwo, &iColsTwo);
matB = iRowsTwo * iColsTwo;
if (matB && (iRowsTwo != iRowsOne || iColsTwo != iColsOne))
{
Scierror(999, _("%s: Wrong dimension for input argument #%d: B must have the same size as A.\n"), "eigs", 2);
return 1;
}
if (isVarComplex(pvApiCtx, piAddressVarTwo))
{
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddressVarTwo, &iRowsTwo, &iColsTwo, &Bcplx);
Bcomplex = 1;
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &iRowsTwo, &iColsTwo, &Breal);
}
if (matB != 0)
{
if (Acomplex && !Bcomplex)
{
Bcplx = (doublecomplex*)MALLOC(N * N * sizeof(doublecomplex));
memset(Bcplx, 0, N * N * sizeof(doublecomplex));
Bcomplex = 1;
for (i = 0 ; i < N * N ; i++)
{
Bcplx[i].r = Breal[i];
}
}
if (!Acomplex && Bcomplex)
{
Acplx = (doublecomplex*)MALLOC(N * N * sizeof(doublecomplex));
memset(Acplx, 0, N * N * sizeof(doublecomplex));
Acomplex = 1;
for (i = 0 ; i < N * N ; i++)
{
Acplx[i].r = Areal[i];
}
}
}
/****************************************
* NEV *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddressVarThree);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 3);
FREE_AB;
return 1;
}
iErr = getScalarDouble(pvApiCtx, piAddressVarThree, &dblNEV);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "eigs", 3);
FREE_AB;
return 1;
}
if (isVarComplex(pvApiCtx, piAddressVarThree))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "eigs", 3);
FREE_AB;
return 1;
}
if (dblNEV != floor(dblNEV) || (dblNEV <= 0))
{
Scierror(999, _("%s: Wrong type for input argument #%d: k must be a positive integer.\n"), "eigs", 3);
FREE_AB;
return 1;
}
if (!finite(dblNEV))
{
Scierror(999, _("%s: Wrong value for input argument #%d: k must be in the range 1 to N.\n"), "eigs", 3);
FREE_AB;
return 1;
}
iNEV = (int)dblNEV;
/****************************************
* SIGMA AND WHICH *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddressVarFour);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 4);
FREE_AB;
return 1;
}
sciErr = getVarType(pvApiCtx, piAddressVarFour, &iTypeVarFour);
if (sciErr.iErr || (iTypeVarFour != sci_matrix && iTypeVarFour != sci_strings))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "eigs", 4);
FREE_AB;
return 1;
}
if (iTypeVarFour == sci_strings)
{
int iErr = getAllocatedSingleString(pvApiCtx, piAddressVarFour, &pstData);
if (iErr)
{
FREE_AB;
return 1;
}
if (strcmp(pstData, "LM") != 0 && strcmp(pstData, "SM") != 0 && strcmp(pstData, "LR") != 0 && strcmp(pstData, "SR") != 0 && strcmp(pstData, "LI") != 0
&& strcmp(pstData, "SI") != 0 && strcmp(pstData, "LA") != 0 && strcmp(pstData, "SA") != 0 && strcmp(pstData, "BE") != 0)
{
if (!Acomplex && Asym)
{
Scierror(999, _("%s: Wrong value for input argument #%d: Unrecognized sigma value.\n Sigma must be one of '%s', '%s', '%s', '%s' or '%s'.\n" ),
"eigs", 4, "LM", "SM", "LA", "SA", "BE");
freeAllocatedSingleString(pstData);
return 1;
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: Unrecognized sigma value.\n Sigma must be one of '%s', '%s', '%s', '%s', '%s' or '%s'.\n " ),
"eigs", 4, "LM", "SM", "LR", "SR", "LI", "SI");
FREE_AB;
freeAllocatedSingleString(pstData);
return 1;
}
}
if ((Acomplex || !Asym) && (strcmp(pstData, "LA") == 0 || strcmp(pstData, "SA") == 0 || strcmp(pstData, "BE") == 0))
{
Scierror(999, _("%s: Invalid sigma value for complex or non symmetric problem.\n"), "eigs", 4);
FREE_AB;
freeAllocatedSingleString(pstData);
return 1;
}
if (!Acomplex && Asym && (strcmp(pstData, "LR") == 0 || strcmp(pstData, "SR") == 0 || strcmp(pstData, "LI") == 0 || strcmp(pstData, "SI") == 0))
{
Scierror(999, _("%s: Invalid sigma value for real symmetric problem.\n"), "eigs", 4);
freeAllocatedSingleString(pstData);
return 1;
}
SIGMA.r = 0;
SIGMA.i = 0;
}
if (iTypeVarFour == sci_matrix)
{
sciErr = getVarDimension(pvApiCtx, piAddressVarFour, &iRowsFour, &iColsFour);
if (iRowsFour * iColsFour != 1)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "eigs", 4);
FREE_AB;
return 1;
}
if (getScalarComplexDouble(pvApiCtx, piAddressVarFour, &SIGMA.r, &SIGMA.i))
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 4);
FREE_AB;
return 1;
}
if (C2F(isanan)(&SIGMA.r) || C2F(isanan)(&SIGMA.i))
{
Scierror(999, _("%s: Wrong type for input argument #%d: sigma must be a real.\n"), "eigs", 4);
FREE_AB;
return 1;
}
pstData = "LM";
}
/****************************************
* MAXITER *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddressVarFive);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 5);
FREE_AB;
FREE_PSTDATA;
return 0;
}
iErr = getScalarDouble(pvApiCtx, piAddressVarFive, &dblMAXITER);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be a scalar.\n"), "eigs", 5, "opts.maxiter");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if ((dblMAXITER != floor(dblMAXITER)) || (dblMAXITER <= 0))
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer positive value.\n"), "eigs", 5, "opts.maxiter");
FREE_AB;
FREE_PSTDATA;
return 1;
}
/****************************************
* TOL *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 6, &piAddressVarSix);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 6);
FREE_AB;
FREE_PSTDATA;
return 1;
}
iErr = getScalarDouble(pvApiCtx, piAddressVarSix, &dblTOL);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be a real scalar.\n"), "eigs", 6, "opts.tol");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (C2F(isanan)(&dblTOL))
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be a real scalar.\n"), "eigs", 6, "opts.tol");
FREE_AB;
FREE_PSTDATA;
return 1;
}
/****************************************
* NCV *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 7, &piAddressVarSeven);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 7);
FREE_AB;
FREE_PSTDATA;
return 1;
}
sciErr = getVarType(pvApiCtx, piAddressVarSeven, &TypeVarSeven);
if (sciErr.iErr || TypeVarSeven != sci_matrix)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar.\n"), "eigs", 7, "opts.ncv");
FREE_AB;
FREE_PSTDATA;
return 1;
}
else
{
if (isVarComplex(pvApiCtx, piAddressVarSeven))
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar.\n"), "eigs", 7, "opts.ncv");
}
else
{
sciErr = getVarDimension(pvApiCtx, piAddressVarSeven, &RowsSeven, &ColsSeven);
if (RowsSeven * ColsSeven > 1)
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar.\n"), "eigs", 7, "opts.ncv");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (RowsSeven * ColsSeven == 1)
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarSeven, &RowsSeven, &ColsSeven, &dblNCV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 7);
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (dblNCV[0] != floor(dblNCV[0]))
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar.\n"), "eigs", 7, "opts.ncv");
FREE_AB;
FREE_PSTDATA;
return 1;
}
}
}
}
/****************************************
* CHOLB *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 8, &piAddressVarEight);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 8);
FREE_AB;
FREE_PSTDATA;
return 1;
}
sciErr = getVarType(pvApiCtx, piAddressVarEight, &iTypeVarEight);
if (sciErr.iErr || (iTypeVarEight != sci_matrix && iTypeVarEight != sci_boolean))
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar or a boolean.\n"), "eigs", 8, "opts.cholB");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (iTypeVarEight == sci_boolean)
{
iErr = getScalarBoolean(pvApiCtx, piAddressVarEight, &iCHOLB);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar or a boolean.\n"), "eigs", 8, "opts.cholB");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (iCHOLB != 1 && iCHOLB != 0)
{
Scierror(999, _("%s: Wrong value for input argument #%d: %s must be %s or %s.\n"), "eigs", 8, "opts.cholB", "%f", "%t");
FREE_AB;
FREE_PSTDATA;
return 1;
}
dblCHOLB = (double) iCHOLB;
}
if (iTypeVarEight == sci_matrix)
{
iErr = getScalarDouble(pvApiCtx, piAddressVarEight, &dblCHOLB);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar or a boolean.\n"), "eigs", 8, "opts.cholB");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (dblCHOLB != 1 && dblCHOLB != 0)
{
Scierror(999, _("%s: Wrong value for input argument #%d: %s must be %s or %s.\n"), "eigs", 8, "opts.cholB", "%f", "%t");
FREE_AB;
FREE_PSTDATA;
return 1;
}
}
if ( dblCHOLB ) // check that B is upper triangular with non zero element on the diagonal
{
if (!Bcomplex)
{
for (i = 0; i < N; i++)
{
for (j = 0; j <= i; j++)
{
if (i == j && Breal[i + j * N] == 0)
{
Scierror(999, _("%s: B is not positive definite. Try with sigma='SM' or sigma=scalar.\n"), "eigs");
FREE_PSTDATA;
return 0;
}
else
{
if ( j < i && Breal[i + j * N] != 0 )
{
Scierror(999, _("%s: If opts.cholB is true, B should be upper triangular.\n"), "eigs");
FREE_PSTDATA;
return 0;
}
}
}
}
}
else
{
for (i = 0; i < N; i++)
{
for (j = 0; j <= i; j++)
{
if (i == j && Bcplx[i + i * N].r == 0 && Bcplx[i + i * N].i == 0)
{
Scierror(999, _("%s: B is not positive definite. Try with sigma='SM' or sigma=scalar.\n"), "eigs");
FREE_AB;
FREE_PSTDATA;
return 0;
}
else
{
if ( j < i && (Bcplx[i + j * N].r != 0 || Bcplx[i + j * N].i != 0) )
{
Scierror(999, _("%s: If opts.cholB is true, B should be upper triangular.\n"), "eigs");
FREE_AB;
FREE_PSTDATA;
return 0;
}
}
}
}
}
}
/****************************************
* RESID *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 9, &piAddressVarNine);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 9);
FREE_AB;
FREE_PSTDATA;
return 1;
}
sciErr = getVarType(pvApiCtx, piAddressVarNine, &iTypeVarNine);
if (sciErr.iErr || iTypeVarNine != sci_matrix)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: A real or complex matrix expected.\n"), "eigs", 9);
FREE_AB;
FREE_PSTDATA;
return 1;
}
else
{
sciErr = getVarDimension(pvApiCtx, piAddressVarNine, &iRowsNine, &iColsNine);
if (iRowsNine * iColsNine == 1 || iRowsNine * iColsNine != N)
{
Scierror(999, _("%s: Wrong dimension for input argument #%d: Start vector %s must be N by 1.\n"), "eigs", 9, "opts.resid");
FREE_AB;
FREE_PSTDATA;
return 1;
}
}
if (!Acomplex && !Bcomplex)
{
if (isVarComplex(pvApiCtx, piAddressVarNine))
{
Scierror(999, _("%s: Wrong type for input argument #%d: Start vector %s must be real for real problems.\n"), "eigs", 9, "opts.resid");
FREE_PSTDATA;
return 1;
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarNine, &iRowsNine, &iColsNine, &RESID);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), "eigs", 9);
FREE_PSTDATA;
return 1;
}
}
}
else
{
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddressVarNine, &iRowsNine, &iColsNine, &RESIDC);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), "eigs", 9);
FREE_AB;
FREE_PSTDATA;
return 1;
}
}
/****************************************
* INFO *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 10, &piAddressVarTen);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), "eigs", 9);
FREE_AB;
FREE_PSTDATA;
return 1;
}
iErr = getScalarInteger32(pvApiCtx, piAddressVarTen, &iINFO);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer expected.\n"), "eigs", 1);
FREE_AB;
FREE_PSTDATA;
return 1;
}
// Initialization output arguments
if (nbOutputArgument(pvApiCtx) > 1)
{
RVEC = 1;
}
if (Acomplex || Bcomplex || !Asym)
{
eigenvalueC = (doublecomplex*)CALLOC((iNEV + 1), sizeof(doublecomplex));
if (RVEC)
{
eigenvectorC = (doublecomplex*)CALLOC(N * (iNEV + 1), sizeof(doublecomplex));
}
}
else
{
eigenvalue = (double*)CALLOC(iNEV, sizeof(double));
/* we should allocate eigenvector only if RVEC is true, but dseupd segfaults
if Z is not allocated even when RVEC is false, contrary to the docs.*/
eigenvector = (double*)CALLOC(iNEV * N, sizeof(double));
}
error = eigs(Areal, Acplx, N, Acomplex, Asym, Breal, Bcplx, Bcomplex, matB, iNEV, SIGMA, pstData, &dblMAXITER,
&dblTOL, dblNCV, RESID, RESIDC, &iINFO, &dblCHOLB, INFO_EUPD, eigenvalue, eigenvector, eigenvalueC, eigenvectorC, RVEC);
FREE_AB;
FREE_PSTDATA;
switch (error)
{
case -1 :
if (Asym && !Acomplex && !Bcomplex)
{
Scierror(999, _("%s: Wrong value for input argument #%d: For real symmetric problems, NCV must be k < NCV <= N.\n"), "eigs", 7);
}
else
{
if (!Asym && !Acomplex && !Bcomplex)
{
Scierror(999, _("%s: Wrong value for input argument #%d: For real non symmetric problems, NCV must be k + 2 < NCV <= N.\n"), "eigs", 7);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: For complex problems, NCV must be k + 1 < NCV <= N.\n"), "eigs", 7);
}
}
ReturnArguments(pvApiCtx);
return 1;
case -2 :
if (Asym && !Acomplex && !Bcomplex)
{
Scierror(999, _("%s: Wrong value for input argument #%d: For real symmetric problems, k must be an integer in the range 1 to N - 1.\n"), "eigs", 3);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: For real non symmetric or complex problems, k must be an integer in the range 1 to N - 2.\n"), "eigs", 3);
}
ReturnArguments(pvApiCtx);
return 1;
case -3 :
Scierror(999, _("%s: Error with input argument #%d: B is not positive definite. Try with sigma='SM' or sigma=scalar.\n"), "eigs", 2);
ReturnArguments(pvApiCtx);
return 0;
case -4 :
if (!Acomplex && !Bcomplex)
{
if (Asym)
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "DSAUPD", iINFO);
}
else
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "DNAUPD", iINFO);
}
}
else
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "ZNAUPD", iINFO);
}
ReturnArguments(pvApiCtx);
return 1;
case -5 :
if (!Acomplex && !Bcomplex)
{
if (Asym)
{
Scierror(999, _("%s: Error with %s: unknown mode returned.\n"), "eigs", "DSAUPD");
}
else
{
Scierror(999, _("%s: Error with %s: unknown mode returned.\n"), "eigs", "DNAUPD");
}
}
else
{
Scierror(999, _("%s: Error with %s: unknown mode returned.\n"), "eigs", "ZNAUPD");
}
ReturnArguments(pvApiCtx);
return 1;
case -6 :
if (!Acomplex && !Bcomplex)
{
if (Asym)
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "DSEUPD", INFO_EUPD);
}
else
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "DNEUPD", INFO_EUPD);
}
}
else
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "ZNEUPD", INFO_EUPD);
}
ReturnArguments(pvApiCtx);
FREE(mat_eigenvalue);
return 1;
}
if (nbOutputArgument(pvApiCtx) <= 1)
{
if (eigenvalue)
{
sciErr = createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iNEV, 1, eigenvalue);
FREE(eigenvalue);
FREE(eigenvector);
}
else if (eigenvalueC)
{
sciErr = createComplexZMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iNEV, 1, eigenvalueC);
FREE(eigenvalueC);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
}
else
{
// create a matrix which contains the eigenvalues
if (eigenvalue)
{
mat_eigenvalue = (double*)CALLOC(iNEV * iNEV, sizeof(double));
for (i = 0; i < iNEV; i++)
{
mat_eigenvalue[i * iNEV + i] = eigenvalue[i];
}
sciErr = createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iNEV, iNEV, mat_eigenvalue);
FREE(eigenvalue);
FREE(mat_eigenvalue);
}
else if (eigenvalueC)
{
mat_eigenvalueC = (doublecomplex*)CALLOC(iNEV * iNEV, sizeof(doublecomplex));
for (i = 0; i < iNEV; i++)
{
mat_eigenvalueC[i * iNEV + i] = eigenvalueC[i];
}
sciErr = createComplexZMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iNEV, iNEV, mat_eigenvalueC);
FREE(eigenvalueC);
FREE(mat_eigenvalueC);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
if (eigenvector)
{
sciErr = createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 2, N, iNEV, eigenvector);
FREE(eigenvector);
}
else if (eigenvectorC)
{
sciErr = createComplexZMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 2, N, iNEV, eigenvectorC);
FREE(eigenvectorC);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
AssignOutputVariable(pvApiCtx, 2) = nbInputArgument(pvApiCtx) + 2;
}
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_dec2base(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int *piAddressVarOne = NULL;
int *piAddressVarTwo = NULL;
int m = 0, n = 0;
double *dValues = NULL;
char **convertedValues = NULL;
unsigned int iBaseUsed = 0;
double dBaseUsed = 0.;
unsigned int nbDigits = 0;
error_convertbase err = ERROR_CONVERTBASE_NOK;
CheckRhs(2, 3);
CheckLhs(1, 1);
if (Rhs == 3)
{
double dParamThree = 0.;
unsigned int iParamThree = 0;
int *piAddressVarThree = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddressVarThree);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 3);
return 0;
}
if (!isDoubleType(pvApiCtx, piAddressVarThree))
{
Scierror(999,_("%s: Wrong type for input argument #%d: A scalar integer value expected.\n"), fname, 3);
return 0;
}
if (!isScalar(pvApiCtx, piAddressVarThree))
{
Scierror(999,_("%s: Wrong size for input argument #%d: A scalar integer value expected.\n"), fname, 3);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddressVarThree, &dParamThree) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
iParamThree = (unsigned int)dParamThree;
if (dParamThree != (double)iParamThree)
{
Scierror(999,_("%s: Wrong value for input argument #%d: A integer value expected.\n"), fname, 3);
return 0;
}
nbDigits = iParamThree;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
if (!isDoubleType(pvApiCtx, piAddressVarTwo))
{
Scierror(999,_("%s: Wrong type for input argument #%d: A integer value expected.\n"), fname, 2);
return 0;
}
if (!isScalar(pvApiCtx, piAddressVarTwo))
{
Scierror(999,_("%s: Wrong size for input argument #%d.\n"), fname, 2);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddressVarTwo, &dBaseUsed) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
iBaseUsed = (unsigned int)dBaseUsed;
if (dBaseUsed != (double)iBaseUsed)
{
Scierror(999, _("%s: Wrong value for input argument #%d: A integer value expected.\n"), fname, 2);
return 0;
}
if ((iBaseUsed < 2) && (iBaseUsed > 36))
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be between %d and %d."), fname, 2, 2, 36);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (isEmptyMatrix(pvApiCtx, piAddressVarOne))
{
if (createEmptyMatrix(pvApiCtx, Rhs + 1) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
else
{
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
}
if (!isDoubleType(pvApiCtx, piAddressVarOne))
{
Scierror(999,_("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), fname, 1);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVarOne))
{
Scierror(999,_("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), fname, 1);
return 0;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &m, &n , &dValues);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
convertedValues = (char **)MALLOC(sizeof(char*) * (m *n));
if (convertedValues == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
convertedValues = convertMatrixOfDec2Base(dValues, m * n, iBaseUsed, nbDigits, &err);
if ((err != ERROR_CONVERTBASE_OK) || (convertedValues == NULL))
{
freeArrayOfString(convertedValues, m * n);
convertedValues = NULL;
switch (err)
{
case ERROR_CONVERTBASE_NOT_INTEGER_VALUE:
Scierror(999, _("%s: Wrong value for input argument #%d: Must be between 0 and 2^52.\n"), fname, 1);
return 0;
case ERROR_CONVERTBASE_NOT_IN_INTERVAL:
Scierror(999,_("%s: Wrong value(s) for input argument #%d: A matrix of positive integer values expected.\n"), fname, 1);
return 0;
case ERROR_CONVERTBASE_ALLOCATION:
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
case ERROR_CONVERTBASE_NOK: default:
Scierror(999, _("%s: Wrong value for input argument #%d: cannot convert value(s).\n"), fname, 1);
return 0;
}
}
sciErr = createMatrixOfString(pvApiCtx, Rhs + 1, m, n, convertedValues);
freeArrayOfString(convertedValues, m * n);
convertedValues = NULL;
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999,_("%s: Memory allocation error.\n"), fname);
return 0;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
int sci_optional_args(char* fname, void *pvApiCtx)
{
char* pstName = NULL;
int iAge = 0;
int iDrivingLicense = 0;
char stOutput[100];
static rhs_opts opts[] =
{
{ -1, "name", -1, 0, 0, NULL},
{ -1, "age", -1, 0, 0, NULL},
{ -1, "driving_license", -1, 0, 0, NULL},
{ -1, NULL, -1, 0, 0, NULL}
};
CheckInputArgument(pvApiCtx, 0, 3);
CheckOutputArgument(pvApiCtx, 0, 1);
if (getOptionals(pvApiCtx, fname, opts) == 0)
{
Scierror(999, "foo: error occured in getOptionals().");
return 1;
}
// name
if (opts[0].iPos != -1)
{
getAllocatedSingleString(pvApiCtx, opts[0].piAddr, &pstName);
}
else
{
pstName = strdup("John Doe");
}
// age
if (opts[1].iPos != -1)
{
double dblAge = 0;
getScalarDouble(pvApiCtx, opts[1].piAddr, &dblAge);
iAge = (int)dblAge;
}
else
{
iAge = 77;
}
// driving license
if (opts[2].iPos != -1)
{
getScalarBoolean(pvApiCtx, opts[2].piAddr, &iDrivingLicense);
}
else
{
iDrivingLicense = 0;
}
sprintf(stOutput, "%s, %d years old, %s a driving license.", pstName, iAge, iDrivingLicense ? "has" : "does not have");
if (createSingleString(pvApiCtx, nbInputArgument(pvApiCtx) + 1, stOutput))
{
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
return 0;
}
/*--------------------------------------------------------------------------*/
int C2F(sci_funcprot)(char *fname, unsigned long fname_len)
{
SciErr sciErr;
CheckLhs(1, 1);
CheckRhs(0, 1);
if (Rhs == 0)
{
double dOut = (double) getfuncprot();
if (createScalarDouble(pvApiCtx, Rhs + 1, dOut) != 0)
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else if (Rhs == 1)
{
int ilevel = 0;
int *piAddressVarOne = NULL;
double dVarOne = 0.;
double dPreviousValue = (double) getfuncprot();
/* get Address of inputs */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
/* check input type */
if (isDoubleType(pvApiCtx, piAddressVarOne) != 1)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), fname, 1);
return 0;
}
if (isScalar(pvApiCtx, piAddressVarOne) != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), fname, 1);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddressVarOne, &dVarOne) != 0)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
ilevel = (int) dVarOne;
if (dVarOne != (double)ilevel)
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer value expected.\n"), fname, 1);
return 0;
}
if (!setfuncprot(ilevel))
{
Scierror(999, _("%s: Wrong value for input argument #%d: 0,1 or 2 expected.\n"), fname, 1);
return 0;
}
else
{
if (createScalarDouble(pvApiCtx, Rhs + 1, dPreviousValue) != 0)
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
}
return 0;
}
/*--------------------------------------------------------------------------*/
static int sci_format_tworhs(char *fname)
{
/* format(1, 10) */
int *piAddressVarOne = NULL;
int *piAddressVarTwo = NULL;
SciErr sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
if (!isScalar(pvApiCtx, piAddressVarOne))
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, 1);
return 0;
}
if (!isScalar(pvApiCtx, piAddressVarTwo))
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, 2);
return 0;
}
if (isDoubleType(pvApiCtx, piAddressVarOne) && isDoubleType(pvApiCtx, piAddressVarTwo))
{
double type_value_d = 0.;
double v_value_d = 0.;
int v_value = 0;
if (getScalarDouble(pvApiCtx, piAddressVarOne, &v_value_d) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddressVarTwo, &type_value_d) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
v_value = (int)v_value_d;
if ((type_value_d != (double)0) && (type_value_d != (double)1))
{
Scierror(999, _("%s: Wrong value for input argument #%d: '0' or '1' expected.\n"), fname, 2);
return 0;
}
if (v_value_d != (double)v_value)
{
Scierror(999, _("%s: Wrong value for input argument #%d: An integer value expected.\n"), fname, 1);
return 0;
}
if (type_value_d == 1)
{
if ((v_value < format_MIN) || (v_value > format_MAX))
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the interval [%d, %d].\n"), fname, 1, format_MIN, format_MAX);
return 0;
}
setVariableFormat(v_value);
}
else
{
if ((v_value < format_e_MIN) || (v_value > format_MAX))
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the interval [%d, %d].\n"), fname, 1, format_e_MIN, format_MAX);
return 0;
}
set_e_Format(v_value);
}
LhsVar(1) = 0;
PutLhsVar();
}
/* format('e',10) & format(10,'e') syntax */
else if ((isStringType(pvApiCtx, piAddressVarOne) &&
(isDoubleType(pvApiCtx, piAddressVarTwo)) || (isDoubleType(pvApiCtx, piAddressVarOne) && isStringType(pvApiCtx, piAddressVarTwo))))
{
char *param = NULL;
unsigned int value = 0;
if (isStringType(pvApiCtx, piAddressVarOne))
{
double dvalue = 0;
if (getAllocatedSingleString(pvApiCtx, piAddressVarOne, ¶m) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddressVarTwo, &dvalue) != 0)
{
freeAllocatedSingleString(param);
param = NULL;
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
value = (int)dvalue;
if (dvalue != (double)value)
{
freeAllocatedSingleString(param);
param = NULL;
Scierror(999, _("%s: Wrong value for input argument #%d: An integer value expected.\n"), fname, 2);
return 0;
}
}
else /* matrix */
{
double dvalue = 0;
if (getScalarDouble(pvApiCtx, piAddressVarOne, &dvalue) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
value = (int)dvalue;
if (dvalue != (double)value)
{
Scierror(999, _("%s: Wrong value for input argument #%d: An integer value expected.\n"), fname, 1);
return 0;
}
if (getAllocatedSingleString(pvApiCtx, piAddressVarTwo, ¶m) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
}
if ((strcmp(e_type_format, param) == 0) || (strcmp(v_type_format, param) == 0))
{
if (strcmp(e_type_format, param) == 0)
{
freeAllocatedSingleString(param);
param = NULL;
if ((value < format_e_MIN) || (value > format_MAX))
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the interval [%d, %d].\n"), fname, 2, format_e_MIN,
format_MAX);
return 0;
}
set_e_Format(value);
}
else /* v_type_format */
{
freeAllocatedSingleString(param);
param = NULL;
if ((value < format_MIN) || (value > format_MAX))
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the interval [%d, %d].\n"), fname, 2, format_MIN, format_MAX);
return 0;
}
setVariableFormat(value);
}
LhsVar(1) = 0;
PutLhsVar();
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, 1, e_type_format, v_type_format);
}
}
else
{
Scierror(999, _("%s: Wrong type for inputs arguments.\n"), fname);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_mgetl(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int *piAddressVarOne = NULL;
int numberOfLinesToRead = -1;
Rhs = Max(0, Rhs);
CheckRhs(1, 2);
CheckLhs(1, 1);
if (Rhs == 2)
{
int *piAddressVarTwo = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
if ( isDoubleType(pvApiCtx, piAddressVarTwo) )
{
double dValue = 0.;
if (!isScalar(pvApiCtx, piAddressVarTwo))
{
Scierror(999, _("%s: Wrong size for input argument #%d: Integer expected.\n"), fname, 2);
return 0;
}
if ( getScalarDouble(pvApiCtx, piAddressVarTwo, &dValue) == 0)
{
numberOfLinesToRead = (int)dValue;
}
else
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: Integer expected.\n"), fname, 2);
return 0;
}
}
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if ( isStringType(pvApiCtx, piAddressVarOne) || isDoubleType(pvApiCtx, piAddressVarOne) )
{
char **wcReadedStrings = NULL;
int numberOfLinesReaded = 0;
int fileDescriptor = -1;
int iErrorMgetl = 0;
BOOL bCloseFile = FALSE;
if (!isScalar(pvApiCtx, piAddressVarOne))
{
Scierror(999, _("%s: Wrong size for input argument #%d: String or logical unit expected.\n"), fname, 1);
return 0;
}
if (isStringType(pvApiCtx, piAddressVarOne))
{
char *fileName = NULL;
if (getAllocatedSingleString(pvApiCtx, piAddressVarOne, &fileName) == 0)
{
char *expandedFileName = expandPathVariable(fileName);
freeAllocatedSingleString(fileName);
fileName = NULL;
if (IsAlreadyOpenedInScilab(expandedFileName))
{
int fd = GetIdFromFilename(expandedFileName);
fileDescriptor = fd;
if (expandedFileName)
{
FREE(expandedFileName);
expandedFileName = NULL;
}
bCloseFile = FALSE;
}
else
{
#define READ_ONLY_TEXT_MODE "rt"
int fd = 0;
int f_swap = 0;
double res = 0.0;
int ierr = 0;
C2F(mopen)(&fd, expandedFileName, READ_ONLY_TEXT_MODE, &f_swap, &res, &ierr);
bCloseFile = TRUE;
switch (ierr)
{
case MOPEN_NO_ERROR:
fileDescriptor = fd;
if (expandedFileName)
{
FREE(expandedFileName);
expandedFileName = NULL;
}
break;
case MOPEN_NO_MORE_LOGICAL_UNIT:
{
Scierror(66, _("%s: Too many files opened!\n"), fname);
if (expandedFileName)
{
FREE(expandedFileName);
expandedFileName = NULL;
}
return 0;
}
break;
case MOPEN_CAN_NOT_OPEN_FILE:
{
Scierror(999, _("%s: Cannot open file %s.\n"), fname, expandedFileName);
if (expandedFileName)
{
FREE(expandedFileName);
expandedFileName = NULL;
}
return 0;
}
break;
case MOPEN_NO_MORE_MEMORY:
{
if (expandedFileName)
{
FREE(expandedFileName);
expandedFileName = NULL;
}
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
break;
case MOPEN_INVALID_FILENAME:
{
Scierror(999, _("%s: invalid filename %s.\n"), fname, expandedFileName);
if (expandedFileName)
{
FREE(expandedFileName);
expandedFileName = NULL;
}
return 0;
}
break;
case MOPEN_INVALID_STATUS:
default:
{
if (expandedFileName)
{
FREE(expandedFileName);
expandedFileName = NULL;
}
Scierror(999, _("%s: invalid status.\n"), fname);
return 0;
}
break;
}
}
}
else
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else /* double */
{
double dValue = 0.;
if ( !getScalarDouble(pvApiCtx, piAddressVarOne, &dValue) )
{
FILE *fd = NULL;
fileDescriptor = (int)dValue;
if ((fileDescriptor == STDIN_ID) || (fileDescriptor == STDOUT_ID))
{
SciError(244);
return 0;
}
fd = GetFileOpenedInScilab(fileDescriptor);
if (fd == NULL)
{
Scierror(245, _("%s: No input file associated to logical unit %d.\n"), fname, fileDescriptor);
return 0;
}
}
else
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
wcReadedStrings = mgetl(fileDescriptor, numberOfLinesToRead, &numberOfLinesReaded, &iErrorMgetl);
if (bCloseFile)
{
double dErrClose = 0.;
C2F(mclose)(&fileDescriptor, &dErrClose);
}
switch (iErrorMgetl)
{
case MGETL_NO_ERROR:
{
if (numberOfLinesReaded == 0)
{
if (createEmptyMatrix(pvApiCtx, Rhs + 1) != 0)
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else
{
int m = numberOfLinesReaded;
int n = 1;
sciErr = createMatrixOfString(pvApiCtx, Rhs + 1, m, n, wcReadedStrings);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(17, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
freeArrayOfString(wcReadedStrings, numberOfLinesReaded);
wcReadedStrings = NULL;
}
break;
case MGETL_EOF:
{
if (numberOfLinesReaded == 0)
{
if (createEmptyMatrix(pvApiCtx, Rhs + 1) != 0)
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else
{
int m = numberOfLinesReaded;
int n = 1;
sciErr = createMatrixOfString(pvApiCtx, Rhs + 1, m, n, wcReadedStrings);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(17, _("%s: Memory allocation error.\n"), fname);
return 0;
}
freeArrayOfString(wcReadedStrings, numberOfLinesReaded);
wcReadedStrings = NULL;
}
}
break;
case MGETL_MEMORY_ALLOCATION_ERROR:
{
if (wcReadedStrings)
{
freeArrayOfString(wcReadedStrings, numberOfLinesReaded);
wcReadedStrings = NULL;
}
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
break;
case MGETL_ERROR:
{
if (wcReadedStrings)
{
freeArrayOfString(wcReadedStrings, numberOfLinesReaded);
wcReadedStrings = NULL;
}
Scierror(999, _("%s: error.\n"), fname);
return 0;
}
break;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: String or logical unit expected.\n"), fname, 1);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_get(char *fname, void *pvApiCtx)
{
SciErr sciErr;
int* piAddrl1 = NULL;
long long* l1 = NULL;
int* piAddrl2 = NULL;
char* l2 = NULL;
int m1 = 0, n1 = 0;
long hdl = 0;
int lw = 0;
int iObjUID = 0;
int status = SET_PROPERTY_ERROR;
CheckInputArgument(pvApiCtx, 1, 2);
CheckOutputArgument(pvApiCtx, 0, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isMListType(pvApiCtx, piAddrl1) || isTListType(pvApiCtx, piAddrl1))
{
OverLoad(1);
return 0;
}
/*
* The first input argument can be an ID or a marker (in this case, get returns the value of the current object */
switch (getInputArgumentType(pvApiCtx, 1))
{
case sci_matrix: //console handle
{
double dbll1 = 0;
if (isScalar(pvApiCtx, piAddrl1) == 0)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getScalarDouble(pvApiCtx, piAddrl1, &dbll1))
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
if ((int)dbll1 == 0) /* Console property */
{
int* piAddrstkAdr = NULL;
char *stkAdr = NULL;
if (nbInputArgument(pvApiCtx) == 1)
{
if (sciReturnHandle(getHandle(getConsoleIdentifier())) != 0) /* Get Console handle */
{
ReturnArguments(pvApiCtx);
return 0;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
CheckInputArgument(pvApiCtx, 2, 2);
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrstkAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of string at position 2.
if (getAllocatedSingleString(pvApiCtx, piAddrstkAdr, &stkAdr))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
if (GetScreenProperty(pvApiCtx, stkAdr) != SET_PROPERTY_SUCCEED)
{
Scierror(999, _("%s: Could not read property '%s' for console object.\n"), "get", stkAdr[0]);
freeAllocatedSingleString(stkAdr);
return 1;
}
freeAllocatedSingleString(stkAdr);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
return 0;
break;
}
case sci_handles: /* scalar argument (hdl + string) */
CheckInputArgument(pvApiCtx, 1, 2);
// Retrieve a matrix of handle at position 1.
sciErr = getMatrixOfHandle(pvApiCtx, piAddrl1, &m1, &n1, &l1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for input argument #%d: Handle matrix expected.\n"), fname, 1);
return 1;
}
if (m1 != 1 || n1 != 1)
{
//lw = 1 + nbArgumentOnStack(pvApiCtx) - nbInputArgument(pvApiCtx);
OverLoad(1);
return 0;
}
if (nbInputArgument(pvApiCtx) == 1)
{
//get path from handle
int uic = getObjectFromHandle((long) * l1);
char* path = get_path(uic);
if (path[0] == '\0')
{
Scierror(999, _("%s: Unable to get useful path from this handle.\n"), fname);
return 1;
}
createSingleString(pvApiCtx, nbInputArgument(pvApiCtx) + 1, path);
FREE(path);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isScalar(pvApiCtx, piAddrl2) == 0 || isStringType(pvApiCtx, piAddrl2) == 0)
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
// Retrieve a matrix of double at position 2.
if (getAllocatedSingleString(pvApiCtx, piAddrl2, &l2))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
hdl = (long) * l1; /* on recupere le pointeur d'objet par le handle */
break;
case sci_strings: /* string argument (string) */
{
char* pstFirst = NULL;
CheckInputArgument(pvApiCtx, 1, 2);
if (isScalar(pvApiCtx, piAddrl1) == 0)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getAllocatedSingleString(pvApiCtx, piAddrl1, &pstFirst))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 1);
return 1;
}
if (strcmp(pstFirst, "default_figure") == 0 ||
strcmp(pstFirst, "default_axes") == 0 ||
strcmp(pstFirst, "current_figure") == 0 ||
strcmp(pstFirst, "current_axes") == 0 ||
strcmp(pstFirst, "current_entity") == 0 ||
strcmp(pstFirst, "hdl") == 0 ||
strcmp(pstFirst, "figures_id") == 0)
{
hdl = 0;
l2 = pstFirst;
}
else
{
int uid = search_path(pstFirst);
if (uid != 0)
{
freeAllocatedSingleString(pstFirst);
hdl = getHandle(uid);
if (nbInputArgument(pvApiCtx) == 1)
{
createScalarHandle(pvApiCtx, nbInputArgument(pvApiCtx) + 1, hdl);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isScalar(pvApiCtx, piAddrl2) == 0 || isStringType(pvApiCtx, piAddrl2) == 0)
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddrl2, &l2))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
}
else
{
createEmptyMatrix(pvApiCtx, nbInputArgument(pvApiCtx) + 1);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
}
break;
}
default:
//lw = 1 + nbArgumentOnStack(pvApiCtx) - nbInputArgument(pvApiCtx);
OverLoad(1);
return 0;
break;
}
/* (l2) est la commande, l3 l'indice sur les parametres de la commande */
CheckOutputArgument(pvApiCtx, 0, 1);
if (hdl == 0)
{
/* No handle specified */
if (callGetProperty(pvApiCtx, 0, (l2)) != 0)
{
/* An error has occurred */
freeAllocatedSingleString(l2);
ReturnArguments(pvApiCtx);
return 0;
}
}
else
{
iObjUID = getObjectFromHandle(hdl);
if (iObjUID != 0)
{
if (callGetProperty(pvApiCtx, iObjUID, (l2)) != 0)
{
/* An error has occurred */
freeAllocatedSingleString(l2);
ReturnArguments(pvApiCtx);
return 0;
}
}
else
{
Scierror(999, _("%s: The handle is not or no more valid.\n"), fname);
freeAllocatedSingleString(l2);
return 0;
}
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
freeAllocatedSingleString(l2);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_figure(char * fname, void* pvApiCtx)
{
SciErr sciErr;
int* piAddr = NULL;
int iFig = 0;
int iRhs = nbInputArgument(pvApiCtx);
int iId = 0;
int iPos = 0;
int i = 0;
int iAxes = 0;
int iPropertyOffset = 0;
BOOL bDoCreation = TRUE;
BOOL bVisible = TRUE; // Create a visible figure by default
BOOL bDockable = TRUE; // Create a dockable figure by default
BOOL bDefaultAxes = TRUE; // Create an Axes by default
double* figureSize = NULL;
double* axesSize = NULL;
double* position = NULL;
double val[4];
BOOL bMenuBar = TRUE;
BOOL bToolBar = TRUE;
BOOL bInfoBar = TRUE;
BOOL bResize = TRUE;
int iMenubarType = 1; // Create a 'figure' menubar by default
int iToolbarType = 1; // Create a 'figure' toolbar by default
double dblId = 0;
BOOL status = FALSE;
//figure(num) -> scf(num)
//figure() -> scf()
//figure(x, "...", ...)
// figure()
if (iRhs == 0) // Auto ID
{
iId = getValidDefaultFigureId();
iFig = createNewFigureWithAxes();
setGraphicObjectProperty(iFig, __GO_ID__, &iId, jni_int, 1);
iAxes = setDefaultProperties(iFig, TRUE);
initBar(iFig, bMenuBar, bToolBar, bInfoBar);
createScalarHandle(pvApiCtx, iRhs + 1, getHandle(iFig));
AssignOutputVariable(pvApiCtx, 1) = iRhs + 1;
ReturnArguments(pvApiCtx);
return 0;
}
if (iRhs == 1)
{
//figure(x);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (isVarMatrixType(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer value expected.\n"), fname, 1);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddr, &dblId))
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
iId = (int)(dblId + 0.5); //avoid 1.999 -> 1
//get current fig from id
iFig = getFigureFromIndex(iId);
if (iFig == 0) // Figure does not exists, create a new one
{
iFig = createNewFigureWithAxes();
setGraphicObjectProperty(iFig, __GO_ID__, &iId, jni_int, 1);
iAxes = setDefaultProperties(iFig, TRUE);
}
initBar(iFig, bMenuBar, bToolBar, bInfoBar);
createScalarHandle(pvApiCtx, iRhs + 1, getHandle(iFig));
AssignOutputVariable(pvApiCtx, 1) = iRhs + 1;
ReturnArguments(pvApiCtx);
return 0;
}
// Prepare property analysis
if (iRhs % 2 == 0)
{
//get highest value of winsid to create the new windows @ + 1
iId = getValidDefaultFigureId();
iPos = 0;
}
else
{
iPos = 1;
//figure(x, ...);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (isVarMatrixType(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer value expected.\n"), fname, 1);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddr, &dblId))
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
iId = (int)(dblId + 0.5); //avoid 1.999 -> 1
//get current fig from id
iFig = getFigureFromIndex(iId);
if (iFig != 0) // Figure already exists
{
bDoCreation = FALSE;
}
}
if (bDoCreation)
{
int* piAddrProp = NULL;
char* pstProName = NULL;
int* piAddrData = NULL;
for (i = iPos + 1 ; i <= iRhs ; i += 2)
{
//get property name
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddrProp);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddrProp, &pstProName))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i);
return 1;
}
if (stricmp(pstProName, "dockable") != 0 &&
stricmp(pstProName, "toolbar") != 0 &&
stricmp(pstProName, "menubar") != 0 &&
stricmp(pstProName, "default_axes") != 0 &&
stricmp(pstProName, "visible") != 0 &&
stricmp(pstProName, "figure_size") != 0 &&
stricmp(pstProName, "axes_size") != 0 &&
stricmp(pstProName, "position") != 0 &&
stricmp(pstProName, "menubar_visible") != 0 &&
stricmp(pstProName, "toolbar_visible") != 0 &&
stricmp(pstProName, "resize") != 0 &&
stricmp(pstProName, "infobar_visible") != 0)
{
freeAllocatedSingleString(pstProName);
continue;
}
//get address of value on stack
sciErr = getVarAddressFromPosition(pvApiCtx, i + 1, &piAddrData);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
//check property value to compatibility
if (stricmp(pstProName, "dockable") == 0)
{
bDockable = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bDockable == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "dockable", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "toolbar") == 0)
{
char* pstVal = NULL;
if (isStringType(pvApiCtx, piAddrData) == FALSE || isScalar(pvApiCtx, piAddrData) == FALSE)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i);
freeAllocatedSingleString(pstProName);
}
if (getAllocatedSingleString(pvApiCtx, piAddrData, &pstVal))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
if (stricmp(pstVal, "none") == 0)
{
iToolbarType = 0;
}
else if (stricmp(pstVal, "figure") == 0)
{
iToolbarType = 1;
}
else
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "toolbar", "none", "figure");
freeAllocatedSingleString(pstProName);
freeAllocatedSingleString(pstVal);
return 1;
}
freeAllocatedSingleString(pstVal);
}
else if (stricmp(pstProName, "menubar") == 0)
{
char* pstVal = NULL;
if (isStringType(pvApiCtx, piAddrData) == FALSE || isScalar(pvApiCtx, piAddrData) == FALSE)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddrData, &pstVal))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
if (stricmp(pstVal, "none") == 0)
{
iMenubarType = 0;
}
else if (stricmp(pstVal, "figure") == 0)
{
iMenubarType = 1;
}
else
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "menubar", "none", "figure");
freeAllocatedSingleString(pstProName);
freeAllocatedSingleString(pstVal);
return 1;
}
freeAllocatedSingleString(pstVal);
}
else if (stricmp(pstProName, "default_axes") == 0)
{
bDefaultAxes = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bDefaultAxes == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "default_axes", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "visible") == 0)
{
bVisible = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bVisible == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "visible", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "figure_size") == 0)
{
int iRows = 0;
int iCols = 0;
if (isDoubleType(pvApiCtx, piAddrData) == FALSE)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A double vector expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
getMatrixOfDouble(pvApiCtx, piAddrData, &iRows, &iCols, &figureSize);
if (iRows * iCols != 2)
{
Scierror(999, _("Wrong size for '%s' property: %d elements expected.\n"), "figure_size", 2);
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "axes_size") == 0)
{
int iRows = 0;
int iCols = 0;
if (isDoubleType(pvApiCtx, piAddrData) == FALSE)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A double vector expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
getMatrixOfDouble(pvApiCtx, piAddrData, &iRows, &iCols, &axesSize);
if (iRows * iCols != 2)
{
Scierror(999, _("Wrong size for '%s' property: %d elements expected.\n"), "axes_size", 2);
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "position") == 0)
{
int iRows = 0;
int iCols = 0;
double* pdbl = NULL;
if (isDoubleType(pvApiCtx, piAddrData))
{
getMatrixOfDouble(pvApiCtx, piAddrData, &iRows, &iCols, &pdbl);
if (iRows * iCols != 4)
{
Scierror(999, _("Wrong size for '%s' property: %d elements expected.\n"), "position", 4);
freeAllocatedSingleString(pstProName);
return 1;
}
position = pdbl;
axesSize = (pdbl + 2);
}
else if (isStringType(pvApiCtx, piAddrData) && isScalar(pvApiCtx, piAddrData))
{
char* pstVal = NULL;
int iVal = 0;
if (getAllocatedSingleString(pvApiCtx, piAddrData, &pstVal))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
iVal = sscanf(pstVal, "%lf|%lf|%lf|%lf", &val[0], &val[1], &val[2], &val[3]);
freeAllocatedSingleString(pstVal);
if (iVal != 4)
{
Scierror(999, _("Wrong value for '%s' property: string or 1 x %d real row vector expected.\n"), "position", 4);
freeAllocatedSingleString(pstProName);
return 1;
}
position = val;
axesSize = (val + 2);
}
else
{
Scierror(999, _("Wrong value for '%s' property: string or 1 x %d real row vector expected.\n"), "position", 4);
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "resize") == 0)
{
bResize = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bResize == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "resize", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "menubar_visible") == 0)
{
bMenuBar = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bMenuBar == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "menubar_visible", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "toolbar_visible") == 0)
{
bToolBar = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bToolBar == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "toolbar_visible", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "infobar_visible") == 0)
{
bInfoBar = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bInfoBar == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "infobar_visible", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
freeAllocatedSingleString(pstProName);
}
iFig = createFigure(bDockable, iMenubarType, iToolbarType, bDefaultAxes, bVisible);
setGraphicObjectProperty(iFig, __GO_ID__, &iId, jni_int, 1);
iAxes = setDefaultProperties(iFig, bDefaultAxes);
}
//set(iFig, iPos, iPos + 1)
for (i = iPos + 1 ; i <= iRhs ; i += 2)
{
int isMatrixOfString = 0;
int* piAddrProp = NULL;
char* pstProName = NULL;
int* piAddrData = NULL;
int iRows = 0;
int iCols = 0;
void* _pvData = NULL;
int iType = 0;
//get property name
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddrProp);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddrProp, &pstProName))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i);
return 1;
}
if (bDoCreation && (
stricmp(pstProName, "dockable") == 0 ||
stricmp(pstProName, "toolbar") == 0 ||
stricmp(pstProName, "menubar") == 0 ||
stricmp(pstProName, "default_axes") == 0 ||
stricmp(pstProName, "visible") == 0 ||
stricmp(pstProName, "figure_size") == 0 ||
stricmp(pstProName, "axes_size") == 0 ||
stricmp(pstProName, "position") == 0 ||
stricmp(pstProName, "resize") == 0 ||
stricmp(pstProName, "menubar_visible") == 0 ||
stricmp(pstProName, "toolbar_visible") == 0 ||
stricmp(pstProName, "infobar_visible") == 0))
{
// Already set creating new figure
// but let the set_ function fail if figure already exists
freeAllocatedSingleString(pstProName);
continue;
}
//get address of value on stack
sciErr = getVarAddressFromPosition(pvApiCtx, i + 1, &piAddrData);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
getVarType(pvApiCtx, piAddrData, &iType);
if ((strcmp(pstProName, "user_data") == 0) || (stricmp(pstProName, "userdata") == 0))
{
/* in this case set_user_data_property
* directly uses the third position in the stack
* to get the variable which is to be set in
* the user_data property (any data type is allowed) S. Steer */
_pvData = (void*)piAddrData; /*position in the stack */
iRows = -1; /*unused */
iCols = -1; /*unused */
iType = -1;
}
else
{
switch (iType)
{
case sci_matrix :
getMatrixOfDouble(pvApiCtx, piAddrData, &iRows, &iCols, (double**)&_pvData);
break;
case sci_boolean :
getMatrixOfBoolean(pvApiCtx, piAddrData, &iRows, &iCols, (int**)&_pvData);
break;
case sci_handles :
getMatrixOfHandle(pvApiCtx, piAddrData, &iRows, &iCols, (long long**)&_pvData);
break;
case sci_strings :
if ( strcmp(pstProName, "tics_labels") != 0 && strcmp(pstProName, "auto_ticks") != 0 &&
strcmp(pstProName, "axes_visible") != 0 && strcmp(pstProName, "axes_reverse") != 0 &&
strcmp(pstProName, "text") != 0 && stricmp(pstProName, "string") != 0 &&
stricmp(pstProName, "tooltipstring") != 0) /* Added for uicontrols */
{
if (getAllocatedSingleString(pvApiCtx, piAddrData, (char**)&_pvData))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, 3);
freeAllocatedSingleString(pstProName);
return 1;
}
iRows = (int)strlen((char*)_pvData);
iCols = 1;
}
else
{
isMatrixOfString = 1;
if (getAllocatedMatrixOfString(pvApiCtx, piAddrData, &iRows, &iCols, (char***)&_pvData))
{
Scierror(999, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 3);
freeAllocatedSingleString(pstProName);
return 1;
}
}
break;
case sci_list :
iCols = 1;
getListItemNumber(pvApiCtx, piAddrData, &iRows);
_pvData = (void*)piAddrData; /* In this case l3 is the list position in stack */
break;
default :
_pvData = (void*)piAddrData; /* In this case l3 is the list position in stack */
break;
}
}
callSetProperty(pvApiCtx, iFig, _pvData, iType, iRows, iCols, pstProName);
// If backgroundcolor is set :
// * add it to colormap => performed by callSetProperty
// * set background to index => performed by callSetProperty
// * copy value into axes background property
if (stricmp(pstProName, "backgroundcolor") == 0 && iAxes > 0)
{
int iBackground = 0;
int *piBackground = &iBackground;
getGraphicObjectProperty(iFig, __GO_BACKGROUND__, jni_int, (void **)&piBackground);
setGraphicObjectProperty(iAxes, __GO_BACKGROUND__, piBackground, jni_int, 1);
}
freeAllocatedSingleString(pstProName);
if (iType == sci_strings)
{
//free allacted data
if (isMatrixOfString == 1)
{
freeAllocatedMatrixOfString(iRows, iCols, (char**)_pvData);
}
else
{
freeAllocatedSingleString((char*)_pvData);
}
}
}
if (position)
{
int pos[2];
pos[0] = (int)position[0];
pos[1] = (int)position[1];
setGraphicObjectProperty(iFig, __GO_POSITION__, pos, jni_int_vector, 2);
}
//axes_size
if (axesSize)
{
int axes[2];
axes[0] = (int)axesSize[0];
axes[1] = (int)axesSize[1];
setGraphicObjectProperty(iFig, __GO_AXES_SIZE__, axes, jni_int_vector, 2);
}
else //no size, use default axes_size
{
int* piAxesSize = NULL;
getGraphicObjectProperty(getFigureModel(), __GO_AXES_SIZE__, jni_int_vector, (void **)&piAxesSize);
setGraphicObjectProperty(iFig, __GO_AXES_SIZE__, piAxesSize, jni_int_vector, 2);
releaseGraphicObjectProperty(__GO_AXES_SIZE__, piAxesSize, jni_int_vector, 2);
}
initBar(iFig, bMenuBar, bToolBar, bInfoBar);
if (axesSize == NULL && figureSize) //figure_size
{
int figure[2];
figure[0] = (int)figureSize[0];
figure[1] = (int)figureSize[1];
setGraphicObjectProperty(iFig, __GO_SIZE__, figure, jni_int_vector, 2);
}
setGraphicObjectProperty(iFig, __GO_RESIZE__, (void*)&bResize, jni_bool, 1);
//return new created fig
createScalarHandle(pvApiCtx, iRhs + 1, getHandle(iFig));
AssignOutputVariable(pvApiCtx, 1) = iRhs + 1;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_norm(char *fname, void* pvApiCtx)
{
SciErr sciErr;
// Arguments' addresses
int *pAAddr = NULL;
int *pflagAddr = NULL;
// Arguments' values
double *pA = NULL;
char *pflagChar = NULL;
doublecomplex *pAC = NULL;
double flagVal = 0;
// Arguments' properties (type, dimensions, length)
int iLen = 0;
int iType = 0;
int iRows = 0;
int iCols = 0;
// Return value
double ret = 0;
double RowsColsTemp = 0;
int i = 0;
int isMat = 0;
int isComplex = 0;
CheckInputArgument(pvApiCtx, 1, 2);
CheckOutputArgument(pvApiCtx, 1, 1);
// Checking A.
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &pAAddr); // Retrieving A address.
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, pAAddr, &iType); // Retrieving A type.
if (iType != sci_matrix)
{
OverLoad(1);
return 0;
}
if (isVarComplex(pvApiCtx, pAAddr))
{
sciErr = getComplexZMatrixOfDouble(pvApiCtx, pAAddr, &iRows, &iCols, &pAC);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: Real or complex matrix expected.\n"), fname, 1);
return 0;
}
isComplex = 1;
for (i = 0; i < iRows * iCols; ++i) // Checking A for %inf, which is not supported by Lapack.
{
if (la_isinf(pAC[i].r) != 0 || la_isinf(pAC[i].i) != 0 || ISNAN(pAC[i].r) || ISNAN(pAC[i].i))
{
Scierror(264, _("%s: Wrong value for argument #%d: Must not contain NaN or Inf.\n"), fname, 1);
return 0;
}
}
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, pAAddr, &iRows, &iCols, &pA);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: Real or complex matrix expected.\n"), fname, 1);
return 0;
}
for (i = 0 ; i < iRows * iCols ; i++) // Checking A for %inf, which is not supported by Lapack.
{
if (la_isinf(pA[i]) != 0 || ISNAN(pA[i]))
{
Scierror(264, _("%s: Wrong value for argument #%d: Must not contain NaN or Inf.\n"), fname, 1);
return 0;
}
}
}
if (iRows == 0) // A = [] => returning 0.
{
createScalarDouble(pvApiCtx, Rhs + 1, 0);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
if (iRows > 1 && iCols > 1) // If A is a matrix, only 1, 2 and %inf are allowed as second argument.
{
isMat = 1;
}
if (iRows == 1) // If iRows == 1, then transpose A to consider it like a vector.
{
RowsColsTemp = iRows;
iRows = iCols;
iCols = (int)RowsColsTemp;
}
if (Rhs == 1) // One argument => returning norm 2.
{
// Call normP() or normPC().
if (isComplex)
{
ret = normPC(pAC, iRows, iCols, 2); // if A is a complex matrix, call the complex function.
}
else
{
ret = normP(pA, iRows, iCols, 2);
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
// Checking flag.
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &pflagAddr); // Retrieving flag address.
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, pflagAddr, &iType); // Retrieving flag type.
if (iType != sci_strings && iType != sci_matrix)
{
Scierror(999, _("%s: Wrong type for input argument #%d: String or integer expected.\n"), fname, 2);
return 0;
}
if (iType == sci_strings)
{
if (getAllocatedSingleString(pvApiCtx, pflagAddr, &pflagChar)) // Retrieving flag dimensions.
{
Scierror(205, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 2);
return 0;
}
iLen = (int)strlen(pflagChar);
if (iLen != 3 && iLen != 1)
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s, or %s expected.\n"), fname, 2, "i", "inf", "f", "fro");
freeAllocatedSingleString(pflagChar);
return 0;
}
if (strcmp(pflagChar, "inf") != 0 && strcmp(pflagChar, "i") != 0 &&
strcmp(pflagChar, "fro") != 0 && strcmp(pflagChar, "f") != 0) // flag must be = "inf", "i", "fro" or "f".
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s or %s expected.\n"), fname, 2, "i", "inf", "f", "fro");
freeAllocatedSingleString(pflagChar);
return 0;
}
if (isComplex)
{
ret = normStringC(pAC, iRows, iCols, pflagChar); // if A is a complex matrix, call the complex function.
}
else
{
ret = normString(pA, iRows, iCols, pflagChar); // flag is a string => returning the corresponding norm.
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
freeAllocatedSingleString(pflagChar);
return 0;
}
else
{
if (isVarComplex(pvApiCtx, pflagAddr))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real expected.\n"), fname, 2);
return 0;
}
if (getScalarDouble(pvApiCtx, pflagAddr, &flagVal)) // Retrieving flag value & dimensions as a double.
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, 2);
return 0;
}
// Call the norm functions.
if (la_isinf(flagVal) == 1 && flagVal > 0) // flag = %inf
{
if (isComplex)
{
ret = normStringC(pAC, iRows, iCols, "inf"); // if A is a complex matrix, call the complex function.
}
else
{
ret = normString(pA, iRows, iCols, "inf"); // The infinite norm is computed by normString().
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
else
{
if (isMat == 1 && flagVal != 1 && flagVal != 2 && la_isinf(flagVal) == 0)
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s or %s expected.\n"), fname, 2, "1", "2", "inf", "-inf");
return 0;
}
if (isComplex)
{
ret = normPC(pAC, iRows, iCols, flagVal); // if A is a complex matrix, call the complex function.
}
else
{
ret = normP(pA, iRows, iCols, flagVal); // flag is an integer => returning the corresponding norm.
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_getcallbackobject(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int* piAddrpObjUID = NULL;
int nbRow = 0;
int nbCol = 0;
double ObjUID = 0;
unsigned long graphicHandle = 0;
CheckInputArgument(pvApiCtx, 1, 1);
CheckOutputArgument(pvApiCtx, 0, 1);
if ((checkInputArgumentType(pvApiCtx, 1, sci_matrix)))
{
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrpObjUID);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of string at position 1.
if (getScalarDouble(pvApiCtx, piAddrpObjUID, &ObjUID))
{
Scierror(202, _("%s: Wrong type for argument #%d: Real expected.\n"), fname, 1);
return 1;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, 1);
return FALSE;
}
graphicHandle = getHandle((int)ObjUID);
/* Create return variable */
if (graphicHandle == 0) /* Non-existing object --> return [] */
{
if (createEmptyMatrix(pvApiCtx, nbInputArgument(pvApiCtx) + 1))
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
}
else /* Return the handle */
{
if (createScalarHandle(pvApiCtx, nbInputArgument(pvApiCtx) + 1, graphicHandle))
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return TRUE;
}
/*--------------------------------------------------------------------------*/
int sci_drawaxis(char *fname, void* pvApiCtx)
{
/** XXXXX : un point en suspens c'est le "S" ou une adresse est
* stockees ds un unsigned long : est ce sufisant ?
*/
static rhs_opts opts[] =
{
{ -1, "dir", -1, 0, 0, NULL},
{ -1, "fontsize", -1, 0, 0, NULL},
{ -1, "format_n", -1, 0, 0, NULL},
{ -1, "seg", -1, 0, 0, NULL},
{ -1, "sub_int", -1, 0, 0, NULL},
{ -1, "textcolor", -1, 0, 0, NULL},
{ -1, "tics", -1, 0, 0, NULL},
{ -1, "ticscolor", -1, 0, 0, NULL},
{ -1, "val", -1, 0, 0, NULL},
{ -1, "x", -1, 0, 0, NULL},
{ -1, "y", -1, 0, 0, NULL},
{ -1, NULL, -1, 0, 0, NULL}
};
int iSubwinUID = 0;
int minrhs = -1, maxrhs = 0, minlhs = 0, maxlhs = 1, nopt = 0;
char dir = 'l', *format = NULL, tics = 'v', **val = NULL;
int fontsize = -1, sub_int = 2, seg_flag = 1, textcolor = -1, ticscolor = -1;
double *x = NULL, *y = NULL;
int nx = 0, ny = 0, ntics;
int nb_tics_labels = -1;
int iRhs = nbInputArgument(pvApiCtx);
nopt = NumOpt(pvApiCtx);
CheckInputArgument(pvApiCtx, minrhs, maxrhs + nopt);
CheckOutputArgument(pvApiCtx, minlhs, maxlhs);
if (getOptionals(pvApiCtx, fname, opts) == 0)
{
/* error */
return 0;
}
iSubwinUID = getOrCreateDefaultSubwin();
if (opts[0].iPos != -1)
{
char* pstDir = NULL;
//CheckLength
if (opts[0].iRows != 1 || opts[0].iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d expected.\n"), fname, opts[0].iPos, opts[0].iRows);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, opts[0].piAddr, &pstDir))
{
return 1;
}
dir = pstDir[0];
freeAllocatedSingleString(pstDir);
}
if (opts[1].iPos != -1)
{
double dblSize = 0;
//CheckScalar
if (opts[1].iRows != 1 || opts[1].iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, opts[1].iPos);
return 1;
}
getScalarDouble(pvApiCtx, opts[1].piAddr, &dblSize);
fontsize = (int)dblSize;
}
if (opts[2].iPos != -1)
{
/* verfier ce que l'on recoit avec "" XXX */
if (getAllocatedSingleString(pvApiCtx, opts[2].piAddr, &format))
{
return 1;
}
}
if (opts[3].iPos != -1)
{
double dblSeq = 0;
//CheckScalar
if (opts[3].iRows != 1 || opts[3].iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, opts[3].iPos);
freeAllocatedSingleString(format);
return 1;
}
getScalarDouble(pvApiCtx, opts[3].piAddr, &dblSeq);
seg_flag = (int)dblSeq;
}
if (opts[4].iPos != -1)
{
double dblSub = 0;
//CheckScalar
if (opts[4].iRows != 1 || opts[4].iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, opts[4].iPos);
freeAllocatedSingleString(format);
return 1;
}
getScalarDouble(pvApiCtx, opts[4].piAddr, &dblSub);
sub_int = (int)dblSub;
}
if (opts[5].iPos != -1)
{
double dblColor = 0;
//CheckScalar
if (opts[5].iRows != 1 || opts[5].iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, opts[5].iPos);
freeAllocatedSingleString(format);
return 1;
}
getScalarDouble(pvApiCtx, opts[5].piAddr, &dblColor);
textcolor = (int)dblColor;
}
if (opts[6].iPos != -1)
{
char* pstTics = NULL;
//CheckLength
if (opts[6].iRows != 1 || opts[6].iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d expected.\n"), fname, opts[6].iPos, opts[6].iRows);
freeAllocatedSingleString(format);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, opts[6].piAddr, &pstTics))
{
return 1;
}
tics = pstTics[0];
freeAllocatedSingleString(pstTics);
}
if (opts[7].iPos != -1)
{
double dblColor = 0;
//CheckScalar
if (opts[7].iRows != 1 || opts[7].iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, opts[7].iPos);
freeAllocatedSingleString(format);
return 1;
}
getScalarDouble(pvApiCtx, opts[7].piAddr, &dblColor);
ticscolor = (int)dblColor;
}
if (opts[8].iPos != -1)
{
if (getAllocatedMatrixOfString(pvApiCtx, opts[8].piAddr, &opts[8].iRows, &opts[8].iCols, &val))
{
return 1;
}
}
if (opts[9].iPos != -1)
{
getMatrixOfDouble(pvApiCtx, opts[9].piAddr, &opts[9].iRows, &opts[9].iCols, &x);
nx = opts[9].iRows * opts[9].iCols; /* F.Leray OK here opts[9].iRows and opts[9].iCols are integers. */
}
else
{
static double x_def[1];
double *bounds;
int iCurrentSubwinUID = getCurrentSubWin();
getGraphicObjectProperty(iCurrentSubwinUID, __GO_DATA_BOUNDS__, jni_double_vector, (void **)&bounds);
nx = 1;
x = x_def;
if (dir == 'l')
{
x_def[0] = bounds[0]; /* xMin */
}
else if (dir == 'r')
{
x_def[0] = bounds[1]; /* xMax */
}
}
if (opts[10].iPos != -1)
{
getMatrixOfDouble(pvApiCtx, opts[10].piAddr, &opts[10].iRows, &opts[10].iCols, &y);
ny = opts[10].iRows * opts[10].iCols;
}
else
{
static double y_def[1];
double *bounds;
int iCurrentSubwinUID = getCurrentSubWin();
getGraphicObjectProperty(iCurrentSubwinUID, __GO_DATA_BOUNDS__, jni_double_vector, (void **)&bounds);
ny = 1;
y = y_def;
if (dir == 'd')
{
y_def[0] = bounds[2]; /* yMin */
}
else if (dir == 'u')
{
y_def[0] = bounds[3]; /* yMax */
}
}
/* compatibility test */
switch (tics)
{
case 'r':
if (check_xy(fname, dir, 3, opts[9].iPos, opts[9].iRows, opts[9].iCols, x,
opts[10].iPos, opts[10].iRows, opts[10].iCols, y, &ntics) == 0)
{
ReturnArguments(pvApiCtx);
freeAllocatedSingleString(format);
freeAllocatedMatrixOfString(opts[8].iRows, opts[8].iCols, val);
return 0;
}
break;
case 'i':
if (check_xy(fname, dir, 4, opts[9].iPos, opts[9].iRows, opts[9].iCols, x,
opts[10].iPos, opts[10].iRows, opts[10].iCols, y, &ntics) == 0)
{
ReturnArguments(pvApiCtx);
freeAllocatedSingleString(format);
freeAllocatedMatrixOfString(opts[8].iRows, opts[8].iCols, val);
return 0;
}
break;
case 'v':
if (check_xy(fname, dir, -1, opts[9].iPos, opts[9].iRows, opts[9].iCols, x,
opts[10].iPos, opts[10].iRows, opts[10].iCols, y, &ntics) == 0)
{
ReturnArguments(pvApiCtx);
freeAllocatedSingleString(format);
freeAllocatedMatrixOfString(opts[8].iRows, opts[8].iCols, val);
return 0;
}
break;
default:
Scierror(999, _("%: Wrong value for %s '%c': '%s', '%s' and '%s' expected.\n"), fname, "tics", dir, "r", "v", "i");
freeAllocatedSingleString(format);
freeAllocatedMatrixOfString(opts[8].iRows, opts[8].iCols, val);
return 0;
}
if (val != NULL)
{
//CheckLength
if (opts[8].iRows * opts[8].iCols != ntics)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d expected.\n"), fname, opts[8].iPos, opts[8].iRows * opts[8].iCols);
freeAllocatedSingleString(format);
freeAllocatedMatrixOfString(opts[8].iRows, opts[8].iCols, val);
return 1;
}
nb_tics_labels = opts[8].iRows * opts[8].iCols;
}
Objdrawaxis(dir, tics, x, &nx, y, &ny, val, sub_int, format, fontsize, textcolor, ticscolor, 'n', seg_flag, nb_tics_labels);
freeAllocatedSingleString(format);
if (val != NULL)
{
freeAllocatedMatrixOfString(opts[8].iRows, opts[8].iCols, val);
}
createScalarHandle(pvApiCtx, iRhs + 1, getHandle(getCurrentObject()));
AssignOutputVariable(pvApiCtx, 1) = iRhs + 1;
ReturnArguments(pvApiCtx);
return 0;
}
// This function is a wrapper which allows to call a Scilab script function like a "normal" C/C++/Fortran function
void C2F(dense_glcpd_functions)(int * n, double * x, double * f, double * ws, int * lws, char * cws)
{
int n_x = 0;
int * tmp_addr = NULL;
int sci_obj, lhs_obj, rhs_obj;
int stack_pos, i;
int nbvars_old = Nbvars;
double * tmp_var = NULL, tmp_val = 0.0;
double f_out = 0.0;
SciErr _SciErr;
#ifdef DEBUG
printf("DEBUG: Functions called\n");
#endif
if (param_fobj.fobj_type==0)
{
sci_obj = param_fobj.sci_obj;
lhs_obj = param_fobj.lhs_obj;
rhs_obj = param_fobj.rhs_obj;
stack_pos = param_fobj.stack_pos;
n_x = param_fobj.n_x;
Nbvars = stack_pos + MAX(rhs_obj,lhs_obj) + 1;
#ifdef DEBUG
printf("DEBUG: n = %d, m = %d, n_x = %d\n", *n, *m, n_x);
for(i=0; i<n_x; i++) printf("DEBUG: x[%d] = %f\n", i, x[i]);
#endif
_SciErr = createMatrixOfDouble(pvApiCtx, stack_pos+0, n_x, 1, x); GLCPD_ERROR_NORETURN;
// The scilab function return 1 output argument: f
_SciErr = createMatrixOfDouble(pvApiCtx, stack_pos+1, 0, 0, &tmp_val); GLCPD_ERROR_NORETURN;
if (!C2F(scifunction)(&stack_pos, &sci_obj, &lhs_obj, &rhs_obj))
{
Scierror(999,"dense glcpd: error when calling objective function\n");
Nbvars = nbvars_old;
return;
}
if (Err>0)
{
Scierror(999,"dense glcpd: error when calling objective function\n");
Nbvars = nbvars_old;
return;
}
// Get F
_SciErr = getVarAddressFromPosition(pvApiCtx, stack_pos+0, &tmp_addr); GLCPD_ERROR_NORETURN;
getScalarDouble(pvApiCtx, tmp_addr, &f_out);
*f = f_out;
#ifdef DEBUG
printf("DEBUG: f = %f\n", *f);
#endif
Nbvars = nbvars_old;
}
else
{
(*param_fobj.function)(n, x, f, NULL, NULL, NULL);
return;
}
#ifdef DEBUG
printf("DEBUG: End of Functions\n");
#endif
}
int sci_fann_create(char * fname)
{
int * pi_command_addr = NULL;
int m_layers, n_layers, * pi_layers_addr = NULL;
int * pi_conn_addr = NULL;
char * Command = NULL;
double * layers = NULL, conn = 0.0;
unsigned int * ui_layers = NULL;
int res, numLayers, i;
struct fann * result_ann = NULL;
SciErr _sciErr;
if (Rhs<2)
{
Scierror(999,"%s usage: ann = %s(command,[layers ...])", fname, fname);
return 0;
}
_sciErr = getVarAddressFromPosition(pvApiCtx, 1, &pi_command_addr);
if (_sciErr.iErr)
{
printError(&_sciErr, 0);
return 0;
}
getAllocatedSingleString(pvApiCtx, pi_command_addr, &Command);
_sciErr = getVarAddressFromPosition(pvApiCtx, 2, &pi_layers_addr);
if (_sciErr.iErr)
{
printError(&_sciErr, 0);
return 0;
}
_sciErr = getMatrixOfDouble(pvApiCtx, pi_layers_addr, &m_layers, &n_layers, &layers);
if ((n_layers != 1) & (m_layers !=1))
{
Scierror(999,"%s: Layers must be a vector!",fname);
return 0;
}
numLayers = m_layers * n_layers;
ui_layers = (unsigned int *)MALLOC(numLayers*sizeof(unsigned int));
for(i=0; i<numLayers; i++) ui_layers[i] = layers[i];
if (strcmp(Command,"standard") == 0)
{
freeAllocatedSingleString(Command);
// fann_create_standard_array Just like fann_create_standard, but with an array of layer sizes instead of individual parameters.
result_ann = fann_create_standard_array(numLayers,ui_layers);
FREE(ui_layers);
if (result_ann==NULL)
{
Scierror(999,"%s: not able to create standard network\n",fname);
return 0;
}
}
if (strcmp(Command,"sparse") == 0)
{
freeAllocatedSingleString(Command);
// fann_create_sparse_array Just like fann_create_sparse, but with an array of layer sizes instead of individual parameters.
_sciErr = getVarAddressFromPosition(pvApiCtx, 3, &pi_conn_addr);
if (_sciErr.iErr)
{
printError(&_sciErr, 0);
return 0;
}
getScalarDouble(pvApiCtx, pi_conn_addr, &conn);
result_ann = fann_create_sparse_array(conn,numLayers,ui_layers);
FREE(ui_layers);
if (result_ann==NULL)
{
Scierror(999,"%s: not able to create sparse network\n",fname);
return 0;
}
}
if (strcmp(Command,"shortcut") == 0)
{
freeAllocatedSingleString(Command);
// fann_create_shortcut_array Just like fann_create_shortcut, but with an array of layer sizes instead of individual parameters.
result_ann = fann_create_shortcut_array(numLayers,ui_layers);
FREE(ui_layers);
if (result_ann==NULL)
{
Scierror(999,"%s: not able to create shortcut network\n",fname);
return 0;
}
}
//Create the struct representing this ann in scilab
res = createScilabFannStructFromCFannStruct(result_ann, Rhs + 1);
if (res==-1) return 0;
LhsVar(1) = Rhs + 1;
return 0;
}
//both basic and advanced loader use this code
static int commonCodePart2()
{
//get input 3: lower bounds of variables
if(getFixedSizeDoubleMatrixFromScilab(3,1,numVars,&lowerBounds))
{
cleanupBeforeExit();
return 1;
}
//get input 4: upper bounds of variables
if(getFixedSizeDoubleMatrixFromScilab(4,1,numVars,&upperBounds))
{
cleanupBeforeExit();
return 1;
}
//get input 5: coefficients of variables in objective function to be minimized
if(getFixedSizeDoubleMatrixFromScilab(5,1,numVars,&objective))
{
cleanupBeforeExit();
return 1;
}
//get input 6: array that specifies wether a variable is constrained to be an integer
sciErr = getVarAddressFromPosition(pvApiCtx, 6, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
cleanupBeforeExit();return 1;
}
if ( !isBooleanType(pvApiCtx, varAddress) )
{
Scierror(999, "Wrong type for input argument #6: A matrix of booleans is expected.\n");
cleanupBeforeExit();return 1;
}
sciErr = getMatrixOfBoolean(pvApiCtx, varAddress, &inputMatrixRows, &inputMatrixCols, &isIntVarBool);
if (sciErr.iErr)
{
printError(&sciErr, 0);
cleanupBeforeExit();return 1;
}
if(inputMatrixRows!=1 || inputMatrixCols!=numVars)
{
Scierror(999, "Wrong type for input argument #6: Incorrectly sized matrix.\n");
cleanupBeforeExit();return 1;
}
for(colIter=0;colIter<numVars;colIter++)
{
if(isIntVarBool[colIter])
isIntVar[colIter]=TRUE;
else
isIntVar[colIter]=FALSE;
}
//get input 7: wether to minimize or maximize objective
sciErr = getVarAddressFromPosition(pvApiCtx, 7, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if ( !isDoubleType(pvApiCtx,varAddress) || isVarComplex(pvApiCtx,varAddress) )
{
Scierror(999, "Wrong type for input argument #7: Either 1 (sym_minimize) or -1 (sym_maximize) is expected.\n");
return 1;
}
iRet = getScalarDouble(pvApiCtx, varAddress, &objSense);
if(iRet || (objSense!=-1 && objSense!=1))
{
Scierror(999, "Wrong type for input argument #7: Either 1 (sym_minimize) or -1 (sym_maximize) is expected.\n");
return 1;
}
iRet=sym_set_obj_sense(global_sym_env,objSense);
if(iRet==FUNCTION_TERMINATED_ABNORMALLY)
{
Scierror(999, "An error occured.\n");
return 1;
}
//get input 9: constraint lower bound
if(getFixedSizeDoubleMatrixFromScilab(9,numConstr,1,&conLower))
{
cleanupBeforeExit();
return 1;
}
//get input 10: constraint upper bound
if(getFixedSizeDoubleMatrixFromScilab(10,numConstr,1,&conUpper))
{
cleanupBeforeExit();
return 1;
}
//deduce type of constraint
for(rowIter=0;rowIter<numConstr;rowIter++)
{
if(conLower[rowIter]>conUpper[rowIter])
{
Scierror(999, "Error: the lower bound of constraint %d is more than its upper bound.\n",rowIter);
cleanupBeforeExit();
return 1;
}
if(conLower[rowIter]==(-INFINITY) && conUpper[rowIter]==INFINITY){
conType[rowIter]='N';
conRange[rowIter]=0;
conRHS[rowIter]=0;
}else if(conLower[rowIter]==(-INFINITY)){
conType[rowIter]='L';
conRange[rowIter]=0;
conRHS[rowIter]=conUpper[rowIter];
}else if(conUpper[rowIter]==INFINITY){
conType[rowIter]='G';
conRange[rowIter]=0;
conRHS[rowIter]=conLower[rowIter];
}else if(conUpper[rowIter]==conLower[rowIter]){
conType[rowIter]='E';
conRange[rowIter]=0;
conRHS[rowIter]=conLower[rowIter];
}else{
conType[rowIter]='R';
conRange[rowIter]=conUpper[rowIter]-conLower[rowIter];
conRHS[rowIter]=conUpper[rowIter];
}
}
/*
//for debug: show all data
sciprint("Vars: %d Constr: %d ObjType: %lf\n",numVars,numConstr,objSense);
for(colIter=0;colIter<numVars;colIter++)
sciprint("Var %d: upper: %lf lower: %lf isInt: %d ObjCoeff: %lf\n",colIter,lowerBounds[colIter],upperBounds[colIter],isIntVar[colIter],objective[colIter]);
for(rowIter=0;rowIter<numConstr;rowIter++)
sciprint("Constr %d: type: %c lower: %lf upper: %lf range: %lf\n",rowIter,conType[rowIter],conLower[rowIter],conRange[rowIter]);
*/
//call problem loader
sym_explicit_load_problem(global_sym_env,numVars,numConstr,conMatrixColStart,conMatrixRowIndex,conMatrix,lowerBounds,upperBounds,isIntVar,objective,NULL,conType,conRHS,conRange,TRUE);
sciprint("Problem loaded into environment.\n");
//code to give output
cleanupBeforeExit();
return 0;
}
/*--------------------------------------------------------------------------*/
static int sci_format_onerhs(char *fname)
{
int *piAddressVarOne = NULL;
SciErr sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (isStringType(pvApiCtx, piAddressVarOne))
{
char *param = NULL;
if (!isScalar(pvApiCtx, piAddressVarOne))
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, 1, e_type_format, v_type_format);
return 0;
}
if (getAllocatedSingleString(pvApiCtx, piAddressVarOne, ¶m) == 0)
{
if ((strcmp(e_type_format, param) == 0) || (strcmp(v_type_format, param) == 0))
{
double previous_mode = 0;
double previous_numberDigits = 0;
getFormat(&previous_mode, &previous_numberDigits);
if (strcmp(e_type_format, param) == 0)
{
set_e_Format((int)previous_numberDigits);
}
else /* v_type_format */
{
setVariableFormat((int)previous_numberDigits);
}
freeAllocatedSingleString(param);
param = NULL;
LhsVar(1) = 0;
PutLhsVar();
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, 1, e_type_format, v_type_format);
return 0;
}
}
else
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
}
else if (isDoubleType(pvApiCtx, piAddressVarOne))
{
if (isScalar(pvApiCtx, piAddressVarOne))
{
double dValue = 0.;
if (getScalarDouble(pvApiCtx, piAddressVarOne, &dValue) == 0)
{
double mode = 0.;
double previous_numberDigits = 0.;
unsigned int value = (int)dValue;
if (dValue != (double)value)
{
Scierror(999, _("%s: Wrong value for input argument #%d: An integer value expected.\n"), fname, 1);
return 0;
}
getFormat(&mode, &previous_numberDigits);
if (mode == mode_e)
{
if ((value < format_e_MIN) || (value > format_MAX))
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the interval [%d, %d].\n"), fname, 1, format_e_MIN,
format_MAX);
return 0;
}
set_e_Format(value);
}
else /* mode_variable */
{
if ((value < format_MIN) || (value > format_MAX))
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the interval [%d, %d].\n"), fname, 1, format_MIN,
format_MAX);
return 0;
}
setVariableFormat(value);
}
}
LhsVar(1) = 0;
PutLhsVar();
}
else
{
if (checkVarDimension(pvApiCtx, piAddressVarOne, 1, 2) || checkVarDimension(pvApiCtx, piAddressVarOne, 2, 1))
{
int nbRowsOne = 0;
int nbColsOne = 0;
double *pDouble = NULL;
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &nbRowsOne, &nbColsOne, &pDouble);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
if ((pDouble[1] != mode_e) && (pDouble[1] != mode_variable))
{
Scierror(999, _("%s: Wrong value for input argument #%d.\n"), fname, 1);
return 0;
}
else
{
if (pDouble[1] == mode_e)
{
if ((pDouble[0] < format_e_MIN) || (pDouble[0] > format_MAX))
{
Scierror(999, _("%s: Wrong value for input argument #%d.\n"), fname, 1);
return 0;
}
set_e_Format((int)pDouble[0]);
}
else /* mode_variable */
{
if ((pDouble[0] < format_MIN) || (pDouble[0] > format_MAX))
{
Scierror(999, _("%s: Wrong value for input argument #%d.\n"), fname, 1);
return 0;
}
setVariableFormat((int)pDouble[0]);
}
LhsVar(1) = 0;
PutLhsVar();
}
}
else
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, 1);
return 0;
}
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A string or a scalar integer value expected.\n"), fname, 1);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_uicontrol(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int nbRow = 0, nbCol = 0, k = 0;
int setStatus = SET_PROPERTY_SUCCEED;
int PARENT_NOT_FOUND = -2;
int NOT_FOUND = -1;
int inputIndex = 0, beginIndex = 0;
char *propertyName = NULL;
char *styleProperty = NULL;
int iPropertiesCount = sizeof(propertiesNames) / sizeof(char**);
unsigned long GraphicHandle = 0;
int found = 0; /* Does the property exists ? */
int *propertiesValuesIndices = NULL;
int iParentType = -1;
int *piParentType = &iParentType;
int iParentStyle = -1;
int *piParentStyle = &iParentStyle;
int iParentUID = 0;
int iUicontrol = 0;
int iCurrentFigure = 0;
CheckOutputArgument(pvApiCtx, 0, 1);
//init properties index
init_property_index();
if (nbInputArgument(pvApiCtx) == 0)
{
/* Create a pushbutton in current figure */
/* Create a new pushbutton */
GraphicHandle = getHandle(CreateUIControl(NULL));
/* Set current figure as parent */
iCurrentFigure = getCurrentFigure();
if (iCurrentFigure == 0)
{
iCurrentFigure = createNewFigureWithAxes();
}
iUicontrol = getObjectFromHandle(GraphicHandle);
setGraphicObjectRelationship(iCurrentFigure, iUicontrol);
}
else if (nbInputArgument(pvApiCtx) == 1)
{
/* Create a pushbutton in figure given as parameter */
/* Or give focus to the uicontrol given as parameter */
int* piAddr = NULL;
int iType = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (isHandleType(pvApiCtx, piAddr) == FALSE && isStringType(pvApiCtx, piAddr) == FALSE)
{
OverLoad(1);
return FALSE;
}
#if 0 // Allow XML loading
else if (isStringType(pvApiCtx, piAddr))
{
char* pstXmlfile = NULL;
char* pstExpandedPath = NULL;
if (isScalar(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, 1);
return FALSE;
}
if (getAllocatedSingleString(pvApiCtx, piAddr, &pstXmlfile))
{
freeAllocatedSingleString(pstXmlfile);
Scierror(999, _("%s: No more memory.\n"), fname);
return FALSE;
}
pstExpandedPath = expandPathVariable(pstXmlfile);
freeAllocatedSingleString(pstXmlfile);
iUicontrol = xmlload(pstExpandedPath);
if (iUicontrol < 1)
{
Scierror(999, _("%s: can not read file %s.\n"), fname, pstExpandedPath);
FREE(pstExpandedPath);
return 0;
}
FREE(pstExpandedPath);
GraphicHandle = getHandle(iUicontrol);
/* Create return variable */
if (createScalarHandle(pvApiCtx, nbInputArgument(pvApiCtx) + 1, GraphicHandle))
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return TRUE;
}
#endif // Allow XML loading
else /* Get parent ID */
{
int* piAddr = NULL;
long long hParent = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isScalar(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A graphic handle expected.\n"), fname, 1);
return FALSE;
}
if (getScalarHandle(pvApiCtx, piAddr, &hParent))
{
Scierror(202, _("%s: Wrong type for input argument #%d: Handle matrix expected.\n"), fname, 1);
return 1;
}
iParentUID = getObjectFromHandle((long)hParent);
if (iParentUID != 0)
{
getGraphicObjectProperty(iParentUID, __GO_TYPE__, jni_int, (void **)&piParentType);
if (iParentType == __GO_UICONTROL__) /* Focus management */
{
GraphicHandle = (unsigned long)hParent;
requestFocus(iParentUID);
}
else if (iParentType == __GO_FIGURE__ || iParentType == __GO_UIMENU__) /* PushButton creation */
{
/* Create a new pushbutton */
GraphicHandle = getHandle(CreateUIControl(NULL));
iUicontrol = getObjectFromHandle(GraphicHandle);
/* First parameter is the parent */
setGraphicObjectRelationship(iParentUID, iUicontrol);
setStatus = callSetProperty(pvApiCtx, iUicontrol, &hParent, sci_handles, 1, 1, (char*)propertiesNames[parent_property]);
if (setStatus == SET_PROPERTY_ERROR)
{
Scierror(999, _("%s: Could not set property '%s'.\n"), fname, propertyName);
return FALSE;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s', '%s' or '%s' handle expected.\n"), fname, 1, "Uicontrol",
"Figure", "Uimenu");
return FALSE;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s', '%s' or '%s' handle expected.\n"), fname, 1, "Uicontrol", "Figure",
"Uimenu");
return FALSE;
}
}
}
else
{
if (!checkInputArgumentType(pvApiCtx, 1, sci_handles) && !checkInputArgumentType(pvApiCtx, 1, sci_strings))
{
OverLoad(1);
return FALSE;
}
/* Allocate memory to store the position of properties in uicontrol call */
if ((propertiesValuesIndices = (int*)MALLOC(sizeof(int) * iPropertiesCount)) == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return FALSE;
}
/* Init all positions to NOT_FOUND */
for (inputIndex = 0; inputIndex < iPropertiesCount; inputIndex++)
{
propertiesValuesIndices[inputIndex] = NOT_FOUND; /* Property initialized as not found */
}
/**
* Odd number of input arguments
* First input is the parent ID
* All event inputs are property names
* All odd (except first) inputs are property values
*/
if (nbInputArgument(pvApiCtx) % 2 == 1)
{
if ((!checkInputArgumentType(pvApiCtx, 1, sci_handles)))
{
if ((checkInputArgumentType(pvApiCtx, 1, sci_matrix)))
{
int* piAddr = NULL;
double dblValue = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isScalar(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A graphic handle expected.\n"), fname, 1);
return FALSE;
}
if (getScalarDouble(pvApiCtx, piAddr, &dblValue))
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
iParentUID = getFigureFromIndex((int)dblValue);
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s' or a '%s' handle expected.\n"), fname, 1, "Figure",
"Frame uicontrol");
return FALSE;
}
}
else /* Get parent ID */
{
int* piAddr = NULL;
long long hParent = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isScalar(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A '%s' or a '%s' handle expected.\n"), fname, 1, "Figure",
"Frame uicontrol");
return FALSE;
}
if (getScalarHandle(pvApiCtx, piAddr, &hParent))
{
Scierror(202, _("%s: Wrong type for input argument #%d: Handle matrix expected.\n"), fname, 1);
return 1;
}
iParentUID = getObjectFromHandle((long)hParent);
}
if (iParentUID == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s' or a '%s' handle expected.\n"), fname, 1, "Figure",
"Frame uicontrol");
return FALSE;
}
getGraphicObjectProperty(iParentUID, __GO_TYPE__, jni_int, (void **)&piParentType);
if (iParentType != __GO_FIGURE__)
{
getGraphicObjectProperty(iParentUID, __GO_STYLE__, jni_int, (void **)&piParentStyle);
if (iParentType != __GO_UICONTROL__ ||
(iParentStyle != __GO_UI_FRAME__ && iParentStyle != __GO_UI_TAB__ && iParentStyle != __GO_UI_LAYER__))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s' or a '%s' handle expected.\n"), fname, 1, "Figure",
"Frame uicontrol");
return FALSE;
}
}
/* First parameter is the parent */
propertiesValuesIndices[parent_property] = 1;
// First input parameter which is a property name
beginIndex = 2;
}
/**
* Even number of input arguments
* All odd inputs are property names
* All even inputs are property values
*/
else
{
// First input parameter which is a property name
beginIndex = 1;
}
/* Get all properties positions */
for (inputIndex = beginIndex; inputIndex < Rhs; inputIndex = inputIndex + 2)
{
/* Read property name */
if ((!checkInputArgumentType(pvApiCtx, inputIndex, sci_strings)))
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, inputIndex);
return FALSE;
}
else
{
int* piAddr = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, inputIndex, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr, &propertyName))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, inputIndex);
return 1;
}
/* Bug 3031 */
/* We only want to compare propertyName along its length */
/* 'posi' must be matched to 'position' */
found = 0;
for (k = 0; k < iPropertiesCount ; k++)
{
if (strlen(propertyName) <= strlen(propertiesNames[k]))
{
if (strnicmp(propertyName, propertiesNames[k], strlen(propertyName)) == 0)
{
propertiesValuesIndices[k] = inputIndex + 1; /* Position of value for property */
found = 1;
break;
}
}
}
freeAllocatedSingleString(propertyName);
if (found == 0)
{
Scierror(999, _("%s: Unknown property: %s for '%s' handles.\n"), fname, propertyName, "Uicontrol");
return FALSE;
}
}
}
if (propertiesValuesIndices[style_property] != NOT_FOUND) /* Style found */
{
if ((checkInputArgumentType(pvApiCtx, propertiesValuesIndices[style_property], sci_strings)))
{
int* piAddr = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, propertiesValuesIndices[style_property], &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr, &styleProperty))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, propertiesValuesIndices[style_property]);
return 1;
}
if (strcmp(styleProperty, "frame") == 0)
{
//check scrollable property to create a scroll frame instead of normal frame
if (propertiesValuesIndices[scrollable_property] != NOT_FOUND)
{
char* pstScroll = NULL;
int iScroll = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, propertiesValuesIndices[scrollable_property], &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isStringType(pvApiCtx, piAddr) == 0 && isBooleanType(pvApiCtx, piAddr) == 0 && isScalar(pvApiCtx, piAddr) == 0)
{
Scierror(202, _("%s: Wrong type for argument #%d: string or boolean expected.\n"), fname, propertiesValuesIndices[scrollable_property]);
return 1;
}
if (isStringType(pvApiCtx, piAddr))
{
if (getAllocatedSingleString(pvApiCtx, piAddr, &pstScroll))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, propertiesValuesIndices[scrollable_property]);
return 1;
}
if (strcmp(pstScroll, "on") == 0)
{
iScroll = 1;
}
freeAllocatedSingleString(pstScroll);
}
else
{
if (getScalarBoolean(pvApiCtx, piAddr, &iScroll))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, propertiesValuesIndices[scrollable_property]);
return 1;
}
}
if (iScroll)
{
freeAllocatedSingleString(styleProperty);
styleProperty = os_strdup("framescrollable");
}
propertiesValuesIndices[scrollable_property] = NOT_FOUND;
}
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, propertiesValuesIndices[style_property]);
return FALSE;
}
}
/* Create a new uicontrol */
iUicontrol = CreateUIControl(styleProperty);
freeAllocatedSingleString(styleProperty);
if (iUicontrol == 0) /* Error in creation */
{
Scierror(999, _("%s: Could not create 'Uicontrol' handle.\n"), fname);
return FALSE;
}
GraphicHandle = getHandle(iUicontrol);
/* If no parent given then the current figure is the parent */
if (propertiesValuesIndices[parent_property] == NOT_FOUND)
{
/* Set the parent */
iCurrentFigure = getCurrentFigure();
if (iCurrentFigure == 0)
{
iCurrentFigure = createNewFigureWithAxes();
}
propertiesValuesIndices[parent_property] = PARENT_NOT_FOUND;
}
/* Read and set all properties */
for (inputIndex = 1; inputIndex < iPropertiesCount; inputIndex++) /* Style has already been set */
{
if (propertiesValuesIndices[inputIndex] == PARENT_NOT_FOUND)
{
//special case for not specified parent
//but set relationship at the good moment.
setGraphicObjectRelationship(iCurrentFigure, iUicontrol);
}
else if (propertiesValuesIndices[inputIndex] != NOT_FOUND)
{
int* piAddr = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, propertiesValuesIndices[inputIndex], &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (inputIndex == user_data_property || inputIndex == userdata_property) /* User data settings */
{
nbRow = -1;
nbCol = -1;
setStatus = callSetProperty(pvApiCtx, iUicontrol, piAddr, 0, 0, 0, (char*)propertiesNames[inputIndex]);
}
else /* All other properties */
{
/* Read property value */
switch (getInputArgumentType(pvApiCtx, propertiesValuesIndices[inputIndex]))
{
case sci_matrix:
{
double* pdblValue = NULL;
sciErr = getMatrixOfDouble(pvApiCtx, piAddr, &nbRow, &nbCol, &pdblValue);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, propertiesValuesIndices[inputIndex]);
return 1;
}
setStatus = callSetProperty(pvApiCtx, iUicontrol, pdblValue, sci_matrix, nbRow, nbCol, (char*)propertiesNames[inputIndex]);
break;
}
case sci_strings:
/* Index for String & TooltipString properties: Can be more than one character string */
if ((inputIndex == string_property) || (inputIndex == tooltipstring_property))
{
char** pstValue = NULL;
if (getAllocatedMatrixOfString(pvApiCtx, piAddr, &nbRow, &nbCol, &pstValue))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, propertiesValuesIndices[inputIndex]);
return 1;
}
setStatus = callSetProperty(pvApiCtx, iUicontrol, pstValue, sci_strings, nbRow, nbCol, (char*)propertiesNames[inputIndex]);
freeAllocatedMatrixOfString(nbRow, nbCol, pstValue);
}
else
{
char* pstValue = NULL;
if (getAllocatedSingleString(pvApiCtx, piAddr, &pstValue))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, propertiesValuesIndices[inputIndex]);
return 1;
}
nbRow = (int)strlen(pstValue);
nbCol = 1;
setStatus = callSetProperty(pvApiCtx, iUicontrol, pstValue, sci_strings, nbRow, nbCol, (char*)propertiesNames[inputIndex]);
freeAllocatedSingleString(pstValue);
}
break;
case sci_handles:
{
long long* pHandles = NULL;
sciErr = getMatrixOfHandle(pvApiCtx, piAddr, &nbRow, &nbCol, &pHandles);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for input argument #%d: Handle matrix expected.\n"), fname, propertiesValuesIndices[inputIndex]);
return 1;
}
setStatus = callSetProperty(pvApiCtx, iUicontrol, pHandles, sci_handles, nbRow, nbCol, (char*)propertiesNames[inputIndex]);
break;
}
case sci_tlist: //constraints and border
{
setStatus = callSetProperty(pvApiCtx, iUicontrol, piAddr, sci_tlist, 1, 1, (char*)propertiesNames[inputIndex]);
break;
}
default:
setStatus = SET_PROPERTY_ERROR;
break;
}
}
if (setStatus == SET_PROPERTY_ERROR)
{
Scierror(999, _("%s: Could not set property '%s'.\n"), fname, (char*)propertiesNames[inputIndex]);
return FALSE;
}
}
}
}
if (propertiesValuesIndices != NULL
&& (propertiesValuesIndices[sliderstep_property] == NOT_FOUND &&
(propertiesValuesIndices[min_property] != NOT_FOUND || propertiesValuesIndices[max_property] != NOT_FOUND))) /* SliderStep property not set */
{
/* Set SliderStep property to [1/100*(Max-Min) 1/10*(Max-Min)] */
double maxValue = 0;
double* pdblMaxValue = &maxValue;
double minValue = 0;
double* pdblMinValue = &minValue;
double pdblStep[2];
getGraphicObjectProperty(iUicontrol, __GO_UI_MIN__, jni_double, (void**) &pdblMinValue);
getGraphicObjectProperty(iUicontrol, __GO_UI_MAX__, jni_double, (void**) &pdblMaxValue);
pdblStep[0] = 0.01 * (maxValue - minValue);
pdblStep[1] = 0.1 * (maxValue - minValue);
setGraphicObjectProperty(iUicontrol, __GO_UI_SLIDERSTEP__, pdblStep, jni_double_vector, 2);
}
if ((nbInputArgument(pvApiCtx) < 2) || (propertiesValuesIndices[position_property] == NOT_FOUND)) /* Position property not set */
{
double* pdblPosition = NULL;
getGraphicObjectProperty(iUicontrol, __GO_POSITION__, jni_double_vector, (void**) &pdblPosition);
setGraphicObjectProperty(iUicontrol, __GO_POSITION__, pdblPosition, jni_double_vector, 4);
releaseGraphicObjectProperty(__GO_POSITION__, pdblPosition, jni_double_vector, 4);
}
if ((nbInputArgument(pvApiCtx) < 2) || (propertiesValuesIndices[visible_property] == NOT_FOUND)) /* Visible property not set */
{
/* Force the uicontrol to be visible because is invisible by default in the model (See bug #10346) */
int b = (int)TRUE;
setGraphicObjectProperty(iUicontrol, __GO_VISIBLE__, &b, jni_bool, 1);
}
FREE(propertiesValuesIndices);
/* Create return variable */
if (createScalarHandle(pvApiCtx, nbInputArgument(pvApiCtx) + 1, GraphicHandle))
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return TRUE;
}
/*--------------------------------------------------------------------------*/
int C2F(sci_errclear)(char *fname,unsigned long fname_len)
{
Rhs = Max(0,Rhs);
CheckRhs(0,2);
CheckLhs(1,1);
if (Rhs == 1)
{
SciErr sciErr;
int *piAddressVarOne = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (isDoubleType(pvApiCtx, piAddressVarOne))
{
double dValue = 0.;
int iValue = 0;
int iLastErrorValue = getLastErrorValue();
if (!isScalar(pvApiCtx, piAddressVarOne))
{
Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"), fname, 1);
return 0;
}
getScalarDouble(pvApiCtx, piAddressVarOne, &dValue);
iValue = (int)dValue;
if ((double)iValue != dValue)
{
Scierror(999,_("%s: Wrong value for input argument #%d: An integer value expected.\n"), fname, 1);
return 0;
}
if ((iValue == iLastErrorValue) || (iValue <= 0))
{
/* clear fortran common error */
C2F(errgst).err2 = 0;
/* clear last error buffer (C) */
clearLastError();
}
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d: An integer value expected.\n"), fname, 1);
return 0;
}
}
else
{
/* clear fortran common error */
C2F(errgst).err2 = 0;
/* clear last error buffer (C) */
clearLastError();
}
LhsVar(1) = 0;
PutLhsVar();
return 0;
}
int sci_tbx_sum(char *fname) {
SciErr sciErr;
int *piAddressVarOne = NULL;
double dVarOne = 0.0;
int *piAddressVarTwo = NULL;
double dVarTwo = 0.0;
double dOut = 0.0;
/* check that we have only 2 input arguments */
/* check that we have only 1 output argument */
CheckRhs(2,2);
CheckLhs(1,1);
/* get Address of inputs */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
/* check input type */
if ( !isDoubleType(pvApiCtx, piAddressVarOne) )
{
Scierror(999,"%s: Wrong type for input argument #%d: A scalar expected.\n", fname, 1);
return 0;
}
if ( !isDoubleType(pvApiCtx, piAddressVarTwo) )
{
Scierror(999,"%s: Wrong type for input argument #%d: A scalar expected.\n", fname, 2);
return 0;
}
if ( getScalarDouble(pvApiCtx, piAddressVarOne, &dVarOne) )
{
Scierror(999,"%s: Wrong size for input argument #%d: A scalar expected.\n", fname, 1);
return 0;
}
if ( getScalarDouble(pvApiCtx, piAddressVarTwo, &dVarTwo) )
{
Scierror(999,"%s: Wrong size for input argument #%d: A scalar expected.\n", fname, 2);
return 0;
}
/* call c business function */
dOut = business_sum(dVarOne, dVarTwo);
/* create result on stack */
createScalarDouble(pvApiCtx, Rhs + 1, dOut);
LhsVar(1) = Rhs + 1;
}
int sci_mpi_send(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int iRet = 0;
int *piAddr = NULL;
int *piAddr2 = NULL;
int *piBuffer = NULL;
int iBufferSize = 0;
double NodeID = 0;
CheckInputArgument(pvApiCtx, 2, 2);
CheckOutputArgument(pvApiCtx, 1, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddr2, &NodeID))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar integer value expected.\n"), fname, 1);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
//convert data from Scilab to MPI
iRet = serialize_to_mpi(pvApiCtx, piAddr, &piBuffer, &iBufferSize);
if (iRet)
{
Scierror(999, _("Unable to serialize data\n"));
return 0;
}
//send data
iRet = MPI_Send(piBuffer, iBufferSize, MPI_INT, (int)NodeID, TAG, MPI_COMM_WORLD);
FREE(piBuffer);
if (iRet != MPI_SUCCESS)
{
char error_string[MPI_MAX_ERROR_STRING];
int length_of_error_string;
MPI_Error_string(iRet, error_string, &length_of_error_string);
Scierror(999, _("%s: Could not send the variable to the node %d: %s\n"), fname, NodeID, error_string);
return 0;
}
if (createScalarBoolean(pvApiCtx, nbInputArgument(pvApiCtx) + 1, !iRet))
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_mputl(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int *piAddressVarOne = NULL;
int *piAddressVarTwo = NULL;
char **pStVarOne = NULL;
int *lenStVarOne = NULL;
int mOne = 0, nOne = 0;
int mnOne = 0;
char *filename = NULL;
int fileDescriptor = -1;
BOOL bCloseFile = FALSE;
int i = 0;
int mputlErr = MPUTL_ERROR;
if (Rhs != 2)
{
Scierror(999, _("%s: Wrong number of input arguments: %d expected.\n"), fname, 2);
return 0;
}
if (Lhs != 1)
{
Scierror(999, _("%s: Wrong number of output arguments: %d expected.\n"), fname, 1);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
if ( isDoubleType(pvApiCtx, piAddressVarTwo) )
{
double dValue = 0.;
if (!isScalar(pvApiCtx, piAddressVarTwo))
{
Scierror(999,_("%s: Wrong size for input argument #%d: Integer expected.\n"), fname, 2);
return 0;
}
if ( getScalarDouble(pvApiCtx, piAddressVarTwo, &dValue) == 0)
{
fileDescriptor = (int)dValue;
}
else
{
Scierror(999,_("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else if ( isStringType(pvApiCtx, piAddressVarTwo) )
{
if (!isScalar(pvApiCtx, piAddressVarTwo))
{
Scierror(999,_("%s: Wrong size for input argument #%d: String expected.\n"), fname, 2);
return 0;
}
if (getAllocatedSingleString(pvApiCtx, piAddressVarTwo, &filename) == 0)
{
#define WRITE_ONLY_TEXT_MODE "wt"
int f_swap = 0;
double res = 0.0;
int ierr = 0;
char *expandedFileName = expandPathVariable(filename);
C2F(mopen)(&fileDescriptor, expandedFileName, WRITE_ONLY_TEXT_MODE, &f_swap, &res, &ierr);
if (expandedFileName) {FREE(expandedFileName); expandedFileName = NULL;}
switch (ierr)
{
case MOPEN_NO_ERROR:
bCloseFile = TRUE;
break;
case MOPEN_NO_MORE_LOGICAL_UNIT:
{
freeAllocatedSingleString(filename);
Scierror(66, _("%s: Too many files opened!\n"), fname);
return 0;
}
break;
case MOPEN_CAN_NOT_OPEN_FILE:
{
Scierror(999, _("%s: Cannot open file %s.\n"), fname, filename);
freeAllocatedSingleString(filename);
return 0;
}
break;
case MOPEN_NO_MORE_MEMORY:
{
freeAllocatedSingleString(filename);
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
break;
case MOPEN_INVALID_FILENAME:
{
if (filename)
{
Scierror(999, _("%s: invalid filename %s.\n"), fname, filename);
}
else
{
freeAllocatedSingleString(filename);
Scierror(999, _("%s: invalid filename.\n"), fname);
}
return 0;
}
break;
case MOPEN_INVALID_STATUS: default:
{
freeAllocatedSingleString(filename);
Scierror(999, _("%s: invalid status.\n"), fname);
return 0;
}
break;
}
bCloseFile = TRUE;
freeAllocatedSingleString(filename);
}
else
{
Scierror(999,_("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d: a String or Integer expected.\n"), fname, 2);
}
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (!isStringType(pvApiCtx, piAddressVarOne))
{
Scierror(999,_("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
return 0;
}
sciErr = getMatrixOfString(pvApiCtx, piAddressVarOne,&mOne, &nOne, NULL, NULL);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if ( !((mOne == 1) || (nOne == 1)) )
{
Scierror(999,_("%s: Wrong size for input argument #%d: A 1-by-n or m-by-1 array expected.\n"), fname, 1);
return 0;
}
mnOne = mOne * nOne;
lenStVarOne = (int*)MALLOC(sizeof(int) * mnOne);
if (lenStVarOne == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
sciErr = getMatrixOfString(pvApiCtx, piAddressVarOne,&mOne, &nOne, lenStVarOne, NULL);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
pStVarOne = (char**) MALLOC(sizeof(char*) * mnOne);
if (pStVarOne == NULL)
{
FREE(lenStVarOne); lenStVarOne = NULL;
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
for (i = 0; i < mnOne; i++)
{
pStVarOne[i] = (char*)MALLOC(sizeof(char) * (lenStVarOne[i] + 1));
if (pStVarOne[i] == NULL)
{
freeArrayOfString(pStVarOne, i);
if (lenStVarOne) {FREE(lenStVarOne); lenStVarOne = NULL;}
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
}
sciErr = getMatrixOfString(pvApiCtx, piAddressVarOne, &mOne, &nOne, lenStVarOne, pStVarOne);
if (lenStVarOne) {FREE(lenStVarOne); lenStVarOne = NULL;}
if(sciErr.iErr)
{
freeArrayOfString(pStVarOne, mnOne);
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
mputlErr = mputl(fileDescriptor, pStVarOne, mnOne);
freeArrayOfString(pStVarOne, mnOne);
if (bCloseFile)
{
double dErrClose = 0.;
C2F(mclose)(&fileDescriptor, &dErrClose);
bCloseFile = FALSE;
}
switch (mputlErr)
{
case MPUTL_NO_ERROR:
createScalarBoolean(pvApiCtx, Rhs + 1, TRUE);
LhsVar(1) = Rhs + 1;
PutLhsVar();
break;
case MPUTL_INVALID_FILE_DESCRIPTOR:
// commented for compatiblity
// Scierror(999, _("%s: invalid file descriptor.\n"), fname);
// break;
case MPUTL_ERROR:
case MPUTL_NO_WRITE_RIGHT:
default:
createScalarBoolean(pvApiCtx, Rhs + 1, FALSE);
LhsVar(1) = Rhs + 1;
PutLhsVar();
break;
}
return 0;
}
int sci_mpi_recv(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int iRet = 0;
int *piBuffer = NULL;
int iBufferSize = 0;
int *piAddr1 = NULL;
int *piAddr2 = NULL;
double Tag = 0;
double Rank = 0;
MPI_Status status;
CheckInputArgument(pvApiCtx, 2, 2);
CheckOutputArgument(pvApiCtx, 1, 1);
//Rank
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddr1, &Rank))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar integer value expected.\n"), fname, 1);
return 0;
}
//Tag
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddr2, &Tag))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar integer value expected.\n"), fname, 2);
return 0;
}
//wait message "Rank" node
iRet = MPI_Probe((int)Rank, (int)Tag, MPI_COMM_WORLD, &status);
if (iRet != MPI_SUCCESS)
{
char error_string[MPI_MAX_ERROR_STRING];
int length_of_error_string;
MPI_Error_string(iRet, error_string, &length_of_error_string);
Scierror(999, _("%s: MPI_Probe failed. Rank %d / Tag %d: %s\n"), fname, Rank, Tag, error_string);
return 0;
}
//get data size
iRet = MPI_Get_count(&status, MPI_INT, &iBufferSize);
if (iRet != MPI_SUCCESS)
{
char error_string[MPI_MAX_ERROR_STRING];
int length_of_error_string;
MPI_Error_string(iRet, error_string, &length_of_error_string);
Scierror(999, _("%s: MPI_Get_count failed. Rank %d / Tag %d: %s\n"), fname, Rank, Tag, error_string);
return 0;
}
//alloc memory to receive data
piBuffer = (int *)MALLOC(sizeof(int) * iBufferSize);
if (piBuffer == NULL)
{
Scierror(999, _("%s: Could not create the received variable.\n"), fname);
return 0;
}
//receive data
iRet = MPI_Recv(piBuffer, iBufferSize, MPI_INT, (int)Rank, (int)Tag, MPI_COMM_WORLD, &status);
if (iRet != MPI_SUCCESS)
{
char error_string[MPI_MAX_ERROR_STRING];
int length_of_error_string;
MPI_Error_string(iRet, error_string, &length_of_error_string);
Scierror(999, _("%s: MPI_Recv failed. Rank %d / Tag %d: %s\n"), fname, Rank, Tag, error_string);
return 0;
}
//convert data from MPI to Scilab
iRet = deserialize_from_mpi(pvApiCtx, piBuffer, iBufferSize);
FREE(piBuffer);
if (iRet)
{
Scierror(999, _("%s: Unable to deserialize data !\n"), fname);
return 0;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
