/*----------------------------------------------------------------------------*/
int sci_stripblanks(char *fname, unsigned long fname_len)
{
char **Input_String_Matrix_One = NULL;
char **Output_String_Matrix = NULL;
int numRow = 0; /*@ The row number of the output string matrix*/
int numCol = 0; /*@ The col number of the output string matrix*/
int m1 = 0, n1 = 0, mn = 0, i = 0;
BOOL bREMOVE_TAB = FALSE; /* DEFAULT no TAB */
int Type_One = VarType(1);
CheckRhs(1, 2);
CheckLhs(1, 1);
if (Rhs == 2)
{
int Type_Two = VarType(2);
if (Type_Two == sci_boolean)
{
int m2 = 0, n2 = 0, l2 = 0;
GetRhsVar(2, MATRIX_OF_BOOLEAN_DATATYPE, &m2, &n2, &l2);
bREMOVE_TAB = (BOOL) * istk(l2);
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A boolean expected.\n"), fname, 2);
return 0;
}
}
switch (Type_One)
{
case sci_matrix :
{
/* case stripblanks([]) */
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &Input_String_Matrix_One);
if ( (m1 == 0) && (n1 == 0) )
{
int l = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l);
LhsVar(1) = Rhs + 1 ;
PutLhsVar();
return 0;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of strings or empty matrix expected.\n"), fname, 1);
return 0;
}
}
break;
case sci_strings :
{
GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Input_String_Matrix_One);
mn = m1 * n1;
}
break;
default :
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of strings or empty matrix expected.\n"), fname, 1);
return 0;
}
if (mn > 0)
{
Output_String_Matrix = (char**)MALLOC(sizeof(char*) * (mn));
}
else
{
Output_String_Matrix = NULL;
}
if (Output_String_Matrix == NULL)
{
freeArrayOfString(Input_String_Matrix_One, mn);
Scierror(999, _("%s : No more memory.\n"), fname);
return 0;
}
for (i = 0; i < mn ; i++) /*@ To malloc a space the same as input string*/
{
Output_String_Matrix[i] = (char*)MALLOC(sizeof(char) * (strlen(Input_String_Matrix_One[i]) + 1));
if (Output_String_Matrix[i] == NULL)
{
freeArrayOfString(Input_String_Matrix_One, mn);
freeArrayOfString(Output_String_Matrix, i);
Scierror(999, _("%s : No more memory.\n"), fname);
return 0;
}
}
/*@ The stripblank function*/
stripblanks(Input_String_Matrix_One, Output_String_Matrix, mn, bREMOVE_TAB);
freeArrayOfString(Input_String_Matrix_One, mn);
/* put result on scilab stack */
numRow = m1;
numCol = n1;
CreateVarFromPtr( Rhs + 1, MATRIX_OF_STRING_DATATYPE, &numRow, &numCol, Output_String_Matrix); /*@ Output*/
/* free pointers */
freeArrayOfString(Output_String_Matrix, mn);
LhsVar(1) = Rhs + 1 ;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_newest(char *fname, unsigned long fname_len)
{
CheckLhs(1, 1);
if (Rhs == 0)
{
/* newest() returns [] */
int m1 = 0, n1 = 0, l1 = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
int m1 = 0, n1 = 0, l1 = 0;
int RetIndex = 1;
if (Rhs == 1)
{
if (GetType(1) == sci_matrix)
{
GetRhsVar(1, MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &l1);
if ( (m1 == 0) && (n1 == 0) ) /* newest([]) returns [] */
{
m1 = 0;
n1 = 0;
l1 = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname);
return 0;
}
}
else
{
if (GetType(1) == sci_strings)
{
char **Str = NULL;
GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Str);
RetIndex = GetIndexLastModifiedFileInList(Str, m1 * n1);
freeArrayOfString(Str, m1 * n1);
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname);
return 0;
}
}
}
else /* Rhs > 1 */
{
int i = 1;
char **Str = NULL;
int RhsBackup = Rhs;
/* check that all input arguments are strings */
for (i = 1; i <= Rhs ; i++)
{
if (GetType(i) != sci_strings)
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, i);
return 0;
}
}
Str = (char**)MALLOC(sizeof(char*) * RhsBackup);
if (Str)
{
// Fake call to CheckRhs to initialize gateway name returned by Get_Iname()
// And used in error messages in GetRhsVar
// See bug #11398
CheckRhs(Rhs, Rhs);
for (i = 1; i <= RhsBackup; i++)
{
GetRhsVar(i, STRING_DATATYPE, &m1, &n1, &l1);
Str[i - 1] = strdup(cstk(l1));
}
RetIndex = GetIndexLastModifiedFileInList(Str, RhsBackup);
freeArrayOfString(Str, RhsBackup);
}
}
/* Output on scilab's stack */
if (RetIndex >= 1)
{
int *paramoutINT = (int*)MALLOC(sizeof(int));
*paramoutINT = RetIndex;
n1 = 1;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_INTEGER_DATATYPE, &n1, &n1, ¶moutINT);
LhsVar(1) = Rhs + 1;
if (paramoutINT)
{
FREE(paramoutINT);
paramoutINT = NULL;
}
PutLhsVar();
}
else
{
m1 = 0;
n1 = 0;
l1 = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_TCL_ExistVar(char *fname,unsigned long l)
{
static int l1,n1,m1;
static int l2,n2,m2;
Tcl_Interp *TCLinterpreter=NULL;
CheckRhs(1,2);
CheckLhs(1,1);
if (GetType(1) == sci_strings)
{
char *VarName=NULL;
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
VarName=cstk(l1);
if (!existsGlobalInterp())
{
Scierror(999,_("%s: Error main TCL interpreter not initialized.\n"),fname);
return 0;
}
if (Rhs==2)
{
/* two arguments given - get a pointer on the slave interpreter */
if (GetType(2) == sci_strings)
{
GetRhsVar(2,STRING_DATATYPE,&m2,&n2,&l2);
TCLinterpreter=Tcl_GetSlave(getTclInterp(),cstk(l2));
releaseTclInterp();
if (TCLinterpreter==NULL)
{
Scierror(999,_("%s: No such slave interpreter.\n"),fname);
return 0;
}
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d: String expected.\n"), fname, 2);
return 0;
}
}
else
{
/* only one argument given - use the main interpreter */
TCLinterpreter=getTclInterp();
releaseTclInterp();
}
n1=1;
if ( Tcl_GetVar(TCLinterpreter, VarName, TCL_GLOBAL_ONLY) )
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(TRUE);
}
else
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(FALSE);
}
LhsVar(1)=Rhs+1;
PutLhsVar();
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
return 0;
}
return 0;
}
extern int intpbgc(char *fname)
{
int mA,nA,*ia;
int mb,nb,msol,nsol,nniter,mniter,meps,neps,mkry,nkry,nlfil,mlfil;
int b,sol,niter,eps,kry,lfil,pierr;
int mdt=1,ndt=1,pdt,k;
int mierr=1,nierr=1,iout=6,method=2;
int iwk, *jw, *jlu, *ju, *ipar;
double *w,*alu,*fpar;
SciSparse A;
CheckRhs(1,8);
CheckLhs(1,2);
if (VarType(1)==5){
GetRhsVar(1,"s",&mA,&nA,&A);
if (mA!=nA){
Scierror(501,"%s: input matrix must be square \r\n",fname);
}
} else {
Scierror(501,"%s: input matrix must be sparse \r\n",fname);
return 0;
}
if (VarType(2)==1){
GetRhsVar(2,"d",&mb,&nb,&b);
if ((mb!=nA)||(nb!=1)){
Scierror(501,"%s: incompatible rhs \r\n",fname);
}
} else {
Scierror(501,"%s: rhs must be a vector \r\n",fname);
return 0;
}
if (VarType(3)==1){
GetRhsVar(3,"d",&msol,&nsol,&sol);
if ((msol!=nA)||(nsol!=1)){
Scierror(501,"%s: incompatible init \r\n",fname);
}
} else {
Scierror(501,"%s: init must be a vector \r\n",fname);
return 0;
}
if (VarType(4)==1){
GetRhsVar(4,"i",&nniter,&mniter,&niter);
if (mniter*nniter!= 1){
Scierror(501,"%s: niter must be a single integer \r\n",fname);
}
} else {
Scierror(501,"%s: niter must be integer \r\n",fname);
return 0;
}
if (VarType(5)==1){
GetRhsVar(5,"d",&meps,&neps,&eps);
if (meps*neps!= 1){
Scierror(501,"%s: eps must be a real \r\n",fname);
}
} else {
Scierror(501,"%s: init must be a real \r\n",fname);
return 0;
}
if (VarType(6)==1){
GetRhsVar(6,"i",&mlfil,&nlfil,&lfil);
if (mlfil*nlfil!= 1){
Scierror(501,"%s: lfil must be a single integer \r\n",fname);
}
} else {
Scierror(501,"%s: lfil must be a integer \r\n",fname);
return 0;
}
if (Rhs>=7) {
if (VarType(7)==1){
GetRhsVar(7,"d",&mdt,&ndt,&pdt);
if ((mdt!=1)||(ndt!=1)){
Scierror(501,"%s: drop must be a double \r\n",fname);
}
} else {
Scierror(501,"%s: drop must be a double \r\n",fname);
return 0;
}
} else {
CreateVar(7,"d",&mdt,&ndt,&pdt);
*stk(pdt)=(double) 0.001*eltm(A) ;
}
CreateVar(8,"i",&mierr,&nierr,&pierr);
iwk=(A.m)*(2*(*istk(lfil))+1)+1;
jw=(int *) malloc(2*A.m*sizeof(int));
w= (double *) malloc(A.m*sizeof(double));
alu= (double *) malloc(iwk*sizeof(double));
jlu= (int *) malloc(iwk*sizeof(int));
ju= (int *) malloc((A.m)*sizeof(int));
ia=Sci2spk(&A);
C2F(ilut)(&A.m,A.R,A.icol,ia,istk(lfil),stk(pdt),alu,jlu,ju,&iwk,w,jw,istk(pierr));
free(w);
free(jw);
if (*istk(pierr)!=0){
free(ju);
free(jlu);
free(alu);
if (*istk(pierr)==-1) {
Scierror(501,"%s: input matrix may be wrong \r\n",fname);
} else if (*istk(pierr)==-2) {
Scierror(501,"%s: not enough memory for matrix L \r\n",fname);
} else if (*istk(pierr)==-3) {
Scierror(501,"%s: not enough memory for matrix U \r\n",fname);
} else if (*istk(pierr)==-4) {
Scierror(501,"%s: illegal value for lfil \r\n",fname);
} else if (*istk(pierr)==-5) {
Scierror(501,"%s: zero row encountered in A or U \r\n",fname);
} else {
Scierror(501,"%s: zero pivot encountered at step number %d \r\n",fname,*istk(pierr));
}
} else {
iwk=(A.m)*7;
w= (double *) malloc(iwk*sizeof(double));
fpar=(double *) malloc(16*sizeof(double));
ipar=(int *) malloc(16*sizeof(int));
for (k = 0; k < 16; ++k)
ipar[k]=0;
ipar[1]=2;
ipar[2]=1;
ipar[3]=iwk;
ipar[4]=10;
ipar[5]=*istk(niter);
fpar[0]=*stk(eps);
fpar[1]=(double) 1.0E-20;
C2F(runrc)(&A.m, stk(b), stk(sol), ipar, fpar ,w ,A.R ,A.icol , ia, alu, jlu, ju, &method, &iout);
free(fpar);
*istk(pierr)=ipar[0];
free(ipar);
free(w);
free(ju);
free(jlu);
free(alu);
}
LhsVar(1)=3;
LhsVar(2)=8;
return(0);
}
/*--------------------------------------------------------------------------*/
int sci_legendre(char *fname,unsigned long fname_len)
{
/*
* Interface onto the (Slatec) dxleg.f code.
* Scilab calling sequence :
*
* p = legendre(n, m, x [, norm_flag] )
*
* x is a vector with mnx elements (it is better to
* have a row vector but this is not forced)
*
* n : a non negative int scalar (or a vector of such
* int regularly speced with an increment of 1)
* m : same constraints than for n
*
* n and m may not be both vectors
*
* norm_flag : optionnal. When it is present and equal to "norm"
* it is a normalised version which is computed
* AUTHOR
* Bruno Pincon <*****@*****.**>
*/
int it = 0, lc = 0, mM = 0, nM = 0, lM = 0, m1 = 0, m2 = 0, mN = 0, nN = 0;
int lN = 0, n1 = 0, n2 = 0, mx = 0, nx = 0, lx = 0, mnx = 0, ms = 0, ns = 0, ls = 0;
int M_is_scalar = 0, N_is_scalar = 0, normalised = 0, MNp1 = 0, lpqa = 0, lipqa = 0, *ipqa = NULL;
double *x = NULL, xx = 0., dnu1 = 0., *pqa = NULL;
int id = 0, ierror = 0, i = 0, j = 0, nudiff = 0;
CheckLhs(1, 1);
CheckRhs(3, 4);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mN, &nN, &lN);
if ( ! verify_cstr(stk(lN), mN*nN, &n1, &n2) )
{
Scierror(999,_("%s: Wrong type for first input argument.\n"), fname);
return 0;
};
if ( mN == 1 && nN == 1) N_is_scalar = 1;
GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE, &mM, &nM, &lM);
if ( ! verify_cstr(stk(lM), mM*nM, &m1, &m2) )
{
Scierror(999,_("%s: Wrong type for input argument #%d.\n"), fname,2);
return 0;
}
if ( mM == 1 && nM == 1) M_is_scalar = 1;
if ( ! M_is_scalar && ! N_is_scalar )
{
Scierror(999,_("%s: Only one of arg1 and arg2 may be a vector.\n"), fname);
return 0;
};
GetRhsCVar(3,MATRIX_OF_DOUBLE_DATATYPE, &it, &mx, &nx, &lx, &lc);
if ( it != 0 )
{
Scierror(999,_("%s: Wrong type for input argument #%d: Real matrix expected.\n"), fname, 3);
return 0;
};
mnx = mx*nx;
x = stk(lx);
for ( i = 0 ; i < mnx ; i++ )
if ( ! (fabs(x[i]) < 1.0) )
{
Scierror(999,_("%s: Wrong value for input argument #%d: Matrix with elements in (%d,%d) expected.\n"), fname,3,-1,1);
return 0;
};
if ( Rhs == 4 )
{
GetRhsVar(4,STRING_DATATYPE, &ms, &ns, &ls);
if ( strcmp(cstk(ls),"norm") == 0)
{
normalised = 1;
}
else
{
normalised = 0;
}
}
else
{
normalised = 0;
}
MNp1 = Max (n2 - n1, m2 - m1) + 1;
CreateVar(Rhs+1, MATRIX_OF_DOUBLE_DATATYPE, &MNp1, &mnx, &lpqa);
pqa = stk(lpqa);
CreateVar(Rhs+2, MATRIX_OF_INTEGER_DATATYPE, &MNp1, &mnx, &lipqa);
ipqa = istk(lipqa);
if ( normalised )
{
id = 4;
}
else
{
id = 3;
}
nudiff = n2 - n1;
dnu1 = (double) n1;
for ( i = 0 ; i < mnx ; i++ )
{
xx = fabs(x[i]); /* dxleg computes only for x in [0,1) */
F2C(dxlegf) (&dnu1, &nudiff, &m1, &m2, &xx, &id,
stk(lpqa+i*MNp1), istk(lipqa+i*MNp1), &ierror);
if ( ierror != 0 )
{
if ( ierror == 207 ) /* @TODO what is 207 ? */
{
Scierror(999,_("%s: overflow or underflow of an extended range number\n"), fname);
}
else
{
Scierror(999,_("%s: error number %d\n"), fname, ierror);
}
return 0;
};
}
/* dxlegf returns the result under a form (pqa,ipqa) (to
* compute internaly with an extended exponent range)
* When the "exponent" part (ipqa) is 0 then the number is exactly
* given by pqa else it leads to an overflow or an underflow.
*/
for ( i = 0 ; i < mnx*MNp1 ; i++ )
{
if ( ipqa[i] < 0 )
{
pqa[i] = 0.0;
}
if ( ipqa[i] > 0 )
{
pqa[i] = pqa[i] * return_an_inf(); /* pqa[i] * Inf to have the sign */
}
}
/* complete the result by odd/even symmetry for negative x */
for ( i = 0 ; i < mnx ; i++ )
{
if ( x[i] < 0.0 )
{
if ( (n1+m1) % 2 == 1 )
{
for ( j = 0 ; j < MNp1 ; j+=2 )
{
pqa[i*MNp1 + j] = -pqa[i*MNp1 + j];
}
}
else
{
for ( j = 1 ; j < MNp1 ; j+=2 )
{
pqa[i*MNp1 + j] = -pqa[i*MNp1 + j];
}
}
}
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int inteval_cshep2d(char *fname, unsigned long fname_len)
{
/*
* [f [,dfdx, dfdy [, dffdxx, dffdxy, dffdyy]]] = eval_cshep2d(xp, yp, tlcoef)
*/
int minrhs = 3, maxrhs = 3, minlhs = 1, maxlhs = 6;
int mx = 0, nx = 0, lx = 0, my = 0, ny = 0, ly = 0, mt = 0, nt = 0, lt = 0;
char **Str = NULL;
int m1 = 0, n1 = 0, m2 = 0, n2 = 0, m3 = 0, n3 = 0, m4 = 0, n4 = 0, m5 = 0, n5 = 0, m6 = 0, n6 = 0, m7 = 0, n7 = 0, m8 = 0, n8 = 0;
int lxyz = 0, lgrid = 0, lrmax = 0, lrw = 0, la = 0;
double *xp = NULL, *yp = NULL, *xyz = NULL, *grid = NULL, *f = NULL, *dfdx = NULL, *dfdy = NULL, *dffdxx = NULL, *dffdyy = NULL, *dffdxy = NULL;
int i = 0, ier = 0, n = 0, np = 0, nr = 0, lf = 0, ldfdx = 0, ldfdy = 0, ldffdxx = 0, ldffdyy = 0, ldffdxy = 0;
SciIntMat Cell, Next;
int *cell = NULL, *next = NULL;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &my, &ny, &ly);
for (i = 1; i <= minrhs - 1; i++)
{
SciErr sciErr;
int *piAddressVar = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVar))
{
Scierror(202, _("%s: Wrong type for argument %d: Real matrix expected.\n"), fname, i);
return 0;
}
}
if ( mx != my || nx != ny )
{
Scierror(999,_("%s: Wrong size for input arguments #%d and #%d: Same sizes expected.\n"),fname,1,2);
return 0;
}
GetRhsVar(3,TYPED_LIST_DATATYPE,&mt, &nt, <);
GetListRhsVar(3, 1,MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Str); /* m1 = 1, n1 = 8 ? a verifier */
if ( strcmp(Str[0],"cshep2d") != 0)
{
/* Free Str */
if (Str)
{
int li = 0;
while ( Str[li] != NULL)
{
FREE(Str[li]);
Str[li] = NULL;
li++;
};
FREE(Str);
Str = NULL;
}
Scierror(999,_("%s: Wrong type for input argument #%d: %s tlist expected.\n"), fname,2,"cshep2d");
return 0;
}
/* Free Str */
if (Str)
{
int li=0;
while ( Str[li] != NULL)
{
FREE(Str[li]);
Str[li] = NULL;
li++;
};
FREE(Str);
Str = NULL;
}
GetListRhsVar(3, 2,MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &lxyz); /* m2 = n , n2 = 3 */
GetListRhsVar(3, 3,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m3, &n3, (int *)&Cell); /* m3 = nr, n3 = nr */
GetListRhsVar(3, 4,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m4, &n4, (int *)&Next); /* m4 = 1 , n4 = n */
GetListRhsVar(3, 5,MATRIX_OF_DOUBLE_DATATYPE, &m5, &n5, &lgrid); /* m5 = 1 , n5 = 4 */
GetListRhsVar(3, 6,MATRIX_OF_DOUBLE_DATATYPE, &m6, &n6, &lrmax); /* m6 = 1 , n6 = 1 */
GetListRhsVar(3, 7,MATRIX_OF_DOUBLE_DATATYPE, &m7, &n7, &lrw); /* m7 = 1 , n7 = n */
GetListRhsVar(3, 8,MATRIX_OF_DOUBLE_DATATYPE, &m8, &n8, &la); /* m8 = 9 , n8 = n */
cell = (int *)Cell.D; next = (int *)Next.D;
xp = stk(lx); yp = stk(ly); np = mx*nx;
n = m2; nr = m3;
xyz = stk(lxyz); grid = stk(lgrid);
CreateVar(4,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lf); f = stk(lf);
if ( Lhs > 1 )
{
CreateVar(5,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldfdx); dfdx = stk(ldfdx);
CreateVar(6,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldfdy); dfdy = stk(ldfdy);
}
if ( Lhs > 3 )
{
CreateVar(7,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdxx); dffdxx = stk(ldffdxx);
CreateVar(8,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdxy); dffdyy = stk(ldffdxy);
CreateVar(9,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdyy); dffdxy = stk(ldffdyy);
}
switch( Lhs )
{
case ( 1 ) :
for ( i = 0 ; i < np ; i++ )
/* DOUBLE PRECISION FUNCTION CS2VAL (PX,PY,N,X,Y,F,NR,
* LCELL,LNEXT,XMIN,YMIN,DX,DY,RMAX,RW,A)
*/
f[i] = C2F(cs2val)(&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2*n], &nr,
cell, next, grid, &grid[1], &grid[2], &grid[3],
stk(lrmax), stk(lrw), stk(la));
LhsVar(1) = 4;
break;
case ( 2 ) :
case ( 3 ) :
for ( i = 0 ; i < np ; i++ )
/* SUBROUTINE CS2GRD (PX,PY,N,X,Y,F,NR,LCELL,LNEXT,XMIN,
*. YMIN,DX,DY,RMAX,RW,A, C,CX,CY,IER)
*/
C2F(cs2grd) (&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2*n], &nr,
cell, next, grid, &grid[1], &grid[2], &grid[3],
stk(lrmax), stk(lrw), stk(la), &f[i], &dfdx[i], &dfdy[i], &ier);
LhsVar(1) = 4;
LhsVar(2) = 5;
LhsVar(3) = 6;
break;
case ( 4 ) :
case ( 5 ) :
case ( 6 ) :
for ( i = 0 ; i < np ; i++ )
{
/* SUBROUTINE CS2HES (PX,PY,N,X,Y,F,NR,LCELL,LNEXT,XMIN,
*. YMIN,DX,DY,RMAX,RW,A, C,CX,CY,CXX,CXY,CYY,IER)
*/
C2F(cs2hes) (&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2*n], &nr,
cell, next, grid, &grid[1], &grid[2], &grid[3],
stk(lrmax), stk(lrw), stk(la), &f[i], &dfdx[i], &dfdy[i],
&dffdxx[i], &dffdxy[i], &dffdyy[i], &ier);
}
LhsVar(1) = 4;
LhsVar(2) = 5;
LhsVar(3) = 6;
LhsVar(4) = 7;
LhsVar(5) = 8;
LhsVar(6) = 9;
break;
}
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_x_dialog(char *fname,unsigned long fname_len)
{
int nbRow = 0, nbCol = 0;
int messageBoxID = 0;
char **initialValueAdr = 0;
char **labelsAdr = 0;
int userValueSize = 0;
char **userValue = NULL;
int emptyMatrixAdr = 0;
CheckRhs(1,2);
CheckLhs(0,1);
if (VarType(1) == sci_strings)
{
GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &nbRow, &nbCol, &labelsAdr);
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: Vector of strings expected.\n"), fname, 1);
return FALSE;
}
/* Create the Java Object */
messageBoxID = createMessageBox();
/* Title is a default title */
setMessageBoxTitle(messageBoxID, _("Scilab Input Value Request"));
/* Message */
setMessageBoxMultiLineMessage(messageBoxID, getStringMatrixFromStack((size_t)labelsAdr), nbCol*nbRow);
freeArrayOfString(labelsAdr, nbCol*nbRow);
if (Rhs == 2)
{
if (VarType(2) == sci_strings)
{
GetRhsVar(2,MATRIX_OF_STRING_DATATYPE,&nbRow,&nbCol,&initialValueAdr);
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: Vector of strings expected.\n"), fname, 2);
return FALSE;
}
setMessageBoxInitialValue(messageBoxID, getStringMatrixFromStack((size_t)initialValueAdr), nbCol*nbRow);
freeArrayOfString(initialValueAdr, nbCol*nbRow);
}
/* Display it and wait for a user input */
messageBoxDisplayAndWait(messageBoxID);
/* Read the user answer */
userValueSize = getMessageBoxValueSize(messageBoxID);
if (userValueSize == 0)
{
nbRow = 0;nbCol = 0;
CreateVar(Rhs+1, MATRIX_OF_DOUBLE_DATATYPE, &nbRow, &nbCol, &emptyMatrixAdr);
}
else
{
userValue = getMessageBoxValue(messageBoxID);
nbCol = 1;
CreateVarFromPtr(Rhs+1, MATRIX_OF_STRING_DATATYPE, &userValueSize, &nbCol, userValue);
/* TO DO : delete of userValue */
}
LhsVar(1) = Rhs+1;
PutLhsVar();
return TRUE;
}
/*--------------------------------------------------------------------------*/
int sci_fftw_flags(char *fname, unsigned long fname_len)
{
/* declaration of variables to store scilab parameters address */
static int l1 = 0, m1 = 0, n1 = 0;
SciIntMat M1;
char **Str1 = NULL;
static int l2 = 0, m2 = 0, n2 = 0;
char **Str3 = NULL;
/* please update me ! */
static int nb_flag = 22;
static char *Str[] =
{
/* documented flags */
"FFTW_MEASURE",
"FFTW_DESTROY_INPUT",
"FFTW_UNALIGNED",
"FFTW_CONSERVE_MEMORY",
"FFTW_EXHAUSTIVE",
"FFTW_PRESERVE_INPUT",
"FFTW_PATIENT",
"FFTW_ESTIMATE",
/* undocumented beyond-guru flags */
"FFTW_ESTIMATE_PATIENT",
"FFTW_BELIEVE_PCOST",
"FFTW_NO_DFT_R2HC",
"FFTW_NO_NONTHREADED",
"FFTW_NO_BUFFERING",
"FFTW_NO_INDIRECT_OP",
"FFTW_ALLOW_LARGE_GENERIC",
"FFTW_NO_RANK_SPLITS",
"FFTW_NO_VRANK_SPLITS",
"FFTW_NO_VRECURSE",
"FFTW_NO_SIMD",
"FFTW_NO_SLOW",
"FFTW_NO_FIXED_RADIX_LARGE_N",
"FFTW_ALLOW_PRUNING"
};
static unsigned flagt[] =
{
/* documented flags */
FFTW_MEASURE,
FFTW_DESTROY_INPUT,
FFTW_UNALIGNED,
FFTW_CONSERVE_MEMORY,
FFTW_EXHAUSTIVE,
FFTW_PRESERVE_INPUT,
FFTW_PATIENT,
FFTW_ESTIMATE,
/* undocumented beyond-guru flags */
FFTW_ESTIMATE_PATIENT,
FFTW_BELIEVE_PCOST,
FFTW_NO_DFT_R2HC,
FFTW_NO_NONTHREADED,
FFTW_NO_BUFFERING,
FFTW_NO_INDIRECT_OP,
FFTW_ALLOW_LARGE_GENERIC,
FFTW_NO_RANK_SPLITS,
FFTW_NO_VRANK_SPLITS,
FFTW_NO_VRECURSE,
FFTW_NO_SIMD,
FFTW_NO_SLOW,
FFTW_NO_FIXED_RADIX_LARGE_N,
FFTW_ALLOW_PRUNING
};
unsigned flagv = 0;
int i = 0, j = 0;
CheckRhs(0, 1);
if (Rhs == 0)
{
// nothing
}
else
{
switch(VarType(1))
{
case sci_ints:
/* int */
GetRhsVar(1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &M1);
CheckDims(1, m1, n1, 1, 1);
setCurrentFftwFlags(((int *)M1.D)[0]);
break;
case sci_matrix:
/* double */
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
CheckDims(1, m1, n1, 1, 1);
setCurrentFftwFlags((int)*stk(l1));
break;
case sci_strings:
/* string */
GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Str1);
for (j = 0; j < m1 * n1; j++)
{
for (i = 0; i < nb_flag; i++)
{
if (strcmp(Str1[j], Str[i]) == 0) break;
}
if (i == nb_flag)
{
freeArrayOfString(Str1, m1 * n1);
Scierror(999, _("%s: Wrong values for input argument #%d: FFTW flag expected.\n"), fname, 1);
return 0;
}
else
{
if (i > 0)
{
flagv = ( flagv | (1U << (i - 1)) );
}
}
}
setCurrentFftwFlags(flagv);
freeArrayOfString(Str1, m1 * n1);
break;
default:
Scierror(53, _("%s: Wrong type for input argument #%d.\n"), fname, 1);
return 0;
}
}
/* return value of Sci_Plan.flags in position 2 */
m2 = 1;
n2 = m2;
l2 = I_INT32;
CreateVar(Rhs + 2, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m2, &n2, &l2);
*istk(l2) = (int) getCurrentFftwFlags();
/*Test for only FFTW_MEASURE*/
if (getCurrentFftwFlags() == 0)
{
j = 1;
if ((Str3 = (char **)MALLOC(sizeof(char *))) == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
Str3[0] = strdup(Str[0]);
if (Str3[0] == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
}
else
{
j = 0;
for (i = 1;i < nb_flag; i++)
{
if((getCurrentFftwFlags() & flagt[i]) == flagt[i])
{
j++;
if (Str3)
{
Str3 = (char **)REALLOC(Str3,sizeof(char *) * j);
}
else
{
Str3 = (char **)MALLOC(sizeof(char *) * j);
}
if ( Str3 == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
Str3[j - 1] = strdup(Str[i]);
if (Str3[j - 1] == NULL)
{
freeArrayOfString(Str3, j);
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
}
}
}
n1 = 1;
CreateVarFromPtr(Rhs + 3, MATRIX_OF_STRING_DATATYPE, &j, &n1, Str3);
freeArrayOfString(Str3, j);
LhsVar(1) = Rhs + 2;
LhsVar(2) = Rhs + 3;
PutLhsVar();
return 0;
}
extern int intmshurgmres(char *fname)
{
int mA,nA,*ia;
int mb,nb,msol,nsol,nniter,mniter,meps,neps,mkry,nkry,nlfil,mlfil,nLU,mLU;
int b,sol,niter,eps,kry,lfil,pierr,LU;
int mdt=1,ndt=1,pdt;
int mierr=1,nierr=1,iout=6,param;
int iwk, *jw, *jlu, *ju , *p, *invq, ind;
double *w,*alu, condest=1.0;
SciSparse A;
param=1 + 0*2 + 1*4+ 0*8+ 1*16+ 0*32 + 0*64 + 0*128 +0*256 + 0*512;
CheckRhs(1,9);
CheckLhs(1,2);
/* matrice */
if (VarType(1)==5){
GetRhsVar(1,"s",&mA,&nA,&A);
if (mA!=nA){
Scierror(501,"%s: input matrix must be square \r\n",fname);
}
} else {
Scierror(501,"%s: input matrix must be sparse \r\n",fname);
return 0;
}
/* rhs */
if (VarType(2)==1){
GetRhsVar(2,"d",&mb,&nb,&b);
if ((mb!=nA)||(nb!=1)){
Scierror(501,"%s: incompatible rhs \r\n",fname);
}
} else {
Scierror(501,"%s: rhs must be a vector \r\n",fname);
return 0;
}
/* x0 */
if (VarType(3)==1){
GetRhsVar(3,"d",&msol,&nsol,&sol);
if ((msol!=nA)||(nsol!=1)){
Scierror(501,"%s: incompatible init \r\n",fname);
}
} else {
Scierror(501,"%s: init must be a vector \r\n",fname);
return 0;
}
/* nb iter max */
if (VarType(4)==1){
GetRhsVar(4,"i",&nniter,&mniter,&niter);
if (mniter*nniter!= 1){
Scierror(501,"%s: niter must be a single integer \r\n",fname);
}
} else {
Scierror(501,"%s: niter must be integer \r\n",fname);
return 0;
}
/* reduc res */
if (VarType(5)==1){
GetRhsVar(5,"d",&meps,&neps,&eps);
if (meps*neps!= 1){
Scierror(501,"%s: eps must be a real \r\n",fname);
}
} else {
Scierror(501,"%s: init must be a real \r\n",fname);
return 0;
}
/* taille de l'espace de krylov */
if (VarType(6)==1){
GetRhsVar(6,"i",&mkry,&nkry,&kry);
if (mkry*nkry!= 1){
Scierror(501,"%s: krylov must be a single integer \r\n",fname);
}
} else {
Scierror(501,"%s: krylov must be a integer \r\n",fname);
return 0;
}
if (VarType(7)==1){
GetRhsVar(7,"i",&mlfil,&nlfil,&lfil);
} else {
Scierror(501,"%s: lfil must be integer \r\n",fname);
return 0;
}
if (VarType(8)==1){
GetRhsVar(8,"d",&mdt,&ndt,&pdt);
} else {
Scierror(501,"%s: drop must be a double \r\n",fname);
return 0;
}
if (VarType(9)==1){
GetRhsVar(9,"i",&mLU,&nLU,&LU);
}
CreateVar(10,"i",&mierr,&nierr,&pierr);
iwk=(LU)*(2*(*istk(lfil))+1)+1+ (A.m-LU)*(2*(*istk(lfil))+1)+1;
jw=(int *) malloc(21*A.m*sizeof(int));
w= (double *) malloc(7*A.m*sizeof(double));
p=(int *) malloc(A.m*sizeof(int));
invq=(int *) malloc(A.m*sizeof(int));
for(ind=0;ind<A.m;ind++){
p[ind]=ind+1;
invq[ind]=ind+1;
}
printf("iwk %i :\n",iwk);
alu= (double *) malloc(iwk*sizeof(double));
jlu= (int *) malloc(iwk*sizeof(int));
ju= (int *) malloc((A.m)*sizeof(int));
ia=Sci2spk(&A);
/*
C2F(piluc)(&A.m,A.R,A.icol,ia,istk(lfil),stk(pdt),&condest,istk(LU),¶m,p,invq,alu,jlu,ju,&iwk,w,jw,istk(pierr));
*/
C2F(iluc)(&A.m,A.R,A.icol,ia,istk(lfil),stk(pdt),¶m,alu,jlu,ju,&iwk,w,jw,istk(pierr));
printf("----- fin piluc ------\n");
free(w);
free(jw);
free(p);
free(invq);
if (*istk(pierr)!=0){
free(ju);
free(jlu);
free(alu);
if (*istk(pierr)==-1) {
Scierror(501,"%s: input matrix may be wrong \r\n",fname);
} else if (*istk(pierr)==-2) {
Scierror(501,"%s: not enough memory for matrix L \r\n",fname);
} else if (*istk(pierr)==-3) {
Scierror(501,"%s: not enough memory for matrix U \r\n",fname);
} else if (*istk(pierr)==-4) {
Scierror(501,"%s: illegal value for lfil \r\n",fname);
} else {
Scierror(501,"%s: zero pivot encountered at step number %d \r\n",fname,*istk(pierr));
}
} else {
iwk=(A.m)*(*istk(kry)+1);
w= (double *) malloc(iwk*sizeof(double));
C2F(mpgmres)(&A.m,istk(LU), istk(kry), stk(b), stk(sol), w, stk(eps), istk(niter),&iout,A.R ,A.icol , ia, alu, jlu, ju, istk(pierr));
free(w);
free(ju);
free(jlu);
free(alu);
}
/*
//CreateVar(10,"d",&mb,&nb,&sol);
*/
LhsVar(1)=3;
LhsVar(2)=10;
return(0);
}
int sci_gen_if(char *fname)
{
static int l1, m1, n1;
void *p_sci;
static int l2, m2, n2;
static int lr3, lc3;
static int minrhs=2, maxrhs=2;
static int minlhs=1, maxlhs=1;
static int err=0;
struct sci_var s_ce;
struct sci_var s_y;
debug_3 ("[sci_gen_if] ..................... \r\n");
CheckRhs(minrhs,maxrhs);
CheckLhs(minlhs,maxlhs);
// Example:pfir1
m1=1;
n1=1;
GetRhsVar(1,"p",&m1,&n1,&l1);
// Example:ce - boolean
GetRhsVar(2, "b", &m2, &n2, &l2);
s_ce.is_complex=0;
s_ce.is_double=0;
s_ce.is_boolean=1;
s_ce.p_var=NULL;
s_ce.p_re=istk(l2);
s_ce.p_im=NULL;
s_ce.m=m2;
s_ce.n=n2;
p_sci = (void *) ((unsigned long int) *stk(l1));
s_y = sci_gen_ifcpp(p_sci, &s_ce);
if (sci_err) {
sciprint("\n%s:\n info:%d\n",sci_err_msg,sci_info);
Scierror(999,"%s failed err=%d", fname, sci_err);
return 0;
}
// now when m3,n3 are set - create [mxn] sci variable on stack (it=is_complex)
if (s_y.is_double)
{ CreateCVar(3,"d", &s_y.is_complex, &s_y.m, &s_y.n, &lr3, &lc3);
// alocated mem on scilab stack for [mxn] of (complex) double
s_y.p_re=stk(lr3);
s_y.p_im=stk(lc3);
}
else if (s_y.is_boolean)
{ CreateVar(3,"b", &s_y.m, &s_y.n, &lr3);
// alocated mem on scilab stack for [mxn] boolean
s_y.p_re=istk(lr3);
s_y.p_im=NULL;
}
else
{ lr3 = I_INT32;
CreateVar(3,"I", &s_y.m, &s_y.n, &lr3);
// alocated mem on scilab stack for [mxn] I_INT32;
s_y.p_re=istk(lr3);
s_y.p_im=NULL;
}
// copy values
sci_pop_var(&s_y);
// remove data from heap
sci_delete_var(&s_y);
LhsVar(1) = 3; /* return var */
debug_3 ("[sci_gen_if] +++++++++++++++++++++ \r\n");
return 0;
}
int sci_proc_if(char *fname)
{
static int l1, m1, n1;
void *p_sci;
static int l2, m2, n2;
static int lr3, lc3, it3, m3, n3;
static int lr4, lc4;
static int minrhs=3, maxrhs=3;
static int minlhs=1, maxlhs=1;
static int err=0;
struct sci_var s_ce;
struct sci_var s_x;
struct sci_var s_y;
SciIntMat M1;
sci_types sci_var_type;
debug_3 ("[sci_proc_if] ..................... \r\n");
CheckRhs(minrhs,maxrhs);
CheckLhs(minlhs,maxlhs);
// Example:pfir1
m1=1;
n1=1;
GetRhsVar(1,"p",&m1,&n1,&l1);
// Example:ce - boolean
GetRhsVar(2, "b", &m2, &n2, &l2);
s_ce.is_complex=0;
s_ce.is_double=0;
s_ce.is_boolean=1;
s_ce.p_re=istk(l2);
s_ce.p_im=NULL;
s_ce.m=m2;
s_ce.n=n2;
s_ce.p_var=NULL;
// Example:x
sci_var_type=GetType(3);
switch(sci_var_type)
{
case sci_matrix: // "1 - A matrix of doubles\n"
GetRhsCVar(3, "d", &it3, &m3, &n3, &lr3, &lc3);
s_x.is_complex=it3;
s_x.is_double=1;
s_x.is_boolean=0;
s_x.p_re=stk(lr3);
s_x.p_im=stk(lc3);
s_x.m=m3;
s_x.n=n3;
s_x.p_var=NULL;
break;
case sci_boolean: // "4 - A matrix of booleans\n";
GetRhsVar(3, "b", &m3, &n3, &lr3);
s_x.is_complex=0;
s_x.is_double=0;
s_x.is_boolean=1;
s_x.p_re=istk(lr3);
s_x.p_im=NULL;
s_x.m=m3;
s_x.n=n3;
s_x.p_var=NULL;
break;
case sci_ints: // "8 - A matrix of integers\n - 32bit nothing else";
// This is coded as in an example: modnum_422\ intmodnum_lib.c\ int intspread_c(char *fname)
GetRhsVar(3, "I", &m3, &n3, &M1);
// check the type of int (M1.it==I_INT32 | M1.it==I_UINT32)
s_x.is_complex = 0;
s_x.is_double = 0;
s_x.is_boolean = 0;
s_x.p_re = M1.D;
s_x.p_im = NULL;
s_x.m = m3;
s_x.n = n3;
s_x.p_var = NULL;
break;
default:
Scierror(999,"Unsupported argument type %s failed err=", fname, -1);
break;
}
p_sci = (void *) ((unsigned long int) *stk(l1));
s_y = sci_proc_ifcpp(p_sci, &s_ce, &s_x );
if (sci_err) {
sciprint("\n%s:\n info:%d\n",sci_err_msg,sci_info);
Scierror(999,"%s failed err=%d", fname, sci_err);
return 0;
}
// now when m3,n3 are set - create [mxn] sci variable on stack (it=is_complex)
if (s_y.is_double)
{ CreateCVar(4,"d", &s_y.is_complex, &s_y.m, &s_y.n, &lr4, &lc4);
// alocated mem on scilab stack for [mxn] of (complex) double
s_y.p_re = stk(lr4);
s_y.p_im = stk(lc4);
}
else if (s_y.is_boolean)
{ CreateVar(4,"b", &s_y.m, &s_y.n, &lr4);
// alocated mem on scilab stack for [mxn] boolean
s_y.p_re = istk(lr4);
s_y.p_im = NULL;
}
else
{ lr4 = I_INT32;
CreateVar(4,"I", &s_y.m, &s_y.n, &lr4);
// alocated mem on scilab stack for [mxn] I_INT32;
s_y.p_re = istk(lr4);
s_y.p_im = NULL;
}
// copy values
sci_pop_var(&s_y);
// remove data from heap
sci_delete_var(&s_y);
LhsVar(1) = 4; /* return var */
debug_3 ("[sci_proc_if] +++++++++++++++++++++ \r\n");
return 0;
}
/*------------------------------------------------------------------------*/
int sci_plot2d( char * fname, unsigned long fname_len )
{
int m1 = 0, n1 = 0, l1 = 0, m2 = 0, n2 = 0, l2 = 0, lt = 0;
int test = 0, i = 0, j = 0, iskip = 0;
int frame_def = 8;
int *frame = &frame_def;
int axes_def = 1;
int *axes = &axes_def;
/* F.Leray 18.05.04 : log. case test*/
int size_x = 0, size_y = 0;
double xd[2];
char dataflag = 0;
char * logFlags = NULL ;
int * style = NULL ;
double * rect = NULL ;
char * strf = NULL ;
char * legend = NULL ;
int * nax = NULL ;
BOOL flagNax = FALSE ;
char strfl[4];
static rhs_opts opts[] = { { -1, "axesflag", "?", 0, 0, 0},
{ -1, "frameflag", "?", 0, 0, 0},
{ -1, "leg", "?", 0, 0, 0},
{ -1, "logflag", "?", 0, 0, 0},
{ -1, "nax", "?", 0, 0, 0},
{ -1, "rect", "?", 0, 0, 0},
{ -1, "strf", "?", 0, 0, 0},
{ -1, "style", "?", 0, 0, 0},
{ -1, NULL, NULL, 0, 0, 0}
};
if (Rhs == 0)
{
sci_demo(fname, fname_len);
return 0;
}
CheckRhs(1, 9);
iskip = 0;
if ( get_optionals(fname, opts) == 0)
{
PutLhsVar();
return 0 ;
}
if (GetType(1) == sci_strings)
{
/* logflags */
GetLogflags( fname, 1, opts, &logFlags ) ;
iskip = 1;
}
if (FirstOpt() == 2 + iskip) /** plot2d([loglags,] y, <opt_args>); **/
{
GetRhsVar(1 + iskip, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &l2);
if (m2 == 1 && n2 > 1)
{
m2 = n2;
n2 = 1;
}
m1 = m2;
n1 = n2;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
for (i = 0; i < m2 ; ++i)
{
for (j = 0 ; j < n2 ; ++j)
{
*stk( l1 + i + m2 * j) = (double) i + 1;
}
}
}
else if (FirstOpt() >= 3 + iskip) /** plot2d([loglags,] x, y[, style [,...]]); **/
{
/* x */
GetRhsVar(1 + iskip, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
/* y */
GetRhsVar(2 + iskip, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &l2);
test = (m1 * n1 == 0) ||
((m1 == 1 || n1 == 1) && (m2 == 1 || n2 == 1) && (m1 * n1 == m2 * n2)) ||
((m1 == m2) && (n1 == n2)) ||
((m1 == 1 && n1 == m2) || (n1 == 1 && m1 == m2));
CheckDimProp(1 + iskip, 2 + iskip, !test);
if (m1 * n1 == 0)
{
/* default x=1:n */
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, <);
if (m2 == 1 && n2 > 1)
{
m2 = n2;
n2 = 1;
}
for (i = 0; i < m2 ; ++i)
{
for (j = 0 ; j < n2 ; ++j)
{
*stk( lt + i + m2 * j) = (double) i + 1;
}
}
m1 = m2;
n1 = n2;
l1 = lt;
}
else if ((m1 == 1 || n1 == 1) && (m2 != 1 && n2 != 1) )
{
/* a single x vector for mutiple columns for y */
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, <);
for (i = 0; i < m2 ; ++i)
{
for (j = 0 ; j < n2 ; ++j)
{
*stk( lt + i + m2 * j) = *stk(l1 + i);
}
}
m1 = m2;
n1 = n2;
l1 = lt;
}
else if ((m1 == 1 && n1 == 1) && (n2 != 1) )
{
/* a single y row vector for a single x */
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n2, <);
for (j = 0 ; j < n2 ; ++j)
{
*stk( lt + j ) = *stk(l1);
}
n1 = n2;
l1 = lt;
}
else
{
if (m2 == 1 && n2 > 1)
{
m2 = n2;
n2 = 1;
}
if (m1 == 1 && n1 > 1)
{
m1 = n1;
n1 = 1;
}
}
}
else
{
Scierror(999, _("%s: Wrong number of mandatory input arguments. At least %d expected.\n"), fname, 1);
return 0;
}
if (n1 == -1 || n2 == -1 || m1 == -1 || m2 == -1)
{
Scierror(999, _("%s: Wrong size for input arguments #%d and #%d.\n"), fname, 1, 2); /* @TODO : detail error */
return 0;
}
sciGetStyle( fname, 3 + iskip, n1, opts, &style ) ;
GetStrf( fname, 4 + iskip, opts, &strf ) ;
GetLegend( fname, 5 + iskip, opts, &legend );
GetRect( fname, 6 + iskip, opts, &rect );
GetNax( 7 + iskip, opts, &nax, &flagNax ) ;
if (iskip == 0)
{
GetLogflags( fname, 8, opts, &logFlags ) ;
}
if ( isDefStrf( strf ) )
{
strcpy(strfl, DEFSTRFN);
strf = strfl;
if ( !isDefRect( rect ) )
{
strfl[1] = '7';
}
if ( !isDefLegend( legend ) )
{
strfl[0] = '1';
}
GetOptionalIntArg(fname, 9, "frameflag", &frame, 1, opts);
if ( frame != &frame_def )
{
strfl[1] = (char)(*frame + 48);
}
GetOptionalIntArg(fname, 9, "axesflag", &axes, 1, opts);
if (axes != &axes_def)
{
strfl[2] = (char)(*axes + 48);
}
}
/* Make a test on log. mode : available or not depending on the bounds set by Rect arg. or xmin/xmax :
Rect case :
- if the min bound is strictly posivite, we can use log. mode
- if not, send error message
x/y min/max case:
- we find the first strictly positive min bound in Plo2dn.c ?? */
switch (strf[1])
{
case '0':
/* no computation, the plot use the previous (or default) scale */
break;
case '1' :
case '3' :
case '5' :
case '7':
/* based on Rect arg */
if ( rect[0] > rect[2] || rect[1] > rect[3])
{
Scierror(999, _("%s: Impossible status min > max in x or y rect data.\n"), fname);
return -1;
}
if ( rect[0] <= 0. && logFlags[1] == 'l') /* xmin */
{
Scierror(999, _("%s: Bounds on x axis must be strictly positive to use logarithmic mode.\n"), fname);
return -1 ;
}
if ( rect[1] <= 0. && logFlags[2] == 'l') /* ymin */
{
Scierror(999, _("%s: Bounds on y axis must be strictly positive to use logarithmic mode.\n"), fname);
return -1 ;
}
break;
case '2' :
case '4' :
case '6' :
case '8':
case '9':
/* computed from the x/y min/max */
if ( (int)strlen(logFlags) < 1)
{
dataflag = 'g' ;
}
else
{
dataflag = logFlags[0];
}
switch ( dataflag )
{
case 'e' :
xd[0] = 1.0;
xd[1] = (double)m1;
size_x = (m1 != 0) ? 2 : 0 ;
break;
case 'o' :
size_x = m1;
break;
case 'g' :
default :
size_x = (n1 * m1) ;
break;
}
if (size_x != 0)
{
if (logFlags[1] == 'l' && sciFindStPosMin(stk(l1), size_x) <= 0.0 )
{
Scierror(999, _("%s: At least one x data must be strictly positive to compute the bounds and use logarithmic mode.\n"), fname);
return -1 ;
}
}
size_y = (n1 * m1) ;
if (size_y != 0)
{
if ( logFlags[2] == 'l' && sciFindStPosMin(stk(l2), size_y) <= 0.0 )
{
Scierror(999, _("%s: At least one y data must be strictly positive to compute the bounds and use logarithmic mode\n"), fname);
return -1 ;
}
}
break;
}
// open a figure if none already exists
getOrCreateDefaultSubwin();
Objplot2d (1, logFlags, stk(l1), stk(l2), &n1, &m1, style, strf, legend, rect, nax, flagNax);
LhsVar(1) = 0;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int intsplin3d(char * fname,unsigned long fname_len)
{
/*
* [tlist] = splin3d(x, y, z, v [,orderxyz])
*/
static char *Str[] = {"tensbs3d", "tx", "ty", "tz", "order", "bcoef", "xyzminmax"};
int minrhs = 4, maxrhs = 5, minlhs = 1, maxlhs = 1;
int mx = 0, nx = 0, lx = 0, my = 0, ny = 0, ly = 0, mz = 0, nz = 0, lz = 0, mo = 0;
int no = 0, lo = 0, kx = 0, ky = 0, kz = 0;
int ntx = 0, nty = 0, ntz = 0, ltx = 0, lty = 0, ltz = 0, lbcoef = 0, lxyzminmax = 0;
int mwk = 0, mwkx = 0, mwky = 0, mwkz = 0;
int flag = 0, one = 1, three = 3, six = 6, seven = 7, ltlist = 0, nxyz = 0, lwork = 0;
int lar = 0, lorder = 0, *order = NULL;
double *x = NULL, *y = NULL, *z = NULL, *xyzminmax = NULL;
int i = 0;
RealHyperMat V;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
CheckVector(1, mx, nx);
x = stk(lx);
GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE, &my, &ny, &ly);
CheckVector(2, my, ny);
y = stk(ly);
GetRhsVar(3,MATRIX_OF_DOUBLE_DATATYPE, &mz, &nz, &lz);
CheckVector(2, mz, nz);
z = stk(lz);
for (i = 1; i <= minrhs - 1; i++)
{
SciErr sciErr;
int *piAddressVar = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVar))
{
Scierror(202, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), fname, i);
return 0;
}
}
nx = mx * nx;
ny = my * ny;
nz = mz * nz;
if (nx < 3 || ny < 3 || nz < 3)
{
Scierror(999,_("%s: Wrong size for input arguments: x, y and z grids must have at least %d points.\n"), fname, 3);
return 0;
}
GetRhsRealHMat(4, &V);
if ( V.dimsize != 3 )
{
Scierror(999,_("%s: Wrong size for input argument #%d: A real 3-dimension hypermatrix expected.\n"),fname,4);
return 0;
}
if ( V.dims[0] != nx || V.dims[1] != ny || V.dims[2] != nz )
{
Scierror(999,"%s: Wrong value for input argument: Size incompatibility between grid points and grid values.\n", fname);
return 0;
}
if ( Rhs == 5 )
{
GetRhsVar(5,MATRIX_OF_DOUBLE_DATATYPE, &mo, &no, &lo);
if ( (mo != 1 && no != 1) || mo*no != 3 )
{
Scierror(999,_("%s: Wrong value for input argument #%d: Vector with %d components expected.\n"),fname,4,3);
return 0;
}
kx = (int)*stk(lo);
ky = (int)*stk(lo+1);
kz = (int)*stk(lo+2);
if ( kx < 2 || kx >= nx || ky < 2 || ky >= ny || kz < 2 || kz >= nz )
{
Scierror(999,_("%s: Wrong values for input argument #%d.\n"), fname, 5);
return 0;
}
}
else
{
kx = 4;
ky = 4;
kz = 4;
}
ntx = nx + kx;
nty = ny + ky;
ntz = nz + kz;
mwkx = kx*(nx+1); mwky = ky*(ny+1); mwkz = kz*(nz+1);
mwkx = Max(mwkx, mwky);
mwk = nx*ny*nz + 2*(Max(mwkx, mwkz));
nxyz = nx*ny*nz;
CreateVar(Rhs+1,TYPED_LIST_DATATYPE, &seven, &one, <list);
CreateListVarFromPtr(Rhs+1, 1,MATRIX_OF_STRING_DATATYPE, &one, &seven, Str);
lar = -1; CreateListVarFrom(Rhs+1, 2,MATRIX_OF_DOUBLE_DATATYPE, &ntx, &one, <x, &lar);
lar = -1; CreateListVarFrom(Rhs+1, 3,MATRIX_OF_DOUBLE_DATATYPE, &nty, &one, <y, &lar);
lar = -1; CreateListVarFrom(Rhs+1, 4,MATRIX_OF_DOUBLE_DATATYPE, &ntz, &one, <z, &lar);
lorder = 4;
lar = -1; CreateListVarFrom(Rhs+1, 5,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &three, &one, &lorder, &lar);
order = istk(lorder); order[0] = kx; order[1] = ky; order[2] = kz;
lar = -1; CreateListVarFrom(Rhs+1, 6,MATRIX_OF_DOUBLE_DATATYPE, &nxyz, &one, &lbcoef, &lar);
lar = -1; CreateListVarFrom(Rhs+1, 7,MATRIX_OF_DOUBLE_DATATYPE, &six, &one, &lxyzminmax, &lar);
xyzminmax = stk(lxyzminmax);
xyzminmax[0] = x[0];
xyzminmax[1] = x[nx - 1];
xyzminmax[2] = y[0];
xyzminmax[3] = y[ny - 1];
xyzminmax[4] = z[0];
xyzminmax[5] = z[nz - 1];
CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &mwk, &one, &lwork);
flag = 0;
C2F(db3ink) ( stk(lx), &nx, stk(ly), &ny, stk(lz), &nz, V.R,
&nx, &ny, &kx, &ky, &kz, stk(ltx), stk(lty), stk(ltz),
stk(lbcoef), stk(lwork), &flag);
if ( flag != 1 )
{
Scierror(999, _("%s: Problem with 'flag' = %d\n"), fname, flag);
return 0;
}
/* Return only the tlist */
LhsVar(1) = Rhs+1;
PutLhsVar();
return 0;
}
/*------------------------------------------------------------------------*/
int sci_regexp(char *fname,unsigned long fname_len)
{
char typ = CHAR_S;
char **Str = NULL;
char **Str2 = NULL;
int i = 0; /* loop indice */
int mn = 0; /* dimension parameter 1 m*n */
int mn2 = 0; /* m2*n2 */
int outIndex = 0;
int numRow = 1;
int *values_start = NULL;
int *values_end = NULL;
int *wcvalues_start = NULL;
int *wcvalues_end = NULL;
int nbValues_start = 0;
int nbValues_end=0;
int nbposition = 0;
CheckRhs(2,3);
CheckLhs(1,3);
if (VarType(1) == sci_strings)
{
int m1 = 0;
int n1 = 0;
GetRhsVar(1,MATRIX_OF_STRING_DATATYPE,&m1,&n1,&Str);
mn = m1*n1;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: Single string expected.\n"), fname,1);
return 0;
}
if (mn != 1)
{
freeArrayOfString(Str,mn);
Scierror(36, _("%s: Wrong size for input argument #%d: Single string expected.\n"), fname,1);
return 0;
}
if (VarType(2) == sci_strings)
{
int m2 = 0,n2 = 0;
GetRhsVar(2,MATRIX_OF_STRING_DATATYPE,&m2,&n2,&Str2);
mn2 = m2*n2;
}
else
{
freeArrayOfString(Str,mn);
Scierror(36, _("%s: Wrong type for input argument #%d: Single string expected.\n"), fname,2);
return 0;
}
if (mn2 != 1)
{
freeArrayOfString(Str2,mn2);
Scierror(36, _("%s: Wrong size for input argument #%d: Single string expected.\n"), fname,2);
return 0;
}
if ( (int)strlen(Str[0]) == 0 )
{
values_start = (int *)MALLOC(sizeof(int));
values_end = (int *)MALLOC(sizeof(int));
wcvalues_start = (int *)MALLOC(sizeof(int));
wcvalues_end = (int *)MALLOC(sizeof(int));
}
else
{
values_start = (int *)MALLOC( sizeof(int) * ( strlen(Str[0]) ) );
values_end = (int *)MALLOC( sizeof(int) * ( strlen(Str[0]) ) );
wcvalues_start = (int *)MALLOC( sizeof(int) * ( strlen(Str[0]) ) );
wcvalues_end = (int *)MALLOC( sizeof(int) * ( strlen(Str[0]) ) );
}
if (Rhs == 2 )
{
typ = CHAR_S;
}
else /* Rhs == 3 */
{
int m3 = 0, n3 = 0, l3 = 0;
GetRhsVar(3,STRING_DATATYPE,&m3,&n3,&l3);
if ( m3*n3 != 0) typ = cstk(l3)[0];
if (typ != STR_ONCE)
{
freeArrayOfString(Str,mn);
freeArrayOfString(Str2,mn2);
Scierror(999,_("%s: Wrong type for input argument #%d: '%s' expected.\n"),fname,3,"o");
return 0;
}
}
{
int x = 0;
pcre_error_code answer = PCRE_FINISHED_OK;
int start_point = 0;
int Output_Start = 0;
int Output_End = 0;
int wcOutput_Start = 0;
int wcstart_point = 0;
int wcOutput_End = 0;
for (x = 0; x < mn2; ++x)
{
char *save = strdup(Str2[x]);
if (save)
{
char *pointer = Str[0];
start_point = 0;
wcstart_point = 0;
do
{
strcpy(save,Str2[x]);
Output_Start = 0;
Output_End = 0;
answer = pcre_private(pointer,save,&Output_Start,&Output_End);
if ( answer == PCRE_FINISHED_OK )
{
/* Start = End means that we matched a position and 0 characters.
* Matching 0 characters, for us, means no match.
*/
if (Output_Start != Output_End)
{
char * strOutput_Start = strdup(pointer);
char * strOutput_End = strdup(pointer);
wchar_t *wcstrOutput_Start = NULL;
wchar_t *wcstrOutput_End = NULL;
/* calculates positions with wide characters */
strOutput_Start[Output_Start] = '\0';
strOutput_End[Output_End] = '\0';
wcstrOutput_Start = to_wide_string(strOutput_Start);
wcstrOutput_End = to_wide_string(strOutput_End);
if (wcstrOutput_Start)
{
wcOutput_Start = (int)wcslen(wcstrOutput_Start);
FREE(wcstrOutput_Start);wcstrOutput_Start = NULL;
}
else
{
wcOutput_Start = 0;
}
if (wcstrOutput_End)
{
wcOutput_End = (int)wcslen(wcstrOutput_End);
FREE(wcstrOutput_End);wcstrOutput_End = NULL;
}
else
{
wcOutput_End = 0;
}
if (strOutput_Start) {FREE(strOutput_Start); strOutput_Start = NULL;}
if (strOutput_End) {FREE(strOutput_End); strOutput_End = NULL;}
/*adding the answer into the outputmatrix*/
values_start[nbValues_start] = Output_Start + start_point + 1;
values_end[nbValues_end] = Output_End + start_point;
wcvalues_start[nbValues_start] = wcOutput_Start + wcstart_point + 1;
wcvalues_end[nbValues_end] = wcOutput_End + wcstart_point;
nbValues_start++;
nbValues_end++;
/*The number according to the str2 matrix*/
nbposition++;
}
else if(Output_End == 0 && *pointer != '\0')
{
/* Avoid an infinite loop */
pointer++;
}
pointer = &pointer[Output_End];
start_point = start_point + Output_End ;
wcstart_point = wcstart_point + wcOutput_End ;
}
else
{
if (answer != NO_MATCH)
{
pcre_error(fname,answer);
freeArrayOfString(Str,mn);
freeArrayOfString(Str2,mn2);
return 0;
}
}
}
while( (answer == PCRE_FINISHED_OK) && (*pointer != '\0') && (typ != STR_ONCE) );
if (save) {FREE(save);save=NULL;}
}
else
{
freeArrayOfString(Str,mn);
freeArrayOfString(Str2,mn2);
Scierror(999, _("%s: No more memory.\n"),fname);
return 0;
}
}
}
numRow = 1; /* Output values[] */
outIndex = 0;
CreateVar(Rhs+1,MATRIX_OF_DOUBLE_DATATYPE,&numRow,&nbValues_start,&outIndex);
for ( i = 0 ; i < nbValues_start ; i++ )
{
stk(outIndex)[i] = (double)wcvalues_start[i] ;
}
LhsVar(1) = Rhs+1 ;
if (Lhs >= 2)
{
numRow = 1;
outIndex = 0;
CreateVar(Rhs+2,MATRIX_OF_DOUBLE_DATATYPE,&numRow,&nbValues_end,&outIndex);
for ( i = 0 ; i < nbposition ; i++ )
{
stk(outIndex)[i] = (double)wcvalues_end[i] ;
}
LhsVar(2) = Rhs+2;
}
if (Lhs == 3)
{
if (nbValues_start != 0)
{
char **match = (char**)MALLOC(sizeof(char*)*(nbValues_start));
if (match == NULL)
{
freeArrayOfString(Str, mn);
freeArrayOfString(Str2, mn2);
Scierror(999, _("%s: No more memory.\n"),fname);
return 0;
}
for( i = 0; i < nbValues_start; i++)
{
int len = values_end[i] - values_start[i] + 1;
match[i] = (char*)MALLOC(sizeof(char)*(len + 1));
strncpy(match[i], Str[0] + values_start[i] - 1, len);
/* A char* always finished by \0 */
match[i][len] = '\0';
}
numRow = nbValues_start;
outIndex = 1 ;
CreateVarFromPtr(Rhs + 3,MATRIX_OF_STRING_DATATYPE, &numRow, &outIndex, match );
LhsVar(3) = Rhs + 3 ;
freeArrayOfString(match,nbValues_start);
}
else
{
int m3 = 0, n3 = 0, l3 = 0;
CreateVar(Rhs+3,STRING_DATATYPE, &m3, &n3, &l3);
LhsVar(3) = Rhs + 3 ;
}
}
freeArrayOfString(Str, mn);
freeArrayOfString(Str2, mn2);
if (values_start) {FREE(values_start); values_start = NULL;}
if (values_end) {FREE(values_end); values_end = NULL;}
if (wcvalues_start) {FREE(wcvalues_start); wcvalues_start = NULL;}
if (wcvalues_end) {FREE(wcvalues_end); wcvalues_end = NULL;}
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_qp_solve(char *fname, unsigned long fname_len)
{
static int un = 1, deux = 2;
// n : first dimension of Q
// nbis : second dimension of Q (nbis is expected to be equal to n)
static int Q = 0, n = 0, nbis = 0;
static int p = 0, unbis = 0;
static int C = 0, m = 0;
static int b = 0, mbis = 0;
static int me = 0, pipo = 0;
static int x = 0, iter = 0, iact = 0, nact = 0, crval = 0, ierr = 0;
int r = 0;
static int lw = 0, k = 0;
static SciSparse Sp;
static int issparse = 0;
double *work = NULL;
/* Check rhs and lhs */
CheckRhs(5, 5) ;
CheckLhs(1, 4) ;
/*Warning this interface does not support arguments passed by reference */
/* RhsVar: qp_solve(Q,p,C,b,me) */
/* 1,2,3,4,5 */
/* Variable 1 (Q) */
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &n, &nbis, &Q);
CheckSquare(1, n, nbis);
/* Variable 2 (p) */
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &nbis, &unbis, &p);
CheckLength(2, nbis * unbis, n);
/* Variable 3 (C) */
issparse = (GetType(3) == 5);
if (!issparse)
{
GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &nbis, &m, &C);
}
else
{
GetRhsVar(3, SPARSE_MATRIX_DATATYPE, &nbis, &m, &Sp);
}
if ( nbis != n ) // car C est passee en transposee dans la macro qpsolve
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d column(s) expected for matrix %s.\n"), fname, 3, n, "C");
return 0;
}
/* Variable 4 (b) */
GetRhsVar(4, MATRIX_OF_DOUBLE_DATATYPE, &mbis, &unbis, &b);
CheckLength(4, mbis * unbis, m);
/* Variable 5 (me) */
GetRhsVar(5, MATRIX_OF_INTEGER_DATATYPE, &pipo, &unbis, &me);
CheckScalar(5, pipo, unbis);
if ((*istk(me) < 0) || (*istk(me) > n))
{
Scierror(999, _("%s: Wrong value for input argument #%d: %s must be an integer in the range 0 to %d.\n"), fname, 5, "me", n);
return 0;
}
/* Lhs variables: x, iact, iter, crval */
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &n, &un, &x);
CreateVar(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &m, &un, &iact);
CreateVar(Rhs + 3, MATRIX_OF_INTEGER_DATATYPE, &deux, &un, &iter);
CreateVar(Rhs + 4, MATRIX_OF_DOUBLE_DATATYPE, &un, &un, &crval);
r = Min(n, m);
lw = 2 * n + r * (r + 5) / 2 + 2 * m + 1;
if ((work = (double *)MALLOC(lw * sizeof(double))) == NULL)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
}
/* change the sign of C and b.*/
ierr = 0;
if (!issparse)
{
/* linear constraints matrix is stored full */
C2F(qpgen2)(stk(Q), stk(p), &n, &n, stk(x), stk(crval), stk(C),
stk(b), &n, &m, istk(me), istk(iact), &nact, istk(iter), work,
&ierr);
}
else
{
/* linear constraints matrix is a sparse matrix */
/* Change the linear constraints matrix representation:
qpgen1sci requires column-compressed sparse matrix internal
representation while Scilab sparse matrices are row-compressed */
double *R = NULL, *I = NULL;
int *ind = NULL;
if ((R = (double *)MALLOC(Sp.nel * sizeof(double))) == NULL)
{
FREE(work);
work = NULL;
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
}
if ((ind = (int *)MALLOC((m + Sp.nel) * sizeof(int))) == NULL)
{
FREE(work);
work = NULL;
FREE(R);
R = NULL;
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
}
// Transpose the sparse matrix A
C2F(spt)(&n, &m, &(Sp.nel) , &(Sp.it), (int *)work,
Sp.R, Sp.I, Sp.mnel, Sp.icol, R, I, ind, ind + m);
C2F(qpgen1sci)(stk(Q), stk(p), &n, &n, stk(x), stk(crval),
ind, ind + m, R,
stk(b), &m, istk(me), istk(iact), &nact, istk(iter),
work, &ierr);
FREE(work);
work = NULL;
FREE(R);
R = NULL;
FREE(ind);
ind = NULL;
}
for (k = nact; k < m; k++) istk(iact)[k] = 0;
/* LhsVar: [x, iact, iter, f] = qp_solve(...) */
if (ierr == 0)
{
for (k = 0; k < Lhs; k++) LhsVar(1 + k) = Rhs + 1 + k;
PutLhsVar();
}
else if (ierr == 1)
{
Scierror(999, _("%s: The minimization problem has no solution.\n"), fname);
}
else if (ierr == 2)
{
Scierror(999, _("%s: Q is not symmetric positive definite.\n"), fname);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_mget(char *fname,unsigned long fname_len)
{
int m1 = 0, n1 = 0, l1 = 0;
int m2 = 0, n2 = 0, l2 = 0;
int m3 = 0, n3 = 0, l3 = 0;
int l4 = 0;
int err = 0;
char *type = NULL;
int fd = ALL_FILES_DESCRIPTOR;
int n = 1;
int one = 1;
Nbvars = 0;
CheckRhs(1,3);
CheckLhs(1,1);
if ( Rhs >= 1)
{
if (GetType(1) == sci_matrix)
{
GetRhsVar(1,MATRIX_OF_INTEGER_DATATYPE,&m1,&n1,&l1);
if (m1*n1 == 1)
{
n = *istk(l1);
}
else
{
Scierror(999, _("%s: Wrong size for input argument #%d: An integer expected.\n"), fname,1);
return 0;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer expected.\n"), fname,1);
return 0;
}
}
if ( Rhs >= 2)
{
if (GetType(2) == sci_strings)
{
GetRhsVar(2,STRING_DATATYPE,&m2,&n2,&l2);
type = cstk(l2);
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname,2);
return 0;
}
}
else
{
type = LIST_DATATYPE;
}
if ( Rhs >= 3)
{
if (GetType(3) == sci_matrix)
{
GetRhsVar(3,MATRIX_OF_INTEGER_DATATYPE,&m3,&n3,&l3);
if (m3*n3 == 1)
{
fd = *istk(l3);
}
else
{
Scierror(999, _("%s: Wrong size for input argument #%d: An integer expected.\n"), fname,3);
return 0;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer expected.\n"), fname,3);
return 0;
}
}
CreateVar(Rhs+1,MATRIX_OF_DOUBLE_DATATYPE,&one,&n,&l4);
LhsVar(1) = Rhs+1;
C2F(mget)(&fd,stk(l4),&n,type,&err);
if (err > 0)
{
SciError(10000);
return 0;
}
else if ( err < 0)
{
int n5 = 0, l5 = 0, i = 0;
/* n contains now the effectively read data */
n5 = -err -1;
if ( n5 < n )
{
CreateVar(Rhs+2, MATRIX_OF_DOUBLE_DATATYPE, &one, &n5, &l5);
for ( i = 0; i < n5 ; i++)
{
*stk(l5+i) = *stk(l4+i);
}
LhsVar(1) = Rhs + 2;
}
}
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_mclose(char *fname, unsigned long fname_len)
{
int m1 = 0, n1 = 0, l1 = 0;
int one = 1, l2 = 0;
int fd = ALL_FILES_DESCRIPTOR;
Nbvars = 0;
CheckRhs(0, 1);
CheckLhs(1, 1);
if (Rhs == 0)
{
fd = ALL_FILES_DESCRIPTOR;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &one, &one, &l2);
C2F(mclose)(&fd, stk(l2));
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else /* Rhs == 1 */
{
if (GetType(1) == sci_matrix)
{
GetRhsVar(1, MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &l1);
if (m1*n1 == 1)
{
fd = *istk(l1);
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &one, &one, &l2);
C2F(mclose)(&fd, stk(l2));
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
Scierror(999, _("%s: Wrong size for input argument #%d: An integer expected.\n"), fname, 1);
}
}
else if (GetType(1) == sci_strings)
{
char **input_string = NULL;
GetRhsVar(1 , MATRIX_OF_STRING_DATATYPE, &m1, &n1, &input_string);
if (m1*n1 == 1)
{
double err = 0.0;
if (strcmp(input_string[0], "all") == 0)
{
fd = ALL_FILES_DESCRIPTOR;
}
else
{
fd = GetIdFromFilename(input_string[0]);
}
if ( (fd == FILE_ID_NOT_DEFINED) && getWarningMode() )
{
sciprint(_("%s: No such file %s.\n"), fname, input_string[0]);
}
else
{
C2F(mclose)(&fd, &err);
}
freeArrayOfString(input_string, m1 * n1);
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &one, &one, &l2);
*stk(l2) = err;
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
freeArrayOfString(input_string, m1 * n1);
Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 1);
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer or string expected.\n"), fname, 1);
}
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_prompt(char *fname, unsigned long fname_len)
{
char currentPrompt[PROMPT_SIZE_MAX];
static int n1 = 0, m1 = 0, l1 = 0;
int outIndex = 0 ;
CheckRhs(0, 1);
CheckLhs(0, 2);
if (Rhs == 0) /* Get current Scilab prompt */
{
GetCurrentPrompt(currentPrompt);
m1 = (int)strlen(currentPrompt);
n1 = 1;
CreateVar( Rhs + 1, STRING_DATATYPE, &m1, &n1, &outIndex);
strcpy(cstk(outIndex), currentPrompt);
if (Lhs == 2)
{
m1 = 1;
n1 = 1;
l1 = 0;
CreateVar( Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &l1 );
*istk(l1) = (int)C2F(recu).paus ;
}
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
LhsVar(2) = Rhs + 2;
}
PutLhsVar();
}
else /* Tempory change of Scilab prompt */
{
if (Lhs <= 1)
{
if (VarType(1) != sci_strings)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 1);
return FALSE;
}
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
if (n1 != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 1);
return FALSE;
}
SetTemporaryPrompt(cstk(l1));
LhsVar(1) = 0;
PutLhsVar();
}
else
{
Scierror(999, _("%s: Wrong number of output argument(s).\n"), fname);
}
}
return 0;
}
/*--------------------------------------------------------------------------*/
int intbsplin3val(char *fname, unsigned long fname_len)
{
/*
* [fp] = bsplin3val(xp, yp, zp, tlcoef, der)
*/
int minrhs = 5, maxrhs = 5, minlhs = 1, maxlhs = 1;
int mxp = 0, nxp = 0, lxp = 0, myp = 0, nyp = 0, lyp = 0, mzp = 0, nzp = 0, lzp = 0;
int mt = 0, nt = 0, lt = 0, m1 = 0, n1 = 0, np = 0;
int one = 1, kx = 0, ky = 0, kz = 0;
int nx = 0, ny = 0, nz = 0, nxyz = 0, mtx = 0, mty = 0, mtz = 0, m = 0, n = 0, ltx;
int lty = 0, ltz = 0, lbcoef = 0, mwork = 0, lwork = 0, lfp = 0;
int i = 0, mder = 0, nder = 0, lder = 0, ox = 0, oy = 0, oz = 0;
double *fp = NULL, *xp = NULL, *yp = NULL, *zp = NULL, *der = NULL;
SciIntMat Order;
int *order = NULL;
char **Str = NULL;;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &lxp);
xp = stk(lxp);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &myp, &nyp, &lyp);
yp = stk(lyp);
GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &mzp, &nzp, &lzp);
zp = stk(lzp);
for (i = 1; i <= 3; i++)
{
SciErr sciErr;
int *piAddressVar = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVar))
{
Scierror(202, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), fname, i);
return 0;
}
}
if ( mxp != myp || nxp != nyp || mxp != mzp || nxp != nzp)
{
Scierror(999, _("%s: Wrong size for input arguments #%d, #%d and #%d: Same sizes expected.\n"), fname, 1, 2, 3);
return 0;
}
np = mxp * nxp;
GetRhsVar(4, TYPED_LIST_DATATYPE, &mt, &nt, <);
GetListRhsVar(4, 1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Str);
if ( strcmp(Str[0], "tensbs3d") != 0)
{
/* Free Str */
if (Str)
{
int li = 0;
while (Str[li] != NULL)
{
FREE(Str[li]);
li++;
};
FREE(Str);
Str = NULL;
}
Scierror(999, _("%s: Wrong type for input argument #%d: %s tlist expected.\n"), fname, 4, "tensbs3d");
return 0;
}
/* Free Str */
if (Str)
{
int li = 0;
while (Str[li] != NULL)
{
FREE(Str[li]);
li++;
};
FREE(Str);
Str = NULL;
}
GetListRhsVar(4, 2, MATRIX_OF_DOUBLE_DATATYPE, &mtx, &n, <x);
GetListRhsVar(4, 3, MATRIX_OF_DOUBLE_DATATYPE, &mty, &n, <y);
GetListRhsVar(4, 4, MATRIX_OF_DOUBLE_DATATYPE, &mtz, &n, <z);
GetListRhsVar(4, 5, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m , &n, (int *)&Order);
GetListRhsVar(4, 6, MATRIX_OF_DOUBLE_DATATYPE, &nxyz, &n, &lbcoef);
GetRhsVar(5, MATRIX_OF_DOUBLE_DATATYPE, &mder, &nder, &lder);
der = stk(lder);
if ( mder*nder != 3
|| der[0] != floor(der[0]) || der[0] < 0.0
|| der[1] != floor(der[1]) || der[1] < 0.0
|| der[2] != floor(der[2]) || der[2] < 0.0 )
{
Scierror(999, _("%s: Wrong values for input argument #%d.\n"), fname, 5);
return 0;
}
ox = (int) der[0];
oy = (int) der[1];
oz = (int) der[2];
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &lfp);
fp = stk(lfp);
order = (int *)Order.D;
kx = order[0];
ky = order[1];
kz = order[2];
nx = mtx - kx;
ny = mty - ky;
nz = mtz - kz;
mwork = ky * kz + 3 * Max(kx, Max(ky, kz)) + kz;
CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &mwork, &one, &lwork);
for (i = 0; i < np; i++)
{
fp[i] = C2F(db3val)(&(xp[i]), &(yp[i]), &(zp[i]), &ox, &oy, &oz,
stk(ltx), stk(lty), stk(lty), &nx, &ny, &nz,
&kx, &ky, &kz, stk(lbcoef), stk(lwork));
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
/*----------------------------------------------------------
* int_imfinfo:
* interface for imfinfo function.
* should provide type=imfinfo(name) at Scilab level
* $Revision: 1.3 $ $Date: 2009-04-14 14:02:45 $
*----------------------------------------------------------*/
SipExport int
int_imfinfo(char *fname)
{
/* Interface variables */
int mC, nC, lC, /* for name input arg */
mV, nV, lV, /* for "verbose" optional input arg */
mL=12, nL=1, lL, /* for list output arg */
mS=1, nS=12,
mFileName, nFileName=1,
mFileSize=1, nFileSize=1,
mFormat, nFormat=1,
mWidth=1, nWidth=1,
mHeight=1, nHeight=1,
mDepth=1, nDepth=1,
mStorageType, nStorageType=1,
mNumberOfColors=1, nNumberOfColors=1,
mResolutionUnit, nResolutionUnit=1,
mXResolution=1, nXResolution=1,
mYResolution=1, nYResolution=1,
pos,
minlhs=1, maxlhs=1, minrhs=1, maxrhs=2, i;
unsigned long int *lWidth, *lHeight, *lDepth, *lNumberOfColors,
*lFileSize, fsize;
char *lFileName, *lStorageType, *lFormat, *lResolutionUnit, *arg2;
double *lXResolution, *lYResolution;
static char
*Str[]= { "type", "FileName", "FileSize", "Format",
"Width", "Height", "Depth", "StorageType",
"NumberOfColors", "ResolutionUnit", "XResolution",
"YResolution" };
/* ImageMagick variables */
ExceptionInfo exception;
Image *image;
ImageInfo *image_info;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
/* Get name (#1) and "verbose" optional arg (#2)*/
GetRhsVar(1, "c", &mC, &nC, &lC);
if (Rhs == 2) {
GetRhsVar(2, "c", &mV, &nV, &lV);
arg2 = (char *)calloc(strlen(cstk(lV))+1, sizeof(char));
if (!arg2)
sip_error("unable to alloc memory");
strcpy(arg2,cstk(lV));
}
InitializeMagick(NULL);
GetExceptionInfo(&exception);
image_info=CloneImageInfo((ImageInfo *) NULL);
(void) strcpy(image_info->filename,cstk(lC));
image = PingImage(image_info, &exception);
if (image == (Image *) NULL) {
/* clean up */
if (Rhs==2)
free(arg2);
if(exception.reason != NULL) {
char errmsg[50];
for (i=0; i<49; i++)
errmsg[i]=' ';
errmsg[49]='\0';
strncpy(errmsg,GetLocaleExceptionMessage(exception.severity,exception.reason),50);
DestroyImageInfo(image_info);
DestroyExceptionInfo(&exception);
DestroyMagick();
sip_error(errmsg);
}
DestroyImageInfo(image_info);
DestroyExceptionInfo(&exception);
DestroyMagick();
sip_error("unknown reason");
}
pos =1;
CreateVar(1, "t", &mL, &nL, &lL);
CreateListVarFromPtr(1,pos++,"S", &mS, &nS, Str);
lFileName = image->filename;
mFileName = strlen(image->filename);
CreateListVarFromPtr(1,pos++,"c", &mFileName, &nFileName, &lFileName);
fsize = SizeBlob(image);
lFileSize = &fsize;
CreateListVarFromPtr(1,pos++,"i", &mFileSize, &nFileSize, &lFileSize);
lFormat = image->magick;
mFormat = strlen(image->magick);
CreateListVarFromPtr(1,pos++,"c", &mFormat, &nFormat, &lFormat);
lWidth = &(image->columns);
CreateListVarFromPtr(1,pos++,"i", &mWidth, &nWidth, &lWidth);
lHeight = &(image->rows);
CreateListVarFromPtr(1,pos++,"i", &mHeight, &nHeight, &lHeight);
lDepth = &(image->depth);
CreateListVarFromPtr(1,pos++,"i", &mDepth, &nDepth, &lDepth);
lStorageType = (image->storage_class == DirectClass)? "truecolor":"indexed";
mStorageType = strlen(lStorageType);
CreateListVarFromPtr(1,pos++,"c", &mStorageType, &nStorageType, &lStorageType);
lNumberOfColors = &(image->colors);
CreateListVarFromPtr(1,pos++,"i", &mNumberOfColors, \
&nNumberOfColors, &lNumberOfColors);
/*
lComments = image->comments;
mComments = strlen(image->comments);
CreateListVarFromPtr(1,pos++,"c", &mComments, &nComments, &lComments);
*/
lResolutionUnit = (image->units == PixelsPerInchResolution)?"inch":"centimeter";
mResolutionUnit = strlen(lResolutionUnit);
CreateListVarFromPtr(1,pos++,"c", &mResolutionUnit, \
&nResolutionUnit, &lResolutionUnit);
lXResolution = &(image->x_resolution);
CreateListVarFromPtr(1,pos++,"i", &mXResolution, &nXResolution, &lXResolution);
lYResolution = &(image->y_resolution);
CreateListVarFromPtr(1,pos++,"i", &mYResolution, &nYResolution, &lYResolution);
if (Rhs==2) {
if (strcmp(arg2,"verbose") != 0)
sip_error("invalid 2nd argument");
sciprint(" FileName: %s\n\r", image->filename);
sciprint(" FileSize: %d\n\r", fsize);
sciprint(" Format: %s\n\r", image->magick);
sciprint(" Width: %d\n\r", image->columns);
sciprint(" Height: %d\n\r", image->rows);
sciprint(" Depth: %d\n\r", image->depth);
sciprint(" StorageType: %s\n\r", lStorageType);
sciprint(" NumberOfColors: %d\n\r", image->colors);
sciprint(" ResolutionUnit: %s\n\r", lResolutionUnit);
sciprint(" XResolution: %f\n\r", image->x_resolution);
sciprint(" YResolution: %f\n\r", image->y_resolution);
free(arg2);
}
/* Terminate Imagemagick */
DestroyImageInfo(image_info);
DestroyImage(image);
DestroyExceptionInfo(&exception);
DestroyMagick();
/* Return variables */
LhsVar(1) = 1;
return true;
}
/*--------------------------------------------------------------------------*/
int intinterp1(char *fname, unsigned long fname_len)
{
int minrhs = 4, maxrhs = 5, minlhs = 1, maxlhs = 4;
int mt = 0, nt = 0, lt = 0, mx = 0, nx = 0, lx = 0, my = 0, ny = 0, ly = 0, md = 0, nd = 0, ld = 0, ns = 0;
int *str_outmode = NULL;
int n = 0, m = 0, outmode = 0, lst = 0, ldst = 0, lddst = 0, ldddst = 0;
int i = 0;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mt, &nt, <);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &my, &ny, &ly);
GetRhsVar(4, MATRIX_OF_DOUBLE_DATATYPE, &md, &nd, &ld);
if ( mx != my || nx != ny || md != mx || nd != nx || (mx != 1 && nx != 1) || mx*nx < 2)
{
Scierror(999,_("%s: Wrong size for input arguments #%d and #%d: Same sizes expected.\n"),fname,2,3);
return 0;
}
n = mx * nx; /* number of interpolation points */
m = mt * nt; /* number of points to interpolate */
for (i = 1; i <= minrhs; i++)
{
SciErr sciErr;
int *piAddressVar = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVar))
{
Scierror(202, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), fname, i);
return 0;
}
}
if ( Rhs == 5 ) /* get the outmode */
{
GetRhsScalarString(5, &ns, &str_outmode);
outmode = get_type(OutModeTable, NB_OUTMODE, str_outmode, ns);
if ( outmode == UNDEFINED )
{
Scierror(999,_("%s: Wrong values for input argument #%d: Unknown '%s' type.\n"),fname,5,"outmode");
return 0;
};
}
else
{
outmode = C0; /* default outmode */
}
/* memory for st, dst, ddst, dddst */
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &mt, &nt, &lst);
CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &mt, &nt, &ldst);
CreateVar(Rhs + 3, MATRIX_OF_DOUBLE_DATATYPE, &mt, &nt, &lddst);
CreateVar(Rhs + 4, MATRIX_OF_DOUBLE_DATATYPE, &mt, &nt, &ldddst);
/* subroutine EvalPWHermite(t, st, dst, ddst, dddst, m, x, y, d, n, outmode)
* int m, n, outmode
* double precision t(m), st(m), dst(m), ddst(m), dddst(m), x(n), y(n), d(n)
*/
C2F(evalpwhermite) (stk(lt), stk(lst), stk(ldst), stk(lddst), stk(ldddst),
&m, stk(lx), stk(ly), stk(ld), &n, &outmode);
LhsVar(1) = Rhs + 1;
LhsVar(2) = Rhs + 2;
LhsVar(3) = Rhs + 3;
LhsVar(4) = Rhs + 4;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int get_style_arg(char *fname,int pos, int n1,rhs_opts opts[], int ** style )
{
int m,n,l,first_opt=FirstOpt(),kopt,un=1,ix,i,l1;
Nbvars = Max(Nbvars,Rhs);
if ( pos < first_opt ) /* regular argument */
{
if (VarType(pos))
{
GetRhsVar(pos,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
if (m * n < n1)
{
Scierror(999,_("%s: Wrong size for input argument #%d: %d < %d expected.\n"),fname,pos, m*n,n1);
return 0;
}
if ( n1 == 1 && m * n == 1 )
{
ix = 2;
CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l1);
*istk(l1)=*istk(l);
*istk(l1+1)=1;
l=l1;
}
*style = istk(l);
}
else /* zero type argument --> default value */
{
ix = Max(n1,2);
CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l);
for ( i = 0 ; i < n1 ; ++i )
{
*istk(l + i) = i+1 ;
}
if (n1 == 1)
{
*istk(l + 1) = 1 ;
}
*style = istk(l);
}
}
else if ((kopt=FindOpt("style",opts)))
{ /* named argument: style=value */
GetRhsVar(kopt,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
if (m * n < n1)
{
Scierror(999,_("%s: Wrong size for input argument #%d: %d < %d expected.\n"),fname,kopt,m*n,n1);
return 0;
}
if (n1==1&&m*n==1)
{
ix = 2;
CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l1);
*istk(l1)=*istk(l);
*istk(l1+1)=1;
l=l1;
}
*style = istk(l);
}
else /* unspecified argument --> default value */
{
ix = Max(n1,2);
CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l);
for (i = 0 ; i < n1 ; ++i)
{
*istk(l + i) = i+1;
}
if (n1 == 1)
{
*istk(l +1) = 1;
}
*style = istk(l);
}
return 1;
}
/*--------------------------------------------------------------------------*/
int sci_gethistory(char *fname, unsigned long fname_len)
{
static int l1 = 0, m1 = 0, n1 = 0;
CheckRhs(0, 1);
CheckLhs(1, 1);
if (getNumberOfLinesInScilabHistory() <= 0)
{
m1 = 0;
n1 = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
if (Rhs == 1)
{
if (GetType(1) == sci_matrix)
{
int N = 0;
char *line = NULL;
GetRhsVar(1, MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &l1);
N = *istk(l1);
line = getNthLineInScilabHistory(N);
if (line)
{
n1 = 1;
CreateVarFromPtr(Rhs + 1, STRING_DATATYPE, (m1 = (int)strlen(line), &m1), &n1, &line);
FREE(line);
}
else
{
m1 = 0;
n1 = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), fname, 1);
return 0;
}
}
else
{
char **lines = NULL;
int nblines = 0;
nblines = getSizeAllLinesOfScilabHistory();
lines = getAllLinesOfScilabHistory();
if (lines)
{
int m = 0, n = 0;
m = nblines;
n = 1;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &m, &n, lines);
freeArrayOfString(lines, nblines);
}
else
{
m1 = 0;
n1 = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
}
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
/*-------------------------------------------------------------------------------------*/
static int sci_strcat_two_rhs(char *fname)
{
int Type_One = VarType(1);
int Type_Two = VarType(2);
int Number_Inputs_Two = 0;
char **Input_String_Two = NULL;
if (Type_Two != sci_strings)
{
Scierror(246, _("%s: Wrong type for input argument #%d: Single string expected.\n"), fname, 2);
return 0;
}
else /* sci_strings */
{
int Row_Two = 0, Col_Two = 0;
GetRhsVar(2, MATRIX_OF_STRING_DATATYPE, &Row_Two, &Col_Two, &Input_String_Two);
Number_Inputs_Two = Row_Two * Col_Two;
/* check we have only a string as second parameter */
if (Number_Inputs_Two != 1)
{
freeArrayOfString(Input_String_Two, Number_Inputs_Two);
Scierror(36, "%s : Wrong size for input argument #%d: Single string expected.\n", fname, 2);
return 0;
}
}
if ((Type_One != sci_strings) && (Type_One != sci_matrix))
{
freeArrayOfString(Input_String_Two, Number_Inputs_Two);
Scierror(246, "%s: Wrong type for input argument #%d: Matrix of strings expected.\n", fname, 1);
return 0;
}
else
{
if (Type_One == sci_matrix)
{
freeArrayOfString(Input_String_Two, Number_Inputs_Two);
sci_strcat_rhs_one_is_a_matrix(fname);
}
else /* sci_strings */
{
char **Input_String_One = NULL;
int Row_One = 0, Col_One = 0;
int Number_Inputs_One = 0;
int length_output = 0;
GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &Row_One, &Col_One, &Input_String_One);
Number_Inputs_One = Row_One * Col_One;
if (Input_String_One)
{
if ((Number_Inputs_One == 1) && (strcmp(Input_String_One[0], "") == 0))
{
/* With no input argument returns a zero length character string */
int m1 = 0, n1 = 0, l1 = 0;
CreateVar(Rhs + 1, STRING_DATATYPE, &m1, &n1, &l1);
freeArrayOfString(Input_String_Two, Number_Inputs_Two);
freeArrayOfString(Input_String_One, Number_Inputs_One);
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
else
{
if (Number_Inputs_One == 1)
{
length_output = (int)strlen(Input_String_One[0]);
}
else
{
int lengthInput_String_Two = (int)strlen(Input_String_Two[0]);
length_output = sumlengthstring(1) + (int)(Number_Inputs_One) * lengthInput_String_Two - lengthInput_String_Two;
}
}
}
if (length_output > 0)
{
static int n1 = 0, m1 = 0;
int outIndex = 0;
char *Output_String = NULL;
int i = 0;
int Number_Inputs_OneLessOne = Number_Inputs_One - 1;
m1 = length_output;
n1 = 1;
CreateVar(Rhs + 1, STRING_DATATYPE, &m1, &n1, &outIndex);
Output_String = cstk(outIndex);
/* strcpy + strcat faster than sprintf */
strcpy(Output_String, Input_String_One[0]);
(0 < Number_Inputs_OneLessOne) ? strcat(Output_String, Input_String_Two[0]) : 0;
for (i = 1; i < Number_Inputs_One; i++)
{
strcat(Output_String, Input_String_One[i]);
(i < Number_Inputs_OneLessOne) ? strcat(Output_String, Input_String_Two[0]) : 0;
}
freeArrayOfString(Input_String_One, Row_One * Col_One);
freeArrayOfString(Input_String_Two, Number_Inputs_Two);
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
if (length_output == 0)
{
int one = 1;
int len = (int)strlen(EMPTY_CHAR);
int outIndex = 0;
CreateVar(Rhs + 1, STRING_DATATYPE, &len, &one, &outIndex);
strcpy(cstk(outIndex), EMPTY_CHAR);
freeArrayOfString(Input_String_Two, Number_Inputs_Two);
freeArrayOfString(Input_String_One, Number_Inputs_One);
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
freeArrayOfString(Input_String_Two, Number_Inputs_Two);
freeArrayOfString(Input_String_One, Number_Inputs_One);
Scierror(999, _("%s : Wrong size for input argument(s).\n"), fname);
}
}
}
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_buildouttb(char *fname,unsigned long fname_len)
{
static int l1 = 0, m1 = 0, n1 = 0;
static int l2 = 0, m2 = 0, n2 = 0;
static int l3 = 0, n3 = 1;
SciIntMat M1,M2,M3;
int n_lnksz = 0, n_lnktyp = 0;
int *lnksz = NULL,*lnktyp = NULL;
double *ptr_d = NULL;
double *ptr_dc = NULL;
int *ptr_i = NULL;
short *ptr_s = NULL;
char *ptr_c = NULL;
int *ptr_ui = NULL;
short *ptr_us = NULL;
char *ptr_uc = NULL;
int nm = 0,i = 0,j = 0,ierr = 0;
static int minlhs=1, maxlhs=1;
static int minrhs=2, maxrhs=2;
/*check number of lhs/rhs*/
CheckLhs(minlhs, maxlhs);
CheckRhs(minrhs, maxrhs);
/*check type of Rhs 1*/
if (VarType(1) == 1)
{
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
}
else if (VarType(1) == sci_ints)
{
GetRhsVar(1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &M1);
}
else
{
Scierror(888, _("%s : lnksz argument must be double or integer.\n"),fname);
return 0;
}
/*check type of Rhs 2*/
if (VarType(2) == 1)
{
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &l2);
}
else if (VarType(2) == sci_ints)
{
GetRhsVar(2, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m2, &n2, &M2);
}
else
{
Scierror(888,_("%s : lnktyp argument must be double or integer.\n"),fname);
if (lnksz!=NULL) FREE(lnksz);
return 0;
}
/*check size of Rhs 1*/
if (m1 == 2) n_lnksz = n1;
else if (n1==2) n_lnksz = m1;
/*void double input give void list output*/
else if ((n1==0)||(m1==0))
{
if ((n2==0)||(m2==0))
{
/*manually code a void list on rhs(1)*/
ptr_i = (int*)GetData(1);
ptr_i[0] = sci_list;
ptr_i[1] = 0;
ptr_i[2] = 1;
LhsVar(1) = 1;
PutLhsVar();
return 0;
}
else
{
Scierror(888, _("%s : inconsistent dimension between lnksz and lnktyp.\n"), fname);
return 0;
}
}
else
{
Scierror(888, _("%s : bad dimension for lnksz argument.\n"), fname);
return 0;
}
/*check size of Rhs 2*/
if (m2 == 1) n_lnktyp = n2;
else if (n2 == 1) n_lnktyp = m2;
else if ((n2 == 0)||(m2 == 0))
{
if ( (n1 != 0) && (m1 != 0) )
{
Scierror(888, _("%s : inconsistent dimension between lnksz and lnktyp.\n"),fname);
return 0;
}
}
else
{
Scierror(888, _("%s : bad dimension for lnktyp argument.\n"),fname);
return 0;
}
/*cross size checking*/
if (n_lnksz!=n_lnktyp)
{
Scierror(888, _("%s : lnksz and lnktyp argument must have the same length.\n"),fname);
return 0;
}
/*allocate lnksz*/
if ((lnksz=MALLOC(2*n_lnksz*sizeof(int)))==NULL)
{
Scierror(999, _("%s : No more free memory.\n"),fname);
return 0;
}
/* Allocate lnktyp*/
if ((lnktyp=MALLOC(n_lnktyp*sizeof(int)))==NULL)
{
Scierror(999, _("%s : No more free memory.\n"),fname);
if (lnksz!=NULL) FREE(lnksz);
return 0;
}
/*store rhs 1 in lnksz */
if ((m1 == n1)&&(m2 == m1)) m1 = -1; /* this is done for matrix 2,2 */
if (VarType(1) == 8)
{
switch (M1.it)
{
case I_CHAR : if (m1==2)
{
for(j=0;j<n_lnksz;j++)
{
lnksz[j]=(int) IC_CHAR(M1.D)[j*2];
lnksz[n_lnksz+j]=(int) IC_CHAR(M1.D)[2*j+1];
}
}
else
{
for(j=0;j<2*n_lnksz;j++)
lnksz[j]=(int) IC_CHAR(M1.D)[j];
}
break;
case I_INT16 : if (m1==2)
{
for(j=0;j<n_lnksz;j++)
{
lnksz[j]=(int) IC_INT16(M1.D)[j*2];
lnksz[n_lnksz+j]=(int) IC_INT16(M1.D)[2*j+1];
}
}
else
{
for(j=0;j<2*n_lnksz;j++)
lnksz[j]=(int) IC_INT16(M1.D)[j];
}
break;
case I_INT32 : if (m1==2)
{
for(j=0;j<n_lnksz;j++)
{
lnksz[j]=(int) IC_INT32(M1.D)[j*2];
lnksz[n_lnksz+j]=(int) IC_INT32(M1.D)[2*j+1];
}
}
else
{
for(j=0;j<2*n_lnksz;j++)
lnksz[j]=(int) IC_INT32(M1.D)[j];
}
break;
case I_UCHAR : if (m1==2)
{
for(j=0;j<n_lnksz;j++)
{
lnksz[j]=(int) IC_UCHAR(M1.D)[j*2];
lnksz[n_lnksz+j]=(int) IC_UCHAR(M1.D)[2*j+1];
}
}
else
{
for(j=0;j<2*n_lnksz;j++)
lnksz[j]=(int) IC_UCHAR(M1.D)[j];
}
break;
case I_UINT16 : if (m1==2)
{
for(j=0;j<n_lnksz;j++)
{
lnksz[j]=(int) IC_UINT16(M1.D)[j*2];
lnksz[n_lnksz+j]=(int) IC_UINT16(M1.D)[2*j+1];
}
}
else
{
for(j=0;j<2*n_lnksz;j++)
lnksz[j]=(int) IC_UINT16(M1.D)[j];
}
break;
case I_UINT32 : if (m1==2)
{
for(j=0;j<n_lnksz;j++)
{
lnksz[j]=(int) IC_UINT32(M1.D)[j*2];
lnksz[n_lnksz+j]=(int) IC_UINT32(M1.D)[2*j+1];
}
}
else
{
for(j=0;j<2*n_lnksz;j++)
lnksz[j]=(int) IC_UINT32(M1.D)[j];
}
break;
}
}
else
{
if (m1==2)
{
for(j=0;j<n_lnksz;j++)
{
lnksz[j]=(int) ((double *) stk(l1))[j*2];
lnksz[n_lnksz+j]=(int) ((double *) stk(l1))[2*j+1];
}
}
else
{
for(j=0;j<2*n_lnksz;j++)
lnksz[j]=(int) ((double *) stk(l1))[j];
}
}
/*store rhs 2 in lnktyp */
if (VarType(2) == sci_ints)
{
switch (M2.it)
{
case I_CHAR : for(j=0;j<n_lnktyp;j++)
lnktyp[j]=(int) IC_CHAR(M2.D)[j];
break;
case I_INT16 : for(j=0;j<n_lnktyp;j++)
lnktyp[j]=(int) IC_INT16(M2.D)[j];
break;
case I_INT32 : for(j=0;j<n_lnktyp;j++)
lnktyp[j]=(int) IC_INT32(M2.D)[j];
break;
case I_UCHAR : for(j=0;j<n_lnktyp;j++)
lnktyp[j]=(int) IC_UCHAR(M2.D)[j];
break;
case I_UINT16 : for(j=0;j<n_lnktyp;j++)
lnktyp[j]=(int) IC_UINT16(M2.D)[j];
break;
case I_UINT32 : for(j=0;j<n_lnktyp;j++)
lnktyp[j]=(int) IC_UINT32(M2.D)[j];
break;
}
}
else
{
for(j=0;j<n_lnktyp;j++)
lnktyp[j]=(int) ((double *) stk(l2))[j];
}
/* build output list */
CreateVar(3,LIST_DATATYPE,&n_lnktyp,&n3,&l3);
for(i=0;i<n_lnktyp;i++)
{
nm=lnksz[i]*lnksz[i+n_lnktyp];
switch (lnktyp[i])
{
case 1 : if ((ptr_d=MALLOC(nm*sizeof(double)))==NULL)
{
ierr=-1;
break;
}
for (j=0;j<nm;j++) ptr_d[j]=0;
CreateListVarFromPtr(3,i+1,MATRIX_OF_DOUBLE_DATATYPE,&lnksz[i],&lnksz[i+n_lnktyp], &ptr_d);
FREE(ptr_d);
break;
case 2 : if ((ptr_d=MALLOC(2*nm*sizeof(double)))==NULL)
{
ierr=-1;
break;
}
for (j=0;j<2*nm;j++) ptr_d[j]=0;
ptr_dc = &ptr_d[nm];
CreateListCVarFromPtr(3,i+1,MATRIX_OF_DOUBLE_DATATYPE,(j=1,&j),&lnksz[i],&lnksz[i+n_lnktyp],&ptr_d,&ptr_dc);
FREE(ptr_d);
break;
case 3 : if ((ptr_i=MALLOC(nm*sizeof(int)))==NULL)
{
ierr=-1;
break;
}
for (j=0;j<nm;j++) ptr_i[j]=0;
M3.m = lnksz[i];
M3.n = lnksz[i+n_lnktyp];
M3.it = 4;
M3.l = -1;
M3.D = ptr_i;
CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
FREE(ptr_i);
break;
case 4 : if ((ptr_s=MALLOC(nm*sizeof(short)))==NULL)
{
ierr=-1;
break;
}
for (j=0;j<nm;j++) ptr_s[j]=0;
M3.m = lnksz[i];
M3.n = lnksz[i+n_lnktyp];
M3.it = 2;
M3.l = -1;
M3.D = ptr_s;
CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
FREE(ptr_s);
break;
case 5 : if ((ptr_c=MALLOC(nm*sizeof(char)))==NULL)
{
ierr=-1;
break;
}
for (j=0;j<nm;j++) ptr_c[j]=0;
M3.m = lnksz[i];
M3.n = lnksz[i+n_lnktyp];
M3.it = 1;
M3.l = -1;
M3.D = ptr_c;
CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
FREE(ptr_c);
break;
case 6 : if ((ptr_ui=MALLOC(nm*sizeof(unsigned int)))==NULL)
{
ierr=-1;
break;
}
for (j=0;j<nm;j++) ptr_ui[j]=0;
M3.m = lnksz[i];
M3.n = lnksz[i+n_lnktyp];
M3.it = 14;
M3.l = -1;
M3.D = ptr_ui;
CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
FREE(ptr_ui);
break;
case 7 : if ((ptr_us=MALLOC(nm*sizeof(unsigned short)))==NULL)
{
ierr=-1;
break;
}
for (j=0;j<nm;j++) ptr_us[j]=0;
M3.m = lnksz[i];
M3.n = lnksz[i+n_lnktyp];
M3.it = 12;
M3.l = -1;
M3.D = ptr_us;
CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
FREE(ptr_us);
break;
case 8 : if ((ptr_uc=MALLOC(nm*sizeof(unsigned char)))==NULL)
{
ierr=-1;
break;
}
for (j=0;j<nm;j++) ptr_uc[j]=0;
M3.m = lnksz[i];
M3.n = lnksz[i+n_lnktyp];
M3.it = 11;
M3.l = -1;
M3.D = ptr_uc;
CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
FREE(ptr_uc);
break;
default : if ((ptr_d=MALLOC(nm*sizeof(double)))==NULL)
{
ierr=-1;
break;
}
for (j=0;j<nm;j++) ptr_d[j]=0;
CreateListVarFromPtr(3,i+1,MATRIX_OF_DOUBLE_DATATYPE,&lnksz[i],&lnksz[i+n_lnktyp], &ptr_d);
FREE(ptr_d);
break;
}
if (ierr==-1)
{
Scierror(999,_("%s : No more free memory.\n"),fname);
FREE(lnksz);
FREE(lnktyp);
return 0;
}
}
LhsVar(1) = 3;
FREE(lnksz);
FREE(lnktyp);
PutLhsVar();
return 0;
}
/*-------------------------------------------------------------------------------------*/
static int sci_strcat_one_rhs(char *fname)
{
int Type_One = VarType(1);
if ((Type_One != sci_strings) && (Type_One != sci_matrix))
{
Scierror(246, "%s: Wrong type for input argument #%d: Matrix of strings expected.\n", fname, 1);
return 0;
}
else
{
if (Type_One == sci_strings)
{
int lenstrcat = sumlengthstring(1);
if (lenstrcat >= 0)
{
char **Input_String_One = NULL;
int m = 0, n = 0; /* matrix size */
int mn = 0; /* m*n */
int n1 = 1, m1 = lenstrcat;
int outIndex = 0;
char *Output_String = NULL;
int i = 0;
int sizeLengths = 0;
int *lengths = lengthEachString(1, &sizeLengths);
int l = 0;
if (lengths == NULL)
{
Scierror(999, _("%s: error.\n"), fname);
return 0;
}
GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m, &n, &Input_String_One);
mn = m * n;
CreateVar(Rhs + 1, STRING_DATATYPE, &m1, &n1, &outIndex);
Output_String = cstk(outIndex);
l = 0;
for (i = 0; i < mn; i++)
{
/* bug 4728 Compatibility with Scilab 4.1.2 */
/* replaces strcpy & strcat by memcpy */
/* copy of char array and not string */
if (i == 0)
{
memcpy(Output_String, Input_String_One[i], lengths[i]);
}
else
{
memcpy(Output_String + l, Input_String_One[i], lengths[i]);
}
l = l + lengths[i];
}
FREE(lengths);
lengths = NULL;
if (Input_String_One)
{
freeArrayOfString(Input_String_One, mn);
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
Scierror(999, _("%s: Wrong size for input argument(s).\n"), fname);
}
}
else /* sci_matrix */
{
sci_strcat_rhs_one_is_a_matrix(fname);
}
}
return 0;
}
int
intoperator (char *fname)
{
int ainf, asup, binf, bsup, op;
int sa[2], sb[2], flag[1];
int cinf, csup, f;
int ma, na, ma2, na2;
int mb, nb, mb2, nb2;
int r, s;
int p, q, t, u;
int rt;
CheckRhs (5, 5);
CheckLhs (2, 3);
GetRhsVar (1, "d", &na, &ma, &ainf);
GetRhsVar (2, "d", &na2, &ma2, &asup);
GetRhsVar (3, "c", &t, &u, &op);
GetRhsVar (4, "d", &nb, &mb, &binf);
GetRhsVar (5, "d", &nb2, &mb2, &bsup);
if (*cstk (op) == 'k' || *cstk (op) == 'y')
{
r = na * nb;
s = ma * mb;
}
else
{
if (na * ma == 1)
{
r = nb;
s = mb;
}
else if (nb * mb == 1 || (na == nb && ma == mb))
{
r = na;
s = ma;
}
else if (ma == nb)
{
r = na;
s = mb;
}
else
{
r = 0;
s = 0;
}
}
p = 1;
q = 1;
CreateVar (6, "d", &r, &s, &cinf);
CreateVar (7, "d", &r, &s, &csup);
CreateVar (8, "i", &p, &q, &f);
sa[0] = na;
sa[1] = ma;
sb[0] = nb;
sb[1] = mb;
if (r * s != 0)
{
if (nb2 * mb2 == 0)
{
operate (stk (ainf), stk (asup), sa,
stk (binf), NULL, sb,
*cstk (op), stk (cinf), stk (csup), flag);
}
else if (na2 * ma2 == 0)
{
operate (stk (ainf), NULL, sa,
stk (binf), stk (bsup), sb,
*cstk (op), stk (cinf), stk (csup), flag);
}
else
{
operate (stk (ainf), stk (asup), sa,
stk (binf), stk (bsup), sb,
*cstk (op), stk (cinf), stk (csup), flag);
}
}
else
{
flag[0] = -1;
}
*istk (f) = flag[0];
LhsVar (1) = 6;
LhsVar (2) = 7;
LhsVar (3) = 8;
return 0;
}
/*-------------------------------------------------------------------------------------*/
static int sci_strcat_three_rhs(char *fname)
{
int Row_One = 0, Col_One = 0;
char **Input_String_One = NULL;
int mn = 0;
static char def_sep[] = "";
char *Input_String_Two = def_sep;
char typ = 0;
int i = 0;
if (VarType(1) != sci_strings)
{
Scierror(999, _("%s: Wrong type for input argument #%d: a string vector expected.\n"), fname, 1);
return 0;
}
if (VarType(2) != sci_strings)
{
Scierror(999, "%s : Wrong size for input argument #%d: Single string expected.\n", fname, 2);
return 0;
}
if (VarType(3) != sci_strings)
{
Scierror(999, "%s : Wrong size for input argument #%d: Single string expected.\n", fname, 3);
return 0;
}
GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &Row_One, &Col_One, &Input_String_One);
mn = Row_One * Col_One;
if (Rhs >= 2)
{
/* second argument always a string and not a matrix of string */
int l2 = 0;
int Row_Two = 0, Col_Two = 0;
GetRhsVar(2, STRING_DATATYPE, &Row_Two, &Col_Two, &l2);
Input_String_Two = cstk(l2);
}
if (Rhs >= 3)
{
int Row_Three = 0, Col_Three = 0;
int l3 = 0;
GetRhsVar(3, STRING_DATATYPE, &Row_Three, &Col_Three, &l3);
if (Row_Three * Col_Three != 0)
{
typ = cstk(l3)[0];
}
if (typ != COL && typ != ROW)
{
freeArrayOfString(Input_String_One, mn);
Scierror(999, _("%s: Wrong type for input argument #%d: '%s' or '%s' expected.\n"), fname, 3, "c", "r");
return 0;
}
}
switch (typ)
{
case STAR:
{
int nchars = 0;
int one = 1;
int l3 = 0;
int k = 0;
/* just return one string */
for (i = 0; i < mn; i++)
{
nchars += (int)strlen(Input_String_One[i]);
}
nchars += (mn - 1) * (int)strlen(Input_String_Two);
CreateVar(Rhs + 1, STRING_DATATYPE, &one, &nchars, &l3);
for (i = 0; i < mn; i++)
{
int j = 0;
for (j = 0; j < (int)strlen(Input_String_One[i]); j++)
{
*cstk(l3 + k++) = Input_String_One[i][j];
}
if (i != mn - 1)
for (j = 0; j < (int)strlen(Input_String_Two); j++)
{
*cstk(l3 + k++) = Input_String_Two[j];
}
}
freeArrayOfString(Input_String_One, mn);
LhsVar(1) = Rhs + 1;
}
break;
case COL:
{
char **Output_String = NULL;
int nchars = 0;
int one = 1;
/* return a column matrix */
if ((Output_String = (char **)MALLOC((Row_One + 1) * sizeof(char *))) == NULL)
{
freeArrayOfString(Input_String_One, mn);
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
Output_String[Row_One] = NULL;
for (i = 0; i < Row_One; i++)
{
int j = 0;
/* length of row i */
nchars = 0;
for (j = 0; j < Col_One; j++)
{
nchars += (int)strlen(Input_String_One[i + Row_One * j]);
}
nchars += (Col_One - 1) * (int)strlen(Input_String_Two);
Output_String[i] = (char *)MALLOC((nchars + 1) * sizeof(char));
if (Output_String[i] == NULL)
{
freeArrayOfString(Output_String, i);
freeArrayOfString(Input_String_One, mn);
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
/* fill the string */
strcpy(Output_String[i], Input_String_One[i]);
for (j = 1; j < Col_One; j++)
{
strcat(Output_String[i], Input_String_Two);
strcat(Output_String[i], Input_String_One[i + Row_One * j]);
}
}
CreateVarFromPtr(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &Row_One, &one, Output_String);
freeArrayOfString(Input_String_One, mn);
freeArrayOfString(Output_String, Row_One + 1);
LhsVar(1) = Rhs + 1;
}
break;
case ROW:
{
int j = 0;
int one = 1;
char **Output_String = (char **)CALLOC(Col_One, sizeof(char *));
/* return a row matrix */
if (Output_String == NULL)
{
freeArrayOfString(Input_String_One, mn);
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
for (j = 0; j < Col_One; j++)
{
Output_String[j] = strdup(Input_String_One[j * Row_One]);
if (Output_String[j] == NULL)
{
freeArrayOfString(Output_String, j);
freeArrayOfString(Input_String_One, mn);
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
for (i = 1; i < Row_One; i++)
{
int lenOutput = 0;
int lenInput = 0;
int lenNew = 0;
if (Input_String_Two)
{
lenOutput = (int)strlen(Output_String[j]);
lenInput = (int)strlen(Input_String_Two);
lenNew = lenOutput + lenInput + 1;
Output_String[j] = (char *)REALLOC(Output_String[j], sizeof(char *) * lenNew);
if (Output_String[j] == NULL)
{
freeArrayOfString(Output_String, j);
freeArrayOfString(Input_String_One, mn);
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
strcat(Output_String[j], Input_String_Two);
}
if (Input_String_One[i + Row_One * j])
{
lenOutput = (int)strlen(Output_String[j]);
lenInput = (int)strlen(Input_String_One[i + Row_One * j]);
lenNew = lenOutput + lenInput + 1;
Output_String[j] = (char *)REALLOC(Output_String[j], sizeof(char *) * lenNew);
if (Output_String[j] == NULL)
{
freeArrayOfString(Output_String, j);
freeArrayOfString(Input_String_One, mn);
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
strcat(Output_String[j], Input_String_One[i + Row_One * j]);
}
}
}
CreateVarFromPtr(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &one, &Col_One, Output_String);
freeArrayOfString(Input_String_One, mn);
if (Col_One == 1)
{
FREE(Output_String);
Output_String = NULL;
}
else
{
freeArrayOfString(Output_String, Col_One);
}
LhsVar(1) = Rhs + 1;
}
break;
default:
{
freeArrayOfString(Input_String_One, mn);
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, 3, "c", "r");
return 0;
}
break;
}
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_xls_read(char *fname, unsigned long fname_len)
{
int m1 = 0, n1 = 0, l1 = 0, zero = 0, ierr = 0;
double *data = NULL;
int *ind = NULL;
int M = 0, N = 0, MN = 0;
int pos = 0, fd = 0;
CheckLhs(2, 2);
CheckRhs(2, 2);
if (VarType(1) != sci_matrix)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Scalar expected.\n"), fname, 1);
return 0;
}
if (VarType(2) != sci_matrix)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Scalar expected.\n"), fname, 2);
return 0;
}
/* checking variable fd */
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
fd = (int) * stk(l1);
/* checking variable Pos */
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
pos = (int) * stk(l1);
xls_read(&fd, &pos, &data, &ind, &N, &M, &ierr);
switch (ierr)
{
case 1 :
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
break;
case 2 :
Scierror(999, _("%s: Failed to read expected data, may be invalid xls file.\n"), fname);
return 0;
break;
case 3 :
Scierror(999, _("%s: End of file.\n"), fname);
return 0;
break;
default :
/* no error */
break;
}
MN = M * N;
if (MN == 0)
{
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &zero, &zero, &l1);
CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &zero, &zero, &l1);
}
else
{
CreateVarFromPtr(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &N, &M, &data);
CreateVarFromPtr(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &N, &M, &ind);
FREE(data);
data = NULL;
FREE(ind);
ind = NULL;
}
LhsVar(1) = Rhs + 1;
LhsVar(2) = Rhs + 2;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_messagebox(char *fname,unsigned long fname_len)
{
int messageBoxID = 0;
/* Used to read input arguments */
int nbRow = 0, nbCol = 0;
int nbRowButtons = 0, nbColButtons = 0;
int nbRowMessage = 0, nbColMessage = 0;
char **buttonsTextAdr = 0;
char **messageAdr = 0;
char **titleAdr = 0;
char **modalOptionAdr = 0;
char **iconAdr = 0;
/* Used to write output argument */
int buttonNumberAdr = 0;
int buttonNumber = 0;
CheckRhs(1,5);
CheckLhs(0,1);
/* Message to be displayed */
if (VarType(1) == sci_strings)
{
GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &nbRowMessage, &nbColMessage, &messageAdr);
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 1);
return FALSE;
}
/* Title to be displayed */
if (Rhs >= 2)
{
if (VarType(2) == sci_strings)
{
GetRhsVar(2, MATRIX_OF_STRING_DATATYPE, &nbRow, &nbCol, &titleAdr);
if (nbRow*nbCol!=1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 2);
return FALSE;
}
/* The title argument can be used to give the modal option */
if (isModalOption(getStringMatrixFromStack((size_t)titleAdr)[0]))
{
modalOptionAdr = titleAdr;
titleAdr = NULL;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 2);
return FALSE;
}
}
/* Icon to be displayed */
if (Rhs >= 3)
{
if (VarType(3) == sci_strings)
{
GetRhsVar(3,MATRIX_OF_STRING_DATATYPE,&nbRow,&nbCol,&iconAdr);
if (nbRow*nbCol == 1)
{
/* The icon argument can be used to give the modal option or the buttons names */
if (isModalOption(getStringMatrixFromStack((size_t)iconAdr)[0]))
{
modalOptionAdr = (char **)iconAdr;
iconAdr = NULL;
}
else if(!isIconName(getStringMatrixFromStack((size_t)iconAdr)[0]))
{
buttonsTextAdr = (char **)iconAdr;
nbRowButtons = nbRow;
nbColButtons = nbCol;
iconAdr = NULL;
}
}
else /* More than one string --> buttons names */
{
buttonsTextAdr = (char **)iconAdr;
nbRowButtons = nbRow;
nbColButtons = nbCol;
iconAdr = NULL;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A string or a string vector expected.\n"), fname, 3);
return FALSE;
}
}
/* Buttons names */
if (Rhs >= 4)
{
if (VarType(4) == sci_strings)
{
GetRhsVar(4,MATRIX_OF_STRING_DATATYPE,&nbRowButtons,&nbColButtons,&buttonsTextAdr);
if (nbRow*nbCol == 1)
{
/* The buttons names argument can be used to give the modal option */
if (isModalOption(getStringMatrixFromStack((size_t)buttonsTextAdr)[0]))
{
modalOptionAdr = buttonsTextAdr;
buttonsTextAdr = NULL;
}
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A string or a string vector expected.\n"), fname, 3);
return FALSE;
}
}
/* Modal option */
if (Rhs == 5)
{
if (VarType(5) == sci_strings)
{
GetRhsVar(5,MATRIX_OF_STRING_DATATYPE,&nbRow,&nbCol,&modalOptionAdr);
if (nbRow*nbCol != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 5);
return FALSE;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 5);
return FALSE;
}
}
/* Create the Java Object */
messageBoxID = createMessageBox();
/* Message */
setMessageBoxMultiLineMessage(messageBoxID, getStringMatrixFromStack((size_t)messageAdr), nbColMessage*nbRowMessage);
/* Title */
if (titleAdr != NULL)
{
setMessageBoxTitle(messageBoxID, getStringMatrixFromStack((size_t)titleAdr)[0]);
}
else
{
setMessageBoxTitle(messageBoxID, _("Scilab Message"));
}
/* Icon */
if (iconAdr != NULL)
{
setMessageBoxIcon(messageBoxID, getStringMatrixFromStack((size_t)iconAdr)[0]);
}
/* Buttons */
if (buttonsTextAdr != NULL)
{
setMessageBoxButtonsLabels(messageBoxID, getStringMatrixFromStack((size_t)buttonsTextAdr), nbColButtons*nbRowButtons);
}
/* Modal ? */
if (modalOptionAdr != NULL)
{
setMessageBoxModal(messageBoxID, !stricmp(getStringMatrixFromStack((size_t)modalOptionAdr)[0],"modal"));
}
else
{
setMessageBoxModal(messageBoxID, FALSE);
}
/* Display it and wait for a user input */
messageBoxDisplayAndWait(messageBoxID);
/* Return the index of the button selected */
if (Lhs == 1)
{
/* Read the user answer */
buttonNumber = getMessageBoxSelectedButton(messageBoxID);
nbRow = 1; nbCol = 1;
CreateVar(Rhs+1, MATRIX_OF_DOUBLE_DATATYPE, &nbRow, &nbCol, &buttonNumberAdr);
*stk(buttonNumberAdr) = buttonNumber;
LhsVar(1) = Rhs+1;
}
else
{
LhsVar(1) = 0;
}
PutLhsVar();
return TRUE;
}