int sci_bug_11046(char *fname)
{
CheckRhs(0, 0);
sciprint("Overload call macro\n"); // %_myscifun
OverLoad(0);
return 0;
}
/*--------------------------------------------------------------------------*/
int C2F(intlu)(char *fname, unsigned long fname_len)
{
int *header1;
int CmplxA;
int ret;
/* lu(A) */
if (GetType(1) != sci_matrix)
{
OverLoad(1);
return 0;
}
header1 = (int *) GetData(1);
CmplxA = header1[3];
switch (CmplxA)
{
case REAL:
ret = C2F(intdgetrf)("lu", 2L);
break;
case COMPLEX:
ret = C2F(intzgetrf)("lu", 2L);
break;
default:
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 1);
break;
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_dlgamma(char *fname, unsigned long fname_len)
{
SciErr sciErr;
double* lX = NULL;
int* piAddrX = NULL;
int iType1 = 0;
int MX = 0, NX = 0, i = 0;
nbInputArgument(pvApiCtx) = Max(0, nbInputArgument(pvApiCtx));
CheckInputArgument(pvApiCtx, 1, 1);
CheckOutputArgument(pvApiCtx, 1, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrX);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddrX, &iType1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
if ((iType1 == sci_list) || (iType1 == sci_tlist) || (iType1 == sci_mlist))
{
OverLoad(1);
return 0;
}
if (isVarComplex(pvApiCtx, piAddrX))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real expected.\n"), fname, 1);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddrX, &MX, &NX, &lX);
if (sciErr.iErr)
{
Scierror(999, _("%s: Wrong type for argument %d: A matrix expected.\n"), fname, 1);
}
for (i = 0; i < MX * NX; i++)
{
lX[i] = C2F(psi)(lX + i);
}
AssignOutputVariable(pvApiCtx, 1) = 1;
returnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int C2F(intschur)(char *fname,unsigned long fname_len)
{
int *header1;int *header2;int *header3;
int Cmplx, CmplxA, CmplxB;
int ret, something, X;
int which = 1; int longueur;
if (GetType(1)!=sci_matrix)
{
OverLoad(1);
return 0;
}
header1 = (int *) GetData(1); CmplxA=header1[3];
switch (Rhs)
{
case 1: /* schur(A) */
switch (CmplxA)
{
case REAL :
ret = C2F(intdgees0)("schur",5L);
break;
case COMPLEX :
ret = C2F(intzgees0)("schur",5L);
break;
default :
Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname,1);
break;
}
break;
case 2 : /* schur(A, something) */
header2 = (int *) GetData(2); something=header2[0];
switch (something)
{
case FUNCTION :
switch (CmplxA)
{
case REAL :
ret = C2F(intoschur)("schur",5L);
break;
case COMPLEX :
ret = C2F(intzschur)("schur",5L);
break;
default :
Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname,2);
break;
}
break;
case STRING :
longueur=header2[5]-header2[4];
which = schtst(longueur, header2);
switch (which)
{
case STRINGREAL:
switch (CmplxA)
{
case REAL:
ret = C2F(intdgees1)("schur",5L);
break;
case COMPLEX:
Scierror(999,_("%s: Wrong type for input argument #%d: Real matrix expected.\n"),
fname,2);
break;
}
return 0;
case STRINGCOMPLEX:
switch (CmplxA)
{
case REAL:
ret = C2F(intdgees1)("schur",5L);
break;
case COMPLEX:
ret = C2F(intzgees1)("schur",5L);
break;
}
break;
default:
/* String is an external function */
switch (CmplxA)
{
case REAL:
ret = C2F(intfschur)("schur",5L);
break;
case COMPLEX:
ret = C2F(intzfschur)("schur",5L);
break;
}
}
break;
case SCI_DOUBLE: /*schur(A,B)*/
if (GetType(2)!=sci_matrix)
{
OverLoad(2);
return 0;
}
CmplxB=header2[3];
if ((CmplxA == 0) && (CmplxB ==0)) Cmplx =0;
else if ((CmplxA == 1) && (CmplxB ==0))
{
C2F(complexify)((X=2,&X));
Cmplx=1;
}
else if ((CmplxA == 0) && (CmplxB ==1))
{
C2F(complexify)((X=1,&X));
Cmplx=1;
}
else Cmplx=1;
switch (Cmplx)
{
case REAL :
ret = C2F(intdgges)("schur",6L);
break;
case COMPLEX :
ret = C2F(intzgges)("schur",6L);
break;
default :
Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname,1);
break;
}
break;
} /* end of switch (something) */
break;
case 3: /* schur(A,B,something) */
if (GetType(2)!=sci_matrix)
{
OverLoad(2);
return 0;
}
header2 = (int *) GetData(2); something=header2[0];
CmplxB=header2[3];
if ((CmplxA == 0) && (CmplxB ==0)) Cmplx =0;
else if ((CmplxA == 1) && (CmplxB ==0))
{
C2F(complexify)((X=2,&X));
Cmplx=1;
}
else if ((CmplxA == 0) && (CmplxB ==1))
{
C2F(complexify)((X=1,&X));
Cmplx=1;
}
else Cmplx=1;
header3 = (int *) GetData(3); something=header3[0];
switch (something)
{
case FUNCTION :
switch (Cmplx)
{
case REAL :
ret = C2F(intogschur)("schur",6L);
break;
case COMPLEX :
ret = C2F(intozgschur)("schur",6L);
break;
default :
Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname,3);
break;
}
break;
case STRING :
switch (Cmplx)
{
case REAL:
ret = C2F(intgschur)("schur",6L);
break;
case COMPLEX:
ret = C2F(intzgschur)("schur",6L);
break;
default :
Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname,3);
break;
}
break;
default: /* switch (something) */
break;
}
break; /* end of case 3 */
default :
Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname,1);
break;
} /*end of switch(Rhs) */
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_param3d1(char *fname, void *pvApiCtx)
{
SciErr sciErr;
int izcol = 0, isfac = 0;
double *zcol = NULL;
static double ebox_def [6] = { 0, 1, 0, 1, 0, 1};
double *ebox = ebox_def;
static int iflag_def[3] = {1, 2, 4};
int iflag[3] , *ifl = NULL;
double alpha_def = 35.0 , theta_def = 45.0;
double *alpha = &alpha_def, *theta = &theta_def;
int m1 = 0, n1 = 0, m2 = 0, n2 = 0, m3 = 0, n3 = 0;
int m3n = 0, n3n = 0, m3l = 0;
static rhs_opts opts[] =
{
{ -1, "alpha", -1, 0, 0, NULL},
{ -1, "ebox", -1, 0, 0, NULL},
{ -1, "flag", -1, 0, 0, NULL},
{ -1, "leg", -1, 0, 0, NULL},
{ -1, "theta", -1, 0, 0, NULL},
{ -1, NULL, -1, 0, 0, NULL}
};
char * labels = NULL;
int* piAddr1 = NULL;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
int* piAddr31 = NULL;
int* piAddr32 = NULL;
double* l1 = NULL;
double* l2 = NULL;
double* l3 = NULL;
double* l3n = NULL;
if (nbInputArgument(pvApiCtx) <= 0)
{
sci_demo(fname, pvApiCtx);
return 0;
}
CheckInputArgument(pvApiCtx, 3, 8);
if (getOptionals(pvApiCtx, fname, opts) == 0)
{
ReturnArguments(pvApiCtx);
return 0;
}
if (FirstOpt(pvApiCtx) < 4)
{
Scierror(999, _("%s: Misplaced optional argument: #%d must be at position %d.\n"), fname, 1, 4);
return (0);
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr1, &m1, &n1, &l1); /* x */
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
printError(&sciErr, 0);
return 1;
}
if (m1 == 1 && n1 > 1)
{
m1 = n1;
n1 = 1;
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &m2, &n2, &l2); /* y */
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 2);
printError(&sciErr, 0);
return 1;
}
if (m2 == 1 && n2 > 1)
{
m2 = n2;
n2 = 1;
}
if (m1 * n1 == 0)
{
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
//CheckSameDims
if (m1 != m2 || n1 != n2)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d-by-%d matrix expected.\n"), fname, 1, m1, n1);
return 1;
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
switch (getInputArgumentType(pvApiCtx, 3))
{
case 1 :
izcol = 0;
// Retrieve a matrix of double at position 3.
// YOU MUST REMOVE YOUR VARIABLE DECLARATION "int l3".
sciErr = getMatrixOfDouble(pvApiCtx, piAddr3, &m3, &n3, &l3); /* z */
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
break;
case 15 :
izcol = 1;
/* z = list(z,colors) */
sciErr = getListItemNumber(pvApiCtx, piAddr3, &m3l);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
if (m3l != 2)
{
Scierror(999, _("%s: Wrong size for input argument #%d: List of size %d expected.\n"),
fname, 2, m3l, 2);
return 0;
}
sciErr = getListItemAddress(pvApiCtx, piAddr3, 1, &piAddr31);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddr31, &m3, &n3, &l3); /* z */
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
sciErr = getListItemAddress(pvApiCtx, piAddr3, 2, &piAddr32);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddr32, &m3n, &n3n, &l3n); /* z */
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
zcol = (l3n);
if (m3n * n3n != n3)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d expected.\n"), fname, 3, n3);
return 0;
}
break;
default :
OverLoad(3);
return 0;
}
if (m3 == 1 && n3 > 1)
{
m3 = n3;
n3 = 1;
}
//CheckSameDims
if (m1 != m3 || n1 != n3)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d-by-%d matrix expected.\n"), fname, 1, m1, n1);
return 1;
}
GetOptionalDoubleArg(pvApiCtx, fname, 4, "theta", &theta, 1, opts);
GetOptionalDoubleArg(pvApiCtx, fname, 5, "alpha", &alpha, 1, opts);
GetLabels(pvApiCtx, fname, 6, opts, &labels);
iflag_def[1] = 8;
ifl = &(iflag_def[1]);
GetOptionalIntArg(pvApiCtx, fname, 7, "flag", &ifl, 2, opts);
iflag[0] = iflag_def[0];
iflag[1] = ifl[0];
iflag[2] = ifl[1];
GetOptionalDoubleArg(pvApiCtx, fname, 8, "ebox", &ebox, 6, opts);
if (m1 == 1 && n1 > 1)
{
m1 = n1;
n1 = 1;
}
getOrCreateDefaultSubwin();
/* NG beg */
isfac = -1;
Objplot3d (fname, &isfac, &izcol, (l1), (l2), (l3), zcol, &m1, &n1, theta, alpha, labels, iflag, ebox, &m1, &n1, &m2, &n2, &m3, &n3, &m3n, &n3n); /*Adding F.Leray 12.03.04*/
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
/* fftw function.
*
* Scilab Calling sequence :
* fftw(A [,option])
* fftw(A,sign [,option])
* fftw(A,sel,sign [,option])
* fftw(A,sign,dim,incr [,option])
*
* Input : A : a scilab double complex or real vector, matrix or hypermatrix
*
* sign : a scilab double or integer scalar (-1 or 1): the sign
* in the exponential component
*
* sel : a scilab double or integer vector, the selection of dimensions
* dim : a scilab double or integer vector: the dimensions
* of the Fast Fourier Transform to perform
*
* incr : a scilab double or integer vector: the increments
* of the Fast Fourier Transform to perform
*
* Output : a scilab double complex or real array with same shape as A that
* gives the result of the transform.
*
*/
int sci_fftw(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int *piAddr = NULL;
char *option = NULL;
int iopt = 0; /* automatic r2c or c2r transform use decision */
int rhs = Rhs;
int iTypeOne = 0;
int ndimsA = 0;
int *dimsA = NULL;
double *Ar = NULL, *Ai = NULL;
int isn = FFTW_FORWARD;
WITHMKL = withMKL();
/****************************************
* Basic constraints on rhs arguments *
****************************************/
/* check min/max lhs/rhs arguments of scilab function */
CheckInputArgument(pvApiCtx, 1, 5);
CheckOutputArgument(pvApiCtx, 1, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddr, &iTypeOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
if ((iTypeOne == sci_list) || (iTypeOne == sci_tlist))
{
OverLoad(1);
return 1;
}
if (iTypeOne == sci_mlist)
{
/* We allow overload for not hypermatrix type */
if (!isHyperMatrixMlist(pvApiCtx, piAddr))
{
OverLoad(1);
return 1;
}
}
/* checking if last argument is a potential option argument (character string) */
sciErr = getVarAddressFromPosition(pvApiCtx, Rhs, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, Rhs);
return 1;
}
if (isStringType(pvApiCtx, piAddr)) /* fftw(...,option); */
{
if (isScalar(pvApiCtx, piAddr))
{
if (getAllocatedSingleString(pvApiCtx, piAddr, &option) == 0)
{
if (strcmp("symmetric", option) == 0) iopt = 1; /*user assumes symmetry */
else if (strcmp("nonsymmetric", option) == 0) iopt = 2; /*user claims full transform */
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, Rhs, "\"symmetric\"", "\"nonsymmetric\"");
freeAllocatedSingleString(option);
option = NULL;
return 1;
}
freeAllocatedSingleString(option);
option = NULL;
rhs = Rhs - 1;
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, Rhs, "\"symmetric\"", "\"nonsymmetric\"");
return 1;
}
}
}
/******************** Checking if isn is given ************************************************/
if (rhs == 1) /*only one rhs argument: forward fft*/
{
isn = FFTW_FORWARD; /* default value */
}
else /*get isn out of second argument*/
{
sciErr = getScalarIntArg(pvApiCtx, 2, fname, &isn);
if (sciErr.iErr)
{
Scierror(sciErr.iErr, getErrorMessage(sciErr));
return 1;
}
/* check value of second rhs argument */
if ((isn != FFTW_FORWARD) && (isn != FFTW_BACKWARD))
{
Scierror(53, _("%s: Wrong value for input argument #%d: %d or %d expected.\n"), fname, 2, FFTW_FORWARD, FFTW_BACKWARD);
return 1;
}
}
/******************** getting the array A ************************************************/
getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (!getArrayOfDouble(pvApiCtx, piAddr, &ndimsA, &dimsA, &Ar, &Ai))
{
Scierror(999, _("%s: Wrong type for argument #%d: Array of floating point numbers expected.\n"), fname, 1);
return 1;
}
/******************** Select proper method ************************************************/
if (rhs < 3)
{
/* fftw(A ,sign [,option])*/
sci_fft_2args(pvApiCtx, fname, ndimsA, dimsA, Ar, Ai, isn, iopt);
}
else if (rhs == 3)
{
/* fftw(A ,sign ,sel [,option])*/
sci_fft_3args(pvApiCtx, fname, ndimsA, dimsA, Ar, Ai, isn, iopt);
}
else if (rhs == 4)
{
/* fftw(A ,sign ,dim,incr [option])*/
sci_fft_4args(pvApiCtx, fname, ndimsA, dimsA, Ar, Ai, isn, iopt);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int C2F(intqr)(char *fname, unsigned long fname_len)
{
int *header1;
int *header2;
int Cmplx;
int ret;
double *snd;
double tol;
if (GetType(1) != sci_matrix)
{
OverLoad(1);
return 0;
}
header1 = (int *) GetData(1);
Cmplx = header1[3];
if (header1[0] == 10)
{
Cmplx = 10;
}
if (Lhs == 4)
{
/* obsolete : [Q,R,rk,E]=qr(A) or = qr(A,tol) */
if (Rhs == 2)
{
if (GetType(2) == sci_matrix)
{
snd = (double *) GetData(2);
tol = snd[2];
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: Real scalar expected.\n"),
fname, 2);
return 0;
}
}
else
{
tol = -1;
Rhs = 1;
}
switch (Cmplx)
{
case REAL :
ret = C2F(doldqr)(&tol, "qr", 2L);
break;
case COMPLEX :
ret = C2F(zoldqr)(&tol, "qr", 2L);
break;
default :
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 1);
return 0;
}
return 0;
}
switch (Rhs)
{
case 1: /* qr(A) */
switch (Cmplx)
{
case REAL :
ret = C2F(intdgeqpf3)("qr", 2L);
break;
case COMPLEX :
ret = C2F(intzgeqpf3)("qr", 2L);
break;
default :
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 1);
break;
}
break;
case 2 : /* qr(A, something) */
header2 = (int *) GetData(2);
switch (header2[0])
{
case STRING :
/* Economy size: ...=qr(A,"e") */
switch (Cmplx)
{
case REAL :
ret = C2F(intdgeqpf4)("qr", 2L);
break;
case COMPLEX :
ret = C2F(intzgeqpf4)("qr", 2L);
break;
default :
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 1);
break;
}
break;
default:
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 2);
break;
}
return 0;
default :
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 1);
break;
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_plot3d(char * fname, unsigned long fname_len)
{
SciErr sciErr;
static double ebox_def [6] = { 0, 1, 0, 1, 0, 1};
double *ebox = ebox_def;
static int iflag_def[3] = {2, 2, 4};
int *iflag = iflag_def;
double alpha_def = 35.0 , theta_def = 45.0;
double *alpha = &alpha_def, *theta = &theta_def;
int m1 = 0, n1 = 0, m2 = 0, n2 = 0, m3 = 0, n3 = 0;
int m3n = 0, n3n = 0, m3l = 0;
int izcol = 0, isfac = 0;
double *zcol = NULL;
static rhs_opts opts[] =
{
{ -1, "alpha", -1, 0, 0, NULL},
{ -1, "ebox", -1, 0, 0, NULL},
{ -1, "flag", -1, 0, 0, NULL},
{ -1, "leg", -1, 0, 0, NULL},
{ -1, "theta", -1, 0, 0, NULL},
{ -1, NULL, -1, 0, 0, NULL}
};
char * legend = NULL;
int* piAddr1 = NULL;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
int* piAddr31 = NULL;
int* piAddr32 = NULL;
double* l1 = NULL;
double* l2 = NULL;
double* l3 = NULL;
double* l3n = NULL;
/*
** This overload the function to call demo script
** the demo script is called %_<fname>
*/
if (nbInputArgument(pvApiCtx) <= 0)
{
sci_demo(fname, fname_len);
return 0;
}
CheckInputArgument(pvApiCtx, 3, 8);
if (getOptionals(pvApiCtx, fname, opts) == 0)
{
ReturnArguments(pvApiCtx);
return 0;
}
if (FirstOpt() < 4)
{
Scierror(999, _("%s: Misplaced optional argument: #%d must be at position %d.\n"), fname, 1, 4);
return -1;
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr1, &m1, &n1, &l1);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 1);
printError(&sciErr, 0);
return 1;
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &m2, &n2, &l2);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 2);
printError(&sciErr, 0);
return 1;
}
if (m1 * n1 == 0)
{
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
if (nbInputArgument(pvApiCtx) >= 3)
{
/* third argument can be a matrix z or a list list(z,zcol) */
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
switch (getInputArgumentType(pvApiCtx, 3))
{
case sci_matrix :
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 3.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr3, &m3, &n3, &l3);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
izcol = 0;
break;
case sci_list :
izcol = 1;
/* z = list(z,colors) */
sciErr = getListItemNumber(pvApiCtx, piAddr3, &m3l);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
if (m3l != 2)
{
Scierror(999, _("%s: Wrong size for input argument #%d: List of size %d expected.\n"),
fname, 2, m3l, 2);
return 1;
}
sciErr = getListItemAddress(pvApiCtx, piAddr3, 1, &piAddr31);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddr31, &m3, &n3, &l3); /* z */
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
sciErr = getListItemAddress(pvApiCtx, piAddr3, 2, &piAddr32);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddr32, &m3n, &n3n, &l3n); /* z */
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
zcol = (l3n);
if (m3n * n3n != n3 && m3n * n3n != m3 * n3)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d or %d expected.\n"), fname, 3, n3, m3 * n3);
return 1;
}
/*
* Added by E Segre 4/5/2000. In the case where zcol is a
* matrix of the same size as z, we set izcol to 2. This
* value is later transmitted to the C2F(fac3dg) routine,
* which has been modified to do the interpolated shading
* (see the file SCI/modules/graphics/src/c/Plo3d.c
*/
if (m3n * n3n == m3 * n3)
{
izcol = 2 ;
}
break;
default :
OverLoad(3);
return 0;
}
}
iflag_def[1] = 8;
GetOptionalDoubleArg(pvApiCtx, fname, 4, "theta", &theta, 1, opts);
GetOptionalDoubleArg(pvApiCtx, fname, 5, "alpha", &alpha, 1, opts);
GetLabels(pvApiCtx, fname, 6, opts, &legend);
GetOptionalIntArg(pvApiCtx, fname, 7, "flag", &iflag, 3, opts);
GetOptionalDoubleArg(pvApiCtx, fname, 8, "ebox", &ebox, 6, opts);
if (m1 * n1 == m3 * n3 && m1 * n1 == m2 * n2 && m1 * n1 != 1)
{
if (! (m1 == m2 && m2 == m3 && n1 == n2 && n2 == n3))
{
Scierror(999, _("%s: Wrong value for input arguments #%d, #%d and #%d: Incompatible length.\n"), fname, 1, 2, 3);
return 1;
}
}
else
{
if (m2 * n2 != n3)
{
Scierror(999, _("%s: Wrong value for input arguments #%d and #%d: Incompatible length.\n"), fname, 2, 3);
return 1;
}
if (m1 * n1 != m3)
{
Scierror(999, _("%s: Wrong value for input arguments #%d and #%d: Incompatible length.\n"), fname, 1, 3);
return 1;
}
if (m1 * n1 <= 1 || m2 * n2 <= 1)
{
Scierror(999, _("%s: Wrong size for input arguments #%d and #%d: %s expected.\n"), fname, 2, 3, ">= 2");
return 1;
}
}
if (m1 * n1 == 0 || m2 * n2 == 0 || m3 * n3 == 0)
{
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
getOrCreateDefaultSubwin();
/******************** 24/05/2002 ********************/
if (m1 * n1 == m3 * n3 && m1 * n1 == m2 * n2 && m1 * n1 != 1) /* NG beg */
{
isfac = 1;
}
else
{
isfac = 0;
}
Objplot3d (fname, &isfac, &izcol, (l1), (l2), (l3), zcol, &m3, &n3, theta, alpha, legend, iflag, ebox, &m1, &n1, &m2, &n2, &m3, &n3, &m3n, &n3n); /*Adding F.Leray 12.03.04 and 19.03.04*/
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_gsort(char *fname, unsigned long fname_len)
{
char iord[2];
char typex[10];
SciIntMat Im;
int Type = 0;
char **S = NULL;
int m1 = 0, n1 = 0, l1 = 0;
int m2 = 0, n2 = 0, l2 = 0;
int m3 = 0, n3 = 0, l3 = 0;
int ind_m1 = 0, ind_n1 = 0;
int *indices = NULL;
int iflag = 0;
int i;
iord[0] = DECREASE_COMMAND;
iord[1] = '\0';
typex[0] = GLOBAL_SORT;
typex[1] = '\0';
Rhs = Max(0, Rhs);
CheckRhs(1, 3);
CheckLhs(1, 2);
if (Rhs >= 1)
{
Type = VarType(1);
switch (Type)
{
case sci_strings:
GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &S);
break;
case sci_matrix:
{
#define COMPLEX 1
int *header = NULL;
int Cmplx = 0;
header = (int *)GetData(1);
Cmplx = header[3];
if (Cmplx == COMPLEX)
{
return gsort_complex(fname, typex, iord);
}
else
{
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
if ((m1 * n1) == 0) /* [] returns [] */
{
int m = 0, n = 0, l = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
LhsVar(2) = Rhs + 2;
}
PutLhsVar();
return 0;
}
}
}
break;
case sci_ints:
GetRhsVar(1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &Im);
break;
case sci_sparse:
default:
OverLoad(1);
return 0;
break;
}
}
if (Rhs == 3)
{
int* piAddr = NULL;
char* pstData = NULL;
SciErr sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr, &pstData))
{
return 1;
}
if (strcmp(pstData, "i") && strcmp(pstData, "d"))
{
if (getWarningMode())
{
sciprint(_("WARNING: %s\n"), _("This usage of the third argument of gsort is obsolete."));
sciprint(_("WARNING: %s\n"), _("It will no more be available in Scilab 6."));
sciprint(_("WARNING: %s\n"), _("Please use 'd' or 'i' instead."));
}
}
iord[0] = pstData[0];
freeAllocatedSingleString(pstData);
}
if (Rhs >= 2)
{
int* piAddr = NULL;
char* pstData = NULL;
SciErr sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr, &pstData))
{
return 1;
}
if ((pstData[0] != ROW_SORT) && (pstData[0] != COLUMN_SORT) && (pstData[0] != GLOBAL_SORT) && (pstData[0] != LIST_SORT))
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s', '%s', '%s' or '%s' expected.\n"), fname, 2, "r", "c", "g", "lr", "lc");
return 1;
}
if (strcmp(pstData, "c") && strcmp(pstData, "r") && strcmp(pstData, "g") && strcmp(pstData, "lc") && strcmp(pstData, "lr"))
{
if (getWarningMode())
{
sciprint(_("WARNING: %s\n"), _("This usage of the second argument of gsort is obsolete."));
sciprint(_("WARNING: %s\n"), _("It will no more be available in Scilab 6."));
sciprint(_("WARNING: %s\n"), _("Please use 'r', 'c', 'g', 'lr' or 'lc' instead."));
}
}
strcpy(typex, pstData);
freeAllocatedSingleString(pstData);
}
if (typex[0] == LIST_SORT)
{
if (typex[1] == ROW_SORT)
{
ind_m1 = m1;
ind_n1 = 1;
if (ind_m1 != 0)
{
indices = (int *)MALLOC(sizeof(int) * (ind_m1)); /* Only return in row */
}
}
else if (typex[1] == COLUMN_SORT)
{
ind_m1 = 1;
ind_n1 = n1;
if (ind_n1 != 0)
{
indices = (int *)MALLOC(sizeof(int) * (ind_n1)); /*Only return in col */
}
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d.\n"), fname, 2);
return 0;
}
}
else
{
ind_m1 = m1;
ind_n1 = n1;
if (ind_m1 * ind_n1 != 0)
{
indices = (int *)MALLOC(sizeof(int) * (ind_m1 * ind_n1)); /* return a matrix */
}
}
if (Lhs == 2)
{
iflag = 1;
}
else
{
iflag = 0;
}
switch (Type)
{
case sci_matrix:
{
if (m1 * n1 != 0)
{
int lr;
double *matrix = stk(l1);
double *tmp_matrix = NULL;
/* next CreateVar and corresponding copy not needed if arg1 is not passed by reference */
if (!CreateVarNoCheck(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lr))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
tmp_matrix = stk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortd) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
if (!CreateVarFromPtrNoCheck(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &ind_m1, &ind_n1, &indices))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(2) = Rhs + 2;
}
if (indices)
{
FREE(indices);
indices = NULL;
}
PutLhsVar();
}
}
break;
case sci_ints:
{
int lr;
lr = Im.it;
/* next CreateVar and corresponding copy not needed if arg1 is not passed by reference */
if (!CreateVarNoCheck(Rhs + 1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &lr))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
switch (Im.it) /* Type defined in stack-c.h */
{
case I_CHAR:
{
char *matrix = Im.D;
char *tmp_matrix = (char *)istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortchar) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_INT32:
{
int *matrix = Im.D;
int *tmp_matrix = istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortint) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_UCHAR:
{
unsigned char *matrix = Im.D;
unsigned char *tmp_matrix = (unsigned char *)istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortuchar) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_INT16:
{
short *matrix = Im.D;
short *tmp_matrix = (short *)istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortshort) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_UINT16:
{
unsigned short *matrix = Im.D;
unsigned short *tmp_matrix = (short *)istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortushort) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_UINT32:
{
unsigned int *matrix = Im.D;
unsigned int *tmp_matrix = (unsigned int *)istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortuint) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
default:
if (indices)
{
FREE(indices);
indices = NULL;
}
Scierror(999, _("%s: Wrong type for input argument #%d: Unknown type.\n"), fname, 1);
return 0;
}
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
if (!CreateVarFromPtrNoCheck(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &ind_m1, &ind_n1, &indices))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(2) = Rhs + 2;
}
if (indices)
{
FREE(indices);
indices = NULL;
}
PutLhsVar();
}
break;
case sci_strings:
{
C2F(gsorts) (S, indices, &iflag, &m1, &n1, typex, iord);
if (!CreateVarFromPtrNoCheck(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, S))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
if (!CreateVarFromPtrNoCheck(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &ind_m1, &ind_n1, &indices))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(2) = Rhs + 2;
}
if (indices)
{
FREE(indices);
indices = NULL;
}
freeArrayOfString(S, m1 * n1);
PutLhsVar();
}
break;
default:
if (indices)
{
FREE(indices);
indices = NULL;
}
Scierror(999, _("%s: Wrong type for input argument #%d.\n"), fname, 1);
return 0;
break;
}
return 0;
}
/*------------------------------------------------------------------------*/
int sci_plot2d(char* fname, void *pvApiCtx)
{
SciErr sciErr;
int* piAddrl1 = NULL;
double* l1 = NULL;
int* piAddrl2 = NULL;
double* l2 = NULL;
double* lt = NULL;
int iTypel1 = 0;
int iTypel2 = 0;
int lw = 0;
int m1 = 0, n1 = 0, m2 = 0, n2 = 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;
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];
BOOL freeStrf = FALSE;
rhs_opts opts[] =
{
{ -1, "axesflag", -1, 0, 0, NULL},
{ -1, "frameflag", -1, 0, 0, NULL},
{ -1, "leg", -1, 0, 0, NULL},
{ -1, "logflag", -1, 0, 0, NULL},
{ -1, "nax", -1, 0, 0, NULL},
{ -1, "rect", -1, 0, 0, NULL},
{ -1, "strf", -1, 0, 0, NULL},
{ -1, "style", -1, 0, 0, NULL},
{ -1, NULL, -1, 0, 0, NULL}
};
if (nbInputArgument(pvApiCtx) == 0)
{
sci_demo(fname, pvApiCtx);
return 0;
}
CheckInputArgument(pvApiCtx, 1, 9);
iskip = 0;
if (getOptionals(pvApiCtx, fname, opts) == 0)
{
ReturnArguments(pvApiCtx);
return 0;
}
if (checkInputArgumentType(pvApiCtx, 1, sci_strings))
{
/* logflags */
GetLogflags(pvApiCtx, fname, 1, opts, &logFlags);
iskip = 1;
}
if (FirstOpt(pvApiCtx) == 2 + iskip) /** plot2d([loglags,] y, <opt_args>); **/
{
sciErr = getVarAddressFromPosition(pvApiCtx, 1 + iskip, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddrl2, &iTypel2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// the argument can be a matrix of doubles or other
// If it is not a matrix of doubles, call overload
if (iTypel2 == sci_matrix)
{
// Retrieve a matrix of double at position 1 + iskip.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrl2, &m2, &n2, &l2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1 + iskip);
return 1;
}
}
else
{
OverLoad(1);
return 0;
}
if (m2 == 1 && n2 > 1)
{
m2 = n2;
n2 = 1;
}
m1 = m2;
n1 = n2;
sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, m1, n1, &l1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
for (i = 0; i < m2 ; ++i)
{
for (j = 0 ; j < n2 ; ++j)
{
*(l1 + i + m2 * j) = (double) i + 1;
}
}
}
else if (FirstOpt(pvApiCtx) >= 3 + iskip) /** plot2d([loglags,] x, y[, style [,...]]); **/
{
/* x */
sciErr = getVarAddressFromPosition(pvApiCtx, 1 + iskip, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddrl1, &iTypel1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// x can be a matrix of doubles or other
// If x is not a matrix of doubles, call overload
if (iTypel1 == sci_matrix)
{
// Retrieve a matrix of double at position 1 + iskip.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrl1, &m1, &n1, &l1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1 + iskip);
return 1;
}
}
else
{
OverLoad(1);
return 0;
}
/* y */
sciErr = getVarAddressFromPosition(pvApiCtx, 2 + iskip, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddrl2, &iTypel2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// y can be a matrix of doubles or other
// If y is not a matrix of doubles, call overload
if (iTypel2 == sci_matrix)
{
// Retrieve a matrix of double at position 1 + iskip.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrl2, &m2, &n2, &l2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 2 + iskip);
return 1;
}
}
else
{
OverLoad(2);
return 0;
}
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
if (!test)
{
Scierror(999, _("%s: Wrong size for input arguments: Incompatible sizes.\n"), fname);
return 1;
}
if (m1 * n1 == 0)
{
/* default x=1:n */
sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, m2, n2, <);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
if (m2 == 1 && n2 > 1)
{
m2 = n2;
n2 = 1;
}
for (i = 0; i < m2 ; ++i)
{
for (j = 0 ; j < n2 ; ++j)
{
*(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 */
sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, m2, n2, <);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
for (i = 0; i < m2 ; ++i)
{
for (j = 0 ; j < n2 ; ++j)
{
*(lt + i + m2 * j) = *(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 */
sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, m1, n2, <);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
for (j = 0 ; j < n2 ; ++j)
{
lt[j] = *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(pvApiCtx, fname, 3 + iskip, n1, opts, &style);
GetStrf(pvApiCtx, fname, 4 + iskip, opts, &strf);
GetLegend(pvApiCtx, fname, 5 + iskip, opts, &legend);
GetRect(pvApiCtx, fname, 6 + iskip, opts, &rect);
GetNax(pvApiCtx, 7 + iskip, opts, &nax, &flagNax);
if (iskip == 0)
{
GetLogflags(pvApiCtx, fname, 8, opts, &logFlags);
}
freeStrf = !isDefStrf(strf);
// Check strf [0-1][0-8][0-5]
if (!isDefStrf(strf) && (strlen(strf) != 3 || strf[0] < '0' || strf[0] > '1' || strf[1] < '0' || strf[1] > '8' || strf[2] < '0' || strf[2] > '5'))
{
Scierror(999, _("%s: Wrong value for strf option: %s.\n"), fname, strf);
if (freeStrf)
{
freeAllocatedSingleString(strf);
}
return -1;
}
if (isDefStrf(strf))
{
strcpy(strfl, DEFSTRFN);
strf = strfl;
if (!isDefRect(rect))
{
strfl[1] = '7';
}
if (!isDefLegend(legend))
{
strfl[0] = '1';
}
GetOptionalIntArg(pvApiCtx, fname, 9, "frameflag", &frame, 1, opts);
if (frame != &frame_def)
{
if (*frame >= 0 && *frame <= 8)
{
strfl[1] = (char)(*frame + 48);
}
else
{
Scierror(999, _("%s: Wrong value for frameflag option.\n"), fname);
if (freeStrf)
{
freeAllocatedSingleString(strf);
}
return -1;
}
}
GetOptionalIntArg(pvApiCtx, fname, 9, "axesflag", &axes, 1, opts);
if (axes != &axes_def)
{
if ((*axes >= 0 && *axes <= 5) || *axes == 9)
{
strfl[2] = (char)(*axes + 48);
}
else
{
Scierror(999, _("%s: Wrong value for axesflag option.\n"), fname);
if (freeStrf)
{
freeAllocatedSingleString(strf);
}
return -1;
}
}
}
/* 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])
{
if (freeStrf)
{
freeAllocatedSingleString(strf);
}
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 */
{
if (freeStrf)
{
freeAllocatedSingleString(strf);
}
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 */
{
if (freeStrf)
{
freeAllocatedSingleString(strf);
}
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' :
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((l1), size_x) <= 0.0)
{
if (freeStrf)
{
freeAllocatedSingleString(strf);
}
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((l2), size_y) <= 0.0)
{
if (freeStrf)
{
freeAllocatedSingleString(strf);
}
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, (l1), (l2), &n1, &m1, style, strf, legend, rect, nax, flagNax);
// Allocated by sciGetStyle (get_style_arg function in GetCommandArg.c)
FREE(style);
if (freeStrf)
{
freeAllocatedSingleString(strf);
}
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_msprintf(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int iType = 0;
int *piAddressVarOne = NULL;
char *ptrFormat = NULL;
int K = 0;
int i = 0;
int lenghtFormat = 0;
int NumberPercent = 0;
int NumberCols = 0;
int nmax = 0;
int cat_to_last = 0;
int ll = 0;
char **pStrs = NULL;
char **pOutputStrings = NULL;
char *pStrTmp = NULL;
char *pStrTmp1 = NULL;
int lcount = 0;
int rval = 0;
int blk = 200;
int k = 0;
int mOut = 0;
int nOut = 0;
int lenghtSplitChar = (int)strlen(SPLIT_ON_CR_IN_FORMAT);
Nbvars = 0;
CheckRhs(1, 1000);
CheckLhs(0, 1);
for (K = 2; K <= Rhs; K++)
{
int iTypeK = 0;
int *piAddressVarK = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, K, &piAddressVarK);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarK, &iTypeK);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if ( (iTypeK != sci_matrix) && (iTypeK != sci_strings) )
{
OverLoad(K);
return 0;
}
}
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarOne, &iType);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (checkVarDimension(pvApiCtx, piAddressVarOne, 1, 1) != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 1);
return 0;
}
if (getAllocatedSingleString(pvApiCtx, piAddressVarOne, &ptrFormat))
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
if (ptrFormat == NULL)
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
else
{
char *ptrFormatTmp = strsub(ptrFormat, CR_IN_FORMAT, SPLIT_ON_CR_IN_FORMAT);
if (ptrFormatTmp)
{
freeAllocatedSingleString(ptrFormat);
ptrFormat = ptrFormatTmp;
}
else
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
lenghtFormat = (int)strlen(ptrFormat);
for (i = 0; i < lenghtFormat; i++)
{
if (ptrFormat[i] == PERCENT_CHAR)
{
NumberPercent++;
if ( (i + 1 < lenghtFormat) && (ptrFormat[i + 1] == PERCENT_CHAR))
{
NumberPercent--;
i++;
}
}
}
if ( (Rhs - 1) > NumberPercent )
{
if (ptrFormat)
{
FREE(ptrFormat);
ptrFormat = NULL;
}
Scierror(999, _("%s: Wrong number of input arguments: at most %d expected.\n"), fname, NumberPercent);
return 0;
}
if ( Rhs > 1 )
{
for ( i = 2 ; i <= Rhs ; i++ )
{
int iRows = 0;
int iCols = 0;
int *piAddressVarI = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVarI);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
sciErr = getVarDimension(pvApiCtx, piAddressVarI, &iRows, &iCols);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
NumberCols += iCols;
}
}
if ( NumberCols != NumberPercent )
{
if (ptrFormat)
{
FREE(ptrFormat);
ptrFormat = NULL;
}
Scierror(999, _("%s: Wrong number of input arguments: data doesn't fit with format.\n"), fname);
return 0;
}
mOut = 0; /* output line counter */
nmax = 0;
pOutputStrings = NULL;
lcount = 1;
cat_to_last = 0;
while (1)
{
if ((rval = do_xxprintf("msprintf", (FILE *) 0, ptrFormat, Rhs, 1, lcount, (char **) &pStrs)) < 0)
{
break;
}
lcount++;
pStrTmp = (char *)pStrs;
if (pStrTmp == NULL)
{
if (ptrFormat)
{
FREE(ptrFormat);
ptrFormat = NULL;
}
Scierror(999, _("%s: Wrong value of input argument #%d: data doesn't fit with format.\n"), fname, 1);
return 0;
}
pStrTmp1 = pStrTmp;
while (*pStrTmp != '\0')
{
if (strncmp(pStrTmp, SPLIT_ON_CR_IN_FORMAT, lenghtSplitChar) == 0)
{
k = (int)(pStrTmp - pStrTmp1);
if (!cat_to_last)
{
/*add a new line */
if (mOut == nmax)
{
nmax += blk;
if (pOutputStrings)
{
pOutputStrings = (char **) REALLOC(pOutputStrings, nmax * sizeof(char **));
}
else
{
pOutputStrings = (char **) MALLOC(nmax * sizeof(char **));
}
if (pOutputStrings == NULL)
{
if (ptrFormat)
{
FREE(ptrFormat);
ptrFormat = NULL;
}
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
}
pOutputStrings[mOut] = (char*)MALLOC((k + 1) * sizeof(char));
if (pOutputStrings[mOut] == NULL)
{
if (ptrFormat)
{
FREE(ptrFormat);
ptrFormat = NULL;
}
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
strncpy(pOutputStrings[mOut], pStrTmp1, k);
pOutputStrings[mOut][k] = EMPTY_CHAR;
mOut++;
}
else
{
/* cat to previous line */
ll = (int)strlen(pOutputStrings[mOut - 1]);
pOutputStrings[mOut - 1] = (char*)REALLOC(pOutputStrings[mOut - 1], (k + 1 + ll) * sizeof(char));
if (pOutputStrings[mOut - 1] == NULL)
{
if (ptrFormat)
{
FREE(ptrFormat);
ptrFormat = NULL;
}
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
strncpy(&(pOutputStrings[mOut - 1][ll]), pStrTmp1, k);
pOutputStrings[mOut - 1][k + ll] = EMPTY_CHAR;
}
k = 0;
pStrTmp += lenghtSplitChar;
pStrTmp1 = pStrTmp;
cat_to_last = 0;
}
else
{
pStrTmp++;
}
}
k = (int)(pStrTmp - pStrTmp1);
if (k > 0)
{
if ((!cat_to_last) || (mOut == 0))
{
/*add a new line */
if (mOut == nmax)
{
nmax += blk;
if (pOutputStrings)
{
pOutputStrings = (char **) REALLOC(pOutputStrings, nmax * sizeof(char **));
if (pOutputStrings == NULL)
{
if (ptrFormat)
{
FREE(ptrFormat);
ptrFormat = NULL;
}
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
}
else
{
pOutputStrings = (char **) MALLOC(nmax * sizeof(char **));
if (pOutputStrings == NULL)
{
if (ptrFormat)
{
FREE(ptrFormat);
ptrFormat = NULL;
}
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
}
}
pOutputStrings[mOut] = (char*) MALLOC((k + 1) * sizeof(char));
if (pOutputStrings[mOut] == NULL)
{
if (ptrFormat)
{
FREE(ptrFormat);
ptrFormat = NULL;
}
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
strncpy(pOutputStrings[mOut], pStrTmp1, k);
pOutputStrings[mOut][k] = EMPTY_CHAR;
mOut++;
}
else
{
/* cat to previous line */
ll = (int)strlen(pOutputStrings[mOut - 1]);
pOutputStrings[mOut - 1] = (char*)REALLOC(pOutputStrings[mOut - 1], (k + 1 + ll) * sizeof(char));
if (pOutputStrings[mOut - 1] == NULL)
{
if (ptrFormat)
{
FREE(ptrFormat);
ptrFormat = NULL;
}
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
strncpy(&(pOutputStrings[mOut - 1][ll]), pStrTmp1, k);
pOutputStrings[mOut - 1][k + ll] = EMPTY_CHAR;
}
}
if (strncmp(pStrTmp - lenghtSplitChar, SPLIT_ON_CR_IN_FORMAT, lenghtSplitChar) != 0)
{
cat_to_last = 1;
}
if (Rhs == 1) break;
}
if (ptrFormat)
{
FREE(ptrFormat);
ptrFormat = NULL;
}
if (rval == RET_BUG) return 0;
/* Create a Scilab String */
nOut = 1;
sciErr = createMatrixOfString(pvApiCtx, Rhs + 1 , mOut, nOut, pOutputStrings);
/* lstr must not be freed */
freeArrayOfString(pOutputStrings, mOut * nOut);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
}
else
{
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_norm(char *fname, void* pvApiCtx)
{
SciErr sciErr;
// Arguments' addresses
int *pAAddr = NULL;
int *pflagAddr = NULL;
// Arguments' values
double *pA = NULL;
char *pflagChar = NULL;
doublecomplex *pAC = NULL;
double flagVal = 0;
// Arguments' properties (type, dimensions, length)
int iLen = 0;
int iType = 0;
int iRows = 0;
int iCols = 0;
// Return value
double ret = 0;
double RowsColsTemp = 0;
int i = 0;
int isMat = 0;
int isComplex = 0;
CheckInputArgument(pvApiCtx, 1, 2);
CheckOutputArgument(pvApiCtx, 1, 1);
// Checking A.
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &pAAddr); // Retrieving A address.
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, pAAddr, &iType); // Retrieving A type.
if (iType != sci_matrix)
{
OverLoad(1);
return 0;
}
if (isVarComplex(pvApiCtx, pAAddr))
{
sciErr = getComplexZMatrixOfDouble(pvApiCtx, pAAddr, &iRows, &iCols, &pAC);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: Real or complex matrix expected.\n"), fname, 1);
return 0;
}
isComplex = 1;
for (i = 0; i < iRows * iCols; ++i) // Checking A for %inf, which is not supported by Lapack.
{
if (la_isinf(pAC[i].r) != 0 || la_isinf(pAC[i].i) != 0 || ISNAN(pAC[i].r) || ISNAN(pAC[i].i))
{
Scierror(264, _("%s: Wrong value for argument #%d: Must not contain NaN or Inf.\n"), fname, 1);
return 0;
}
}
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, pAAddr, &iRows, &iCols, &pA);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: Real or complex matrix expected.\n"), fname, 1);
return 0;
}
for (i = 0 ; i < iRows * iCols ; i++) // Checking A for %inf, which is not supported by Lapack.
{
if (la_isinf(pA[i]) != 0 || ISNAN(pA[i]))
{
Scierror(264, _("%s: Wrong value for argument #%d: Must not contain NaN or Inf.\n"), fname, 1);
return 0;
}
}
}
if (iRows == 0) // A = [] => returning 0.
{
createScalarDouble(pvApiCtx, Rhs + 1, 0);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
if (iRows > 1 && iCols > 1) // If A is a matrix, only 1, 2 and %inf are allowed as second argument.
{
isMat = 1;
}
if (iRows == 1) // If iRows == 1, then transpose A to consider it like a vector.
{
RowsColsTemp = iRows;
iRows = iCols;
iCols = (int)RowsColsTemp;
}
if (Rhs == 1) // One argument => returning norm 2.
{
// Call normP() or normPC().
if (isComplex)
{
ret = normPC(pAC, iRows, iCols, 2); // if A is a complex matrix, call the complex function.
}
else
{
ret = normP(pA, iRows, iCols, 2);
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
// Checking flag.
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &pflagAddr); // Retrieving flag address.
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, pflagAddr, &iType); // Retrieving flag type.
if (iType != sci_strings && iType != sci_matrix)
{
Scierror(999, _("%s: Wrong type for input argument #%d: String or integer expected.\n"), fname, 2);
return 0;
}
if (iType == sci_strings)
{
if (getAllocatedSingleString(pvApiCtx, pflagAddr, &pflagChar)) // Retrieving flag dimensions.
{
Scierror(205, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 2);
return 0;
}
iLen = (int)strlen(pflagChar);
if (iLen != 3 && iLen != 1)
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s, or %s expected.\n"), fname, 2, "i", "inf", "f", "fro");
freeAllocatedSingleString(pflagChar);
return 0;
}
if (strcmp(pflagChar, "inf") != 0 && strcmp(pflagChar, "i") != 0 &&
strcmp(pflagChar, "fro") != 0 && strcmp(pflagChar, "f") != 0) // flag must be = "inf", "i", "fro" or "f".
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s or %s expected.\n"), fname, 2, "i", "inf", "f", "fro");
freeAllocatedSingleString(pflagChar);
return 0;
}
if (isComplex)
{
ret = normStringC(pAC, iRows, iCols, pflagChar); // if A is a complex matrix, call the complex function.
}
else
{
ret = normString(pA, iRows, iCols, pflagChar); // flag is a string => returning the corresponding norm.
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
freeAllocatedSingleString(pflagChar);
return 0;
}
else
{
if (isVarComplex(pvApiCtx, pflagAddr))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real expected.\n"), fname, 2);
return 0;
}
if (getScalarDouble(pvApiCtx, pflagAddr, &flagVal)) // Retrieving flag value & dimensions as a double.
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, 2);
return 0;
}
// Call the norm functions.
if (la_isinf(flagVal) == 1 && flagVal > 0) // flag = %inf
{
if (isComplex)
{
ret = normStringC(pAC, iRows, iCols, "inf"); // if A is a complex matrix, call the complex function.
}
else
{
ret = normString(pA, iRows, iCols, "inf"); // The infinite norm is computed by normString().
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
else
{
if (isMat == 1 && flagVal != 1 && flagVal != 2 && la_isinf(flagVal) == 0)
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s or %s expected.\n"), fname, 2, "1", "2", "inf", "-inf");
return 0;
}
if (isComplex)
{
ret = normPC(pAC, iRows, iCols, flagVal); // if A is a complex matrix, call the complex function.
}
else
{
ret = normP(pA, iRows, iCols, flagVal); // flag is an integer => returning the corresponding norm.
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
}
return 0;
}
/*--------------------------------------------------------------------------
* sciset(choice-name,x1,x2,x3,x4,x5)
* or xset()
*-----------------------------------------------------------*/
int sci_set(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int* piAddr1 = NULL;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
int lw = 0;
int isMatrixOfString = 0;
char* pstProperty = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
//error
return 1;
}
if (isMListType(pvApiCtx, piAddr1) || isTListType(pvApiCtx, piAddr1))
{
OverLoad(1);
return 0;
}
CheckRhs(2, 3);
CheckLhs(0, 1);
if (isDoubleType(pvApiCtx, piAddr1)) /* tclsci handle */
{
/* call "set" for tcl/tk see tclsci/sci_gateway/c/sci_set.c */
OverLoad(1);
return 0;
}
else /* others types */
{
int iRows1 = 0, iCols1 = 0;
int iRows2 = 0, iCols2 = 0;
int iRows3 = 0, iCols3 = 0;
void* _pvData = NULL;
unsigned long hdl;
char *pobjUID = NULL;
int iType1 = 0;
int valueType = 0; /* type of the rhs */
int setStatus = 0;
/* after the call to sciSet get the status : 0 <=> OK, */
/* -1 <=> Error, */
/* 1 <=> nothing done */
/* set or create a graphic window */
sciErr = getVarType(pvApiCtx, piAddr1, &iType1);
if (sciErr.iErr)
{
//error
return 1;
}
switch (iType1)
{
case sci_handles:
/* first is a scalar argument so it's a gset(hdl,"command",[param]) */
/* F.Leray; INFO: case 9 is considered for a matrix of graphic handles */
CheckRhs(3, 3);
if (isScalar(pvApiCtx, piAddr1) == FALSE)
{
OverLoad(1);
return 0;
}
getScalarHandle(pvApiCtx, piAddr1, (long long*)&hdl);
pobjUID = (char*)getObjectFromHandle(hdl);
getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
getAllocatedSingleString(pvApiCtx, piAddr2, &pstProperty);
valueType = getInputArgumentType(pvApiCtx, 3);
getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if ((strcmp(pstProperty, "user_data") == 0) || (stricmp(pstProperty, "userdata") == 0))
{
/* in this case set_user_data_property
* directly uses the third position in the stack
* to get the variable which is to be set in
* the user_data property (any data type is allowed) S. Steer */
_pvData = (void*)piAddr3; /*position in the stack */
iRows3 = -1; /*unused */
iCols3 = -1; /*unused */
valueType = -1;
}
else if (valueType == sci_matrix)
{
getMatrixOfDouble(pvApiCtx, piAddr3, &iRows3, &iCols3, (double**)&_pvData);
}
else if (valueType == sci_boolean)
{
getMatrixOfBoolean(pvApiCtx, piAddr3, &iRows3, &iCols3, (int**)&_pvData);
}
else if (valueType == sci_handles)
{
getMatrixOfHandle(pvApiCtx, piAddr3, &iRows3, &iCols3, (long long**)&_pvData);
}
else if (valueType == sci_strings)
{
if ( strcmp(pstProperty, "tics_labels") != 0 && strcmp(pstProperty, "auto_ticks") != 0 &&
strcmp(pstProperty, "axes_visible") != 0 && strcmp(pstProperty, "axes_reverse") != 0 &&
strcmp(pstProperty, "text") != 0 && stricmp(pstProperty, "string") != 0 &&
stricmp(pstProperty, "tooltipstring") != 0) /* Added for uicontrols */
{
getAllocatedSingleString(pvApiCtx, piAddr3, (char**)&_pvData);
iRows3 = (int)strlen((char*)_pvData);
iCols3 = 1;
}
else
{
isMatrixOfString = 1;
getAllocatedMatrixOfString(pvApiCtx, piAddr3, &iRows3, &iCols3, (char***)&_pvData);
}
}
else if (valueType == sci_list) /* Added for callbacks */
{
iCols3 = 1;
getListItemNumber(pvApiCtx, piAddr3, &iRows3);
_pvData = (void*)piAddr3; /* In this case l3 is the list position in stack */
}
break;
case sci_strings: /* first is a string argument so it's a set("command",[param]) */
CheckRhs(2, 2);
getAllocatedSingleString(pvApiCtx, piAddr1, &pstProperty);
hdl = 0;
pobjUID = NULL;
valueType = getInputArgumentType(pvApiCtx, 2);
getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (valueType == sci_matrix)
{
getMatrixOfDouble(pvApiCtx, piAddr2, &iRows3, &iCols3, (double**)&_pvData);
}
else if (valueType == sci_handles)
{
getMatrixOfHandle(pvApiCtx, piAddr2, &iRows3, &iCols3, (long long**)&_pvData);
}
else if (valueType == sci_strings)
{
if (strcmp(pstProperty, "tics_labels") == 0 || strcmp(pstProperty, "auto_ticks") == 0 ||
strcmp(pstProperty, "axes_visible") == 0 || strcmp(pstProperty, "axes_reverse") == 0 ||
strcmp(pstProperty, "text") == 0)
{
isMatrixOfString = 1;
getAllocatedMatrixOfString(pvApiCtx, piAddr2, &iRows3, &iCols3, (char***)&_pvData);
}
else
{
getAllocatedSingleString(pvApiCtx, piAddr2, (char**)&_pvData);
iRows3 = (int)strlen((char*)_pvData);
iCols3 = 1;
}
}
break;
default:
Scierror(999, _("%s: Wrong type for input argument #%d: String or handle expected.\n"), fname, 1);
return 0;
break;
}
if (hdl != 0)
{
pobjUID = (char*)getObjectFromHandle(hdl);
if (pobjUID == NULL)
{
Scierror(999, _("%s: The handle is not or no more valid.\n"), fname);
return 0;
}
// Only set the property whitout doing anythig else.
//static int sciSet(void* _pvCtx, char *pobjUID, char *marker, void* value, int valueType, int *numrow, int *numcol)
setStatus = callSetProperty(pvApiCtx, pobjUID, _pvData, valueType, iRows3, iCols3, pstProperty);
if (valueType == sci_strings)
{
//free allacted data
if (isMatrixOfString == 1)
{
freeAllocatedMatrixOfString(iRows3, iCols3, (char**)_pvData);
}
else
{
freeAllocatedSingleString((char*)_pvData);
}
}
}
else
{
#define NB_PROPERTIES_SUPPORTED 7
/* No object specified */
/* ONLY supported properties are */
/* 'current_entity' */
/* 'hdl' */
/* 'current_figure' */
/* 'current_axes' */
/* 'default_values' */
/* 'figure_style' for compatibility but do nothing */
/* others values must return a error */
char *propertiesSupported[NB_PROPERTIES_SUPPORTED] = { "current_entity",
"hdl",
"current_figure",
"current_axes",
"figure_style",
"default_values",
"auto_clear"
};
int i = 0;
int iPropertyFound = 0;
for (i = 0; i < NB_PROPERTIES_SUPPORTED; i++)
{
if (strcmp(propertiesSupported[i], pstProperty) == 0)
{
iPropertyFound = 1;
}
}
if (iPropertyFound)
{
// we do nothing with "figure_style" "new" (to remove in 5.4)
int bDoSet = ((isMatrixOfString) && (strcmp(pstProperty, "figure_style") == 0) && (strcmp(((char**)_pvData)[0], "new") == 0)) != 1;
if (bDoSet)
{
setStatus = callSetProperty(pvApiCtx, NULL, _pvData, valueType, iRows3, iCols3, pstProperty);
if (valueType == sci_strings)
{
//free allocated data
if (isMatrixOfString == 1)
{
freeAllocatedMatrixOfString(iRows3, iCols3, (char**)_pvData);
}
else
{
freeAllocatedSingleString((char*)_pvData);
}
}
}
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: a valid property expected.\n"), fname, 1);
if (isMatrixOfString)
{
freeArrayOfString((char **)_pvData, iRows3 * iCols3);
}
return 0;
}
}
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_gsort(char *fname, unsigned long fname_len)
{
char iord[2];
char typex[10];
SciIntMat Im;
int Type = 0;
char **S = NULL;
int m1 = 0, n1 = 0, l1 = 0;
int m2 = 0, n2 = 0, l2 = 0;
int m3 = 0, n3 = 0, l3 = 0;
int ind_m1 = 0, ind_n1 = 0;
int *indices = NULL;
int iflag = 0;
int i;
iord[0] = DECREASE_COMMAND;
iord[1] = '\0';
typex[0] = GLOBAL_SORT;
typex[1] = '\0';
Rhs = Max(0, Rhs);
CheckRhs(1, 3);
CheckLhs(1, 2);
if (Rhs >= 1)
{
Type = VarType(1);
switch (Type)
{
case sci_strings:
GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &S);
break;
case sci_matrix:
{
#define COMPLEX 1
int *header = NULL;
int Cmplx = 0;
header = (int *)GetData(1);
Cmplx = header[3];
if (Cmplx == COMPLEX)
{
return gsort_complex(fname, typex, iord);
}
else
{
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
if ((m1 * n1) == 0) /* [] returns [] */
{
int m = 0, n = 0, l = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
LhsVar(2) = Rhs + 2;
}
PutLhsVar();
return 0;
}
}
}
break;
case sci_ints:
GetRhsVar(1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &Im);
break;
case sci_sparse:
default:
OverLoad(1);
return 0;
break;
}
}
if (Rhs == 3)
{
GetRhsVar(3, STRING_DATATYPE, &m3, &n3, &l3);
CheckLength(3, m3, 1);
if ((*cstk(l3) != INCREASE_COMMAND) && (*cstk(l3) != DECREASE_COMMAND))
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, 3, "i", "d");
return 0;
}
iord[0] = *cstk(l3);
}
if (Rhs >= 2)
{
char c;
GetRhsVar(2, STRING_DATATYPE, &m2, &n2, &l2);
if (m2 == 0)
{
Scierror(999, _("%s: Wrong size for input argument #%d: Non-empty string expected.\n"), fname, 2);
return 0;
}
c = *cstk(l2);
if ((c != ROW_SORT) && (c != COLUMN_SORT) && (c != GLOBAL_SORT) && (c != LIST_SORT))
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s', '%s', '%s' or '%s' expected.\n"), fname, 2, "r", "c", "g", "lr",
"lc");
return 0;
}
strcpy(typex, cstk(l2));
}
if (typex[0] == LIST_SORT)
{
if (typex[1] == ROW_SORT)
{
ind_m1 = m1;
ind_n1 = 1;
if (ind_m1 != 0)
indices = (int *)MALLOC(sizeof(int) * (ind_m1)); /* Only return in row */
}
else if (typex[1] == COLUMN_SORT)
{
ind_m1 = 1;
ind_n1 = n1;
if (ind_n1 != 0)
indices = (int *)MALLOC(sizeof(int) * (ind_n1)); /*Only return in col */
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d.\n"), fname, 2);
return 0;
}
}
else
{
ind_m1 = m1;
ind_n1 = n1;
if (ind_m1 * ind_n1 != 0)
indices = (int *)MALLOC(sizeof(int) * (ind_m1 * ind_n1)); /* return a matrix */
}
if (Lhs == 2)
iflag = 1;
else
iflag = 0;
switch (Type)
{
case sci_matrix:
{
if (m1 * n1 != 0)
{
int lr;
double *matrix = stk(l1);
double *tmp_matrix = NULL;
/* next CreateVar and corresponding copy not needed if arg1 is not passed by reference */
if (!CreateVarNoCheck(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lr))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
tmp_matrix = stk(lr);
for (i = 0; i < m1 * n1; i++)
tmp_matrix[i] = matrix[i];
C2F(gsortd) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
if (!CreateVarFromPtrNoCheck(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &ind_m1, &ind_n1, &indices))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(2) = Rhs + 2;
}
if (indices)
{
FREE(indices);
indices = NULL;
}
PutLhsVar();
}
}
break;
case sci_ints:
{
int lr;
lr = Im.it;
/* next CreateVar and corresponding copy not needed if arg1 is not passed by reference */
if (!CreateVarNoCheck(Rhs + 1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &lr))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
switch (Im.it) /* Type defined in stack-c.h */
{
case I_CHAR:
{
char *matrix = Im.D;
char *tmp_matrix = (char *)istk(lr);
for (i = 0; i < m1 * n1; i++)
tmp_matrix[i] = matrix[i];
C2F(gsortchar) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_INT32:
{
int *matrix = Im.D;
int *tmp_matrix = istk(lr);
for (i = 0; i < m1 * n1; i++)
tmp_matrix[i] = matrix[i];
C2F(gsortint) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_UCHAR:
{
unsigned char *matrix = Im.D;
unsigned char *tmp_matrix = (unsigned char *)istk(lr);
for (i = 0; i < m1 * n1; i++)
tmp_matrix[i] = matrix[i];
C2F(gsortuchar) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_INT16:
{
short *matrix = Im.D;
short *tmp_matrix = (short *)istk(lr);
for (i = 0; i < m1 * n1; i++)
tmp_matrix[i] = matrix[i];
C2F(gsortshort) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_UINT16:
{
unsigned short *matrix = Im.D;
unsigned short *tmp_matrix = (short *)istk(lr);
for (i = 0; i < m1 * n1; i++)
tmp_matrix[i] = matrix[i];
C2F(gsortushort) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_UINT32:
{
unsigned int *matrix = Im.D;
unsigned int *tmp_matrix = (unsigned int *)istk(lr);
for (i = 0; i < m1 * n1; i++)
tmp_matrix[i] = matrix[i];
C2F(gsortuint) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
default:
if (indices)
{
FREE(indices);
indices = NULL;
}
Scierror(999, _("%s: Wrong type for input argument #%d: Unknown type.\n"), fname, 1);
return 0;
}
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
if (!CreateVarFromPtrNoCheck(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &ind_m1, &ind_n1, &indices))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(2) = Rhs + 2;
}
if (indices)
{
FREE(indices);
indices = NULL;
}
PutLhsVar();
}
break;
case sci_strings:
{
C2F(gsorts) (S, indices, &iflag, &m1, &n1, typex, iord);
if (!CreateVarFromPtrNoCheck(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, S))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
if (!CreateVarFromPtrNoCheck(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &ind_m1, &ind_n1, &indices))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(2) = Rhs + 2;
}
if (indices)
{
FREE(indices);
indices = NULL;
}
freeArrayOfString(S, m1 * n1);
PutLhsVar();
}
break;
default:
if (indices)
{
FREE(indices);
indices = NULL;
}
Scierror(999, _("%s: Wrong type for input argument #%d.\n"), fname, 1);
return 0;
break;
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_get(char *fname, void *pvApiCtx)
{
SciErr sciErr;
int* piAddrl1 = NULL;
long long* l1 = NULL;
int* piAddrl2 = NULL;
char* l2 = NULL;
int m1 = 0, n1 = 0;
long hdl = 0;
int lw = 0;
int iObjUID = 0;
int status = SET_PROPERTY_ERROR;
CheckInputArgument(pvApiCtx, 1, 2);
CheckOutputArgument(pvApiCtx, 0, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isMListType(pvApiCtx, piAddrl1) || isTListType(pvApiCtx, piAddrl1))
{
OverLoad(1);
return 0;
}
/*
* The first input argument can be an ID or a marker (in this case, get returns the value of the current object */
switch (getInputArgumentType(pvApiCtx, 1))
{
case sci_matrix: //console handle
{
double dbll1 = 0;
if (isScalar(pvApiCtx, piAddrl1) == 0)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getScalarDouble(pvApiCtx, piAddrl1, &dbll1))
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
if ((int)dbll1 == 0) /* Console property */
{
int* piAddrstkAdr = NULL;
char *stkAdr = NULL;
if (nbInputArgument(pvApiCtx) == 1)
{
if (sciReturnHandle(getHandle(getConsoleIdentifier())) != 0) /* Get Console handle */
{
ReturnArguments(pvApiCtx);
return 0;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
CheckInputArgument(pvApiCtx, 2, 2);
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrstkAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of string at position 2.
if (getAllocatedSingleString(pvApiCtx, piAddrstkAdr, &stkAdr))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
if (GetScreenProperty(pvApiCtx, stkAdr) != SET_PROPERTY_SUCCEED)
{
Scierror(999, _("%s: Could not read property '%s' for console object.\n"), "get", stkAdr[0]);
freeAllocatedSingleString(stkAdr);
return 1;
}
freeAllocatedSingleString(stkAdr);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
return 0;
break;
}
case sci_handles: /* scalar argument (hdl + string) */
CheckInputArgument(pvApiCtx, 1, 2);
// Retrieve a matrix of handle at position 1.
sciErr = getMatrixOfHandle(pvApiCtx, piAddrl1, &m1, &n1, &l1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for input argument #%d: Handle matrix expected.\n"), fname, 1);
return 1;
}
if (m1 != 1 || n1 != 1)
{
//lw = 1 + nbArgumentOnStack(pvApiCtx) - nbInputArgument(pvApiCtx);
OverLoad(1);
return 0;
}
if (nbInputArgument(pvApiCtx) == 1)
{
//get path from handle
int uic = getObjectFromHandle((long) * l1);
char* path = get_path(uic);
if (path[0] == '\0')
{
Scierror(999, _("%s: Unable to get useful path from this handle.\n"), fname);
return 1;
}
createSingleString(pvApiCtx, nbInputArgument(pvApiCtx) + 1, path);
FREE(path);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isScalar(pvApiCtx, piAddrl2) == 0 || isStringType(pvApiCtx, piAddrl2) == 0)
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
// Retrieve a matrix of double at position 2.
if (getAllocatedSingleString(pvApiCtx, piAddrl2, &l2))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
hdl = (long) * l1; /* on recupere le pointeur d'objet par le handle */
break;
case sci_strings: /* string argument (string) */
{
char* pstFirst = NULL;
CheckInputArgument(pvApiCtx, 1, 2);
if (isScalar(pvApiCtx, piAddrl1) == 0)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getAllocatedSingleString(pvApiCtx, piAddrl1, &pstFirst))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 1);
return 1;
}
if (strcmp(pstFirst, "default_figure") == 0 ||
strcmp(pstFirst, "default_axes") == 0 ||
strcmp(pstFirst, "current_figure") == 0 ||
strcmp(pstFirst, "current_axes") == 0 ||
strcmp(pstFirst, "current_entity") == 0 ||
strcmp(pstFirst, "hdl") == 0 ||
strcmp(pstFirst, "figures_id") == 0)
{
hdl = 0;
l2 = pstFirst;
}
else
{
int uid = search_path(pstFirst);
if (uid != 0)
{
freeAllocatedSingleString(pstFirst);
hdl = getHandle(uid);
if (nbInputArgument(pvApiCtx) == 1)
{
createScalarHandle(pvApiCtx, nbInputArgument(pvApiCtx) + 1, hdl);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isScalar(pvApiCtx, piAddrl2) == 0 || isStringType(pvApiCtx, piAddrl2) == 0)
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddrl2, &l2))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
}
else
{
createEmptyMatrix(pvApiCtx, nbInputArgument(pvApiCtx) + 1);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
}
break;
}
default:
//lw = 1 + nbArgumentOnStack(pvApiCtx) - nbInputArgument(pvApiCtx);
OverLoad(1);
return 0;
break;
}
/* (l2) est la commande, l3 l'indice sur les parametres de la commande */
CheckOutputArgument(pvApiCtx, 0, 1);
if (hdl == 0)
{
/* No handle specified */
if (callGetProperty(pvApiCtx, 0, (l2)) != 0)
{
/* An error has occurred */
freeAllocatedSingleString(l2);
ReturnArguments(pvApiCtx);
return 0;
}
}
else
{
iObjUID = getObjectFromHandle(hdl);
if (iObjUID != 0)
{
if (callGetProperty(pvApiCtx, iObjUID, (l2)) != 0)
{
/* An error has occurred */
freeAllocatedSingleString(l2);
ReturnArguments(pvApiCtx);
return 0;
}
}
else
{
Scierror(999, _("%s: The handle is not or no more valid.\n"), fname);
freeAllocatedSingleString(l2);
return 0;
}
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
freeAllocatedSingleString(l2);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_uicontrol(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int nbRow = 0, nbCol = 0, k = 0;
int setStatus = SET_PROPERTY_SUCCEED;
int PARENT_NOT_FOUND = -2;
int NOT_FOUND = -1;
int inputIndex = 0, beginIndex = 0;
char *propertyName = NULL;
char *styleProperty = NULL;
int iPropertiesCount = sizeof(propertiesNames) / sizeof(char**);
unsigned long GraphicHandle = 0;
int found = 0; /* Does the property exists ? */
int *propertiesValuesIndices = NULL;
int iParentType = -1;
int *piParentType = &iParentType;
int iParentStyle = -1;
int *piParentStyle = &iParentStyle;
int iParentUID = 0;
int iUicontrol = 0;
int iCurrentFigure = 0;
CheckOutputArgument(pvApiCtx, 0, 1);
//init properties index
init_property_index();
if (nbInputArgument(pvApiCtx) == 0)
{
/* Create a pushbutton in current figure */
/* Create a new pushbutton */
GraphicHandle = getHandle(CreateUIControl(NULL));
/* Set current figure as parent */
iCurrentFigure = getCurrentFigure();
if (iCurrentFigure == 0)
{
iCurrentFigure = createNewFigureWithAxes();
}
iUicontrol = getObjectFromHandle(GraphicHandle);
setGraphicObjectRelationship(iCurrentFigure, iUicontrol);
}
else if (nbInputArgument(pvApiCtx) == 1)
{
/* Create a pushbutton in figure given as parameter */
/* Or give focus to the uicontrol given as parameter */
int* piAddr = NULL;
int iType = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (isHandleType(pvApiCtx, piAddr) == FALSE && isStringType(pvApiCtx, piAddr) == FALSE)
{
OverLoad(1);
return FALSE;
}
#if 0 // Allow XML loading
else if (isStringType(pvApiCtx, piAddr))
{
char* pstXmlfile = NULL;
char* pstExpandedPath = NULL;
if (isScalar(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, 1);
return FALSE;
}
if (getAllocatedSingleString(pvApiCtx, piAddr, &pstXmlfile))
{
freeAllocatedSingleString(pstXmlfile);
Scierror(999, _("%s: No more memory.\n"), fname);
return FALSE;
}
pstExpandedPath = expandPathVariable(pstXmlfile);
freeAllocatedSingleString(pstXmlfile);
iUicontrol = xmlload(pstExpandedPath);
if (iUicontrol < 1)
{
Scierror(999, _("%s: can not read file %s.\n"), fname, pstExpandedPath);
FREE(pstExpandedPath);
return 0;
}
FREE(pstExpandedPath);
GraphicHandle = getHandle(iUicontrol);
/* Create return variable */
if (createScalarHandle(pvApiCtx, nbInputArgument(pvApiCtx) + 1, GraphicHandle))
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return TRUE;
}
#endif // Allow XML loading
else /* Get parent ID */
{
int* piAddr = NULL;
long long hParent = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isScalar(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A graphic handle expected.\n"), fname, 1);
return FALSE;
}
if (getScalarHandle(pvApiCtx, piAddr, &hParent))
{
Scierror(202, _("%s: Wrong type for input argument #%d: Handle matrix expected.\n"), fname, 1);
return 1;
}
iParentUID = getObjectFromHandle((long)hParent);
if (iParentUID != 0)
{
getGraphicObjectProperty(iParentUID, __GO_TYPE__, jni_int, (void **)&piParentType);
if (iParentType == __GO_UICONTROL__) /* Focus management */
{
GraphicHandle = (unsigned long)hParent;
requestFocus(iParentUID);
}
else if (iParentType == __GO_FIGURE__ || iParentType == __GO_UIMENU__) /* PushButton creation */
{
/* Create a new pushbutton */
GraphicHandle = getHandle(CreateUIControl(NULL));
iUicontrol = getObjectFromHandle(GraphicHandle);
/* First parameter is the parent */
setGraphicObjectRelationship(iParentUID, iUicontrol);
setStatus = callSetProperty(pvApiCtx, iUicontrol, &hParent, sci_handles, 1, 1, (char*)propertiesNames[parent_property]);
if (setStatus == SET_PROPERTY_ERROR)
{
Scierror(999, _("%s: Could not set property '%s'.\n"), fname, propertyName);
return FALSE;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s', '%s' or '%s' handle expected.\n"), fname, 1, "Uicontrol",
"Figure", "Uimenu");
return FALSE;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s', '%s' or '%s' handle expected.\n"), fname, 1, "Uicontrol", "Figure",
"Uimenu");
return FALSE;
}
}
}
else
{
if (!checkInputArgumentType(pvApiCtx, 1, sci_handles) && !checkInputArgumentType(pvApiCtx, 1, sci_strings))
{
OverLoad(1);
return FALSE;
}
/* Allocate memory to store the position of properties in uicontrol call */
if ((propertiesValuesIndices = (int*)MALLOC(sizeof(int) * iPropertiesCount)) == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return FALSE;
}
/* Init all positions to NOT_FOUND */
for (inputIndex = 0; inputIndex < iPropertiesCount; inputIndex++)
{
propertiesValuesIndices[inputIndex] = NOT_FOUND; /* Property initialized as not found */
}
/**
* Odd number of input arguments
* First input is the parent ID
* All event inputs are property names
* All odd (except first) inputs are property values
*/
if (nbInputArgument(pvApiCtx) % 2 == 1)
{
if ((!checkInputArgumentType(pvApiCtx, 1, sci_handles)))
{
if ((checkInputArgumentType(pvApiCtx, 1, sci_matrix)))
{
int* piAddr = NULL;
double dblValue = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isScalar(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A graphic handle expected.\n"), fname, 1);
return FALSE;
}
if (getScalarDouble(pvApiCtx, piAddr, &dblValue))
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
iParentUID = getFigureFromIndex((int)dblValue);
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s' or a '%s' handle expected.\n"), fname, 1, "Figure",
"Frame uicontrol");
return FALSE;
}
}
else /* Get parent ID */
{
int* piAddr = NULL;
long long hParent = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isScalar(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A '%s' or a '%s' handle expected.\n"), fname, 1, "Figure",
"Frame uicontrol");
return FALSE;
}
if (getScalarHandle(pvApiCtx, piAddr, &hParent))
{
Scierror(202, _("%s: Wrong type for input argument #%d: Handle matrix expected.\n"), fname, 1);
return 1;
}
iParentUID = getObjectFromHandle((long)hParent);
}
if (iParentUID == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s' or a '%s' handle expected.\n"), fname, 1, "Figure",
"Frame uicontrol");
return FALSE;
}
getGraphicObjectProperty(iParentUID, __GO_TYPE__, jni_int, (void **)&piParentType);
if (iParentType != __GO_FIGURE__)
{
getGraphicObjectProperty(iParentUID, __GO_STYLE__, jni_int, (void **)&piParentStyle);
if (iParentType != __GO_UICONTROL__ ||
(iParentStyle != __GO_UI_FRAME__ && iParentStyle != __GO_UI_TAB__ && iParentStyle != __GO_UI_LAYER__))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s' or a '%s' handle expected.\n"), fname, 1, "Figure",
"Frame uicontrol");
return FALSE;
}
}
/* First parameter is the parent */
propertiesValuesIndices[parent_property] = 1;
// First input parameter which is a property name
beginIndex = 2;
}
/**
* Even number of input arguments
* All odd inputs are property names
* All even inputs are property values
*/
else
{
// First input parameter which is a property name
beginIndex = 1;
}
/* Get all properties positions */
for (inputIndex = beginIndex; inputIndex < Rhs; inputIndex = inputIndex + 2)
{
/* Read property name */
if ((!checkInputArgumentType(pvApiCtx, inputIndex, sci_strings)))
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, inputIndex);
return FALSE;
}
else
{
int* piAddr = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, inputIndex, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr, &propertyName))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, inputIndex);
return 1;
}
/* Bug 3031 */
/* We only want to compare propertyName along its length */
/* 'posi' must be matched to 'position' */
found = 0;
for (k = 0; k < iPropertiesCount ; k++)
{
if (strlen(propertyName) <= strlen(propertiesNames[k]))
{
if (strnicmp(propertyName, propertiesNames[k], strlen(propertyName)) == 0)
{
propertiesValuesIndices[k] = inputIndex + 1; /* Position of value for property */
found = 1;
break;
}
}
}
freeAllocatedSingleString(propertyName);
if (found == 0)
{
Scierror(999, _("%s: Unknown property: %s for '%s' handles.\n"), fname, propertyName, "Uicontrol");
return FALSE;
}
}
}
if (propertiesValuesIndices[style_property] != NOT_FOUND) /* Style found */
{
if ((checkInputArgumentType(pvApiCtx, propertiesValuesIndices[style_property], sci_strings)))
{
int* piAddr = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, propertiesValuesIndices[style_property], &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr, &styleProperty))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, propertiesValuesIndices[style_property]);
return 1;
}
if (strcmp(styleProperty, "frame") == 0)
{
//check scrollable property to create a scroll frame instead of normal frame
if (propertiesValuesIndices[scrollable_property] != NOT_FOUND)
{
char* pstScroll = NULL;
int iScroll = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, propertiesValuesIndices[scrollable_property], &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isStringType(pvApiCtx, piAddr) == 0 && isBooleanType(pvApiCtx, piAddr) == 0 && isScalar(pvApiCtx, piAddr) == 0)
{
Scierror(202, _("%s: Wrong type for argument #%d: string or boolean expected.\n"), fname, propertiesValuesIndices[scrollable_property]);
return 1;
}
if (isStringType(pvApiCtx, piAddr))
{
if (getAllocatedSingleString(pvApiCtx, piAddr, &pstScroll))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, propertiesValuesIndices[scrollable_property]);
return 1;
}
if (strcmp(pstScroll, "on") == 0)
{
iScroll = 1;
}
freeAllocatedSingleString(pstScroll);
}
else
{
if (getScalarBoolean(pvApiCtx, piAddr, &iScroll))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, propertiesValuesIndices[scrollable_property]);
return 1;
}
}
if (iScroll)
{
freeAllocatedSingleString(styleProperty);
styleProperty = os_strdup("framescrollable");
}
propertiesValuesIndices[scrollable_property] = NOT_FOUND;
}
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, propertiesValuesIndices[style_property]);
return FALSE;
}
}
/* Create a new uicontrol */
iUicontrol = CreateUIControl(styleProperty);
freeAllocatedSingleString(styleProperty);
if (iUicontrol == 0) /* Error in creation */
{
Scierror(999, _("%s: Could not create 'Uicontrol' handle.\n"), fname);
return FALSE;
}
GraphicHandle = getHandle(iUicontrol);
/* If no parent given then the current figure is the parent */
if (propertiesValuesIndices[parent_property] == NOT_FOUND)
{
/* Set the parent */
iCurrentFigure = getCurrentFigure();
if (iCurrentFigure == 0)
{
iCurrentFigure = createNewFigureWithAxes();
}
propertiesValuesIndices[parent_property] = PARENT_NOT_FOUND;
}
/* Read and set all properties */
for (inputIndex = 1; inputIndex < iPropertiesCount; inputIndex++) /* Style has already been set */
{
if (propertiesValuesIndices[inputIndex] == PARENT_NOT_FOUND)
{
//special case for not specified parent
//but set relationship at the good moment.
setGraphicObjectRelationship(iCurrentFigure, iUicontrol);
}
else if (propertiesValuesIndices[inputIndex] != NOT_FOUND)
{
int* piAddr = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, propertiesValuesIndices[inputIndex], &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (inputIndex == user_data_property || inputIndex == userdata_property) /* User data settings */
{
nbRow = -1;
nbCol = -1;
setStatus = callSetProperty(pvApiCtx, iUicontrol, piAddr, 0, 0, 0, (char*)propertiesNames[inputIndex]);
}
else /* All other properties */
{
/* Read property value */
switch (getInputArgumentType(pvApiCtx, propertiesValuesIndices[inputIndex]))
{
case sci_matrix:
{
double* pdblValue = NULL;
sciErr = getMatrixOfDouble(pvApiCtx, piAddr, &nbRow, &nbCol, &pdblValue);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, propertiesValuesIndices[inputIndex]);
return 1;
}
setStatus = callSetProperty(pvApiCtx, iUicontrol, pdblValue, sci_matrix, nbRow, nbCol, (char*)propertiesNames[inputIndex]);
break;
}
case sci_strings:
/* Index for String & TooltipString properties: Can be more than one character string */
if ((inputIndex == string_property) || (inputIndex == tooltipstring_property))
{
char** pstValue = NULL;
if (getAllocatedMatrixOfString(pvApiCtx, piAddr, &nbRow, &nbCol, &pstValue))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, propertiesValuesIndices[inputIndex]);
return 1;
}
setStatus = callSetProperty(pvApiCtx, iUicontrol, pstValue, sci_strings, nbRow, nbCol, (char*)propertiesNames[inputIndex]);
freeAllocatedMatrixOfString(nbRow, nbCol, pstValue);
}
else
{
char* pstValue = NULL;
if (getAllocatedSingleString(pvApiCtx, piAddr, &pstValue))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, propertiesValuesIndices[inputIndex]);
return 1;
}
nbRow = (int)strlen(pstValue);
nbCol = 1;
setStatus = callSetProperty(pvApiCtx, iUicontrol, pstValue, sci_strings, nbRow, nbCol, (char*)propertiesNames[inputIndex]);
freeAllocatedSingleString(pstValue);
}
break;
case sci_handles:
{
long long* pHandles = NULL;
sciErr = getMatrixOfHandle(pvApiCtx, piAddr, &nbRow, &nbCol, &pHandles);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for input argument #%d: Handle matrix expected.\n"), fname, propertiesValuesIndices[inputIndex]);
return 1;
}
setStatus = callSetProperty(pvApiCtx, iUicontrol, pHandles, sci_handles, nbRow, nbCol, (char*)propertiesNames[inputIndex]);
break;
}
case sci_tlist: //constraints and border
{
setStatus = callSetProperty(pvApiCtx, iUicontrol, piAddr, sci_tlist, 1, 1, (char*)propertiesNames[inputIndex]);
break;
}
default:
setStatus = SET_PROPERTY_ERROR;
break;
}
}
if (setStatus == SET_PROPERTY_ERROR)
{
Scierror(999, _("%s: Could not set property '%s'.\n"), fname, (char*)propertiesNames[inputIndex]);
return FALSE;
}
}
}
}
if (propertiesValuesIndices != NULL
&& (propertiesValuesIndices[sliderstep_property] == NOT_FOUND &&
(propertiesValuesIndices[min_property] != NOT_FOUND || propertiesValuesIndices[max_property] != NOT_FOUND))) /* SliderStep property not set */
{
/* Set SliderStep property to [1/100*(Max-Min) 1/10*(Max-Min)] */
double maxValue = 0;
double* pdblMaxValue = &maxValue;
double minValue = 0;
double* pdblMinValue = &minValue;
double pdblStep[2];
getGraphicObjectProperty(iUicontrol, __GO_UI_MIN__, jni_double, (void**) &pdblMinValue);
getGraphicObjectProperty(iUicontrol, __GO_UI_MAX__, jni_double, (void**) &pdblMaxValue);
pdblStep[0] = 0.01 * (maxValue - minValue);
pdblStep[1] = 0.1 * (maxValue - minValue);
setGraphicObjectProperty(iUicontrol, __GO_UI_SLIDERSTEP__, pdblStep, jni_double_vector, 2);
}
if ((nbInputArgument(pvApiCtx) < 2) || (propertiesValuesIndices[position_property] == NOT_FOUND)) /* Position property not set */
{
double* pdblPosition = NULL;
getGraphicObjectProperty(iUicontrol, __GO_POSITION__, jni_double_vector, (void**) &pdblPosition);
setGraphicObjectProperty(iUicontrol, __GO_POSITION__, pdblPosition, jni_double_vector, 4);
releaseGraphicObjectProperty(__GO_POSITION__, pdblPosition, jni_double_vector, 4);
}
if ((nbInputArgument(pvApiCtx) < 2) || (propertiesValuesIndices[visible_property] == NOT_FOUND)) /* Visible property not set */
{
/* Force the uicontrol to be visible because is invisible by default in the model (See bug #10346) */
int b = (int)TRUE;
setGraphicObjectProperty(iUicontrol, __GO_VISIBLE__, &b, jni_bool, 1);
}
FREE(propertiesValuesIndices);
/* Create return variable */
if (createScalarHandle(pvApiCtx, nbInputArgument(pvApiCtx) + 1, GraphicHandle))
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return TRUE;
}
/*--------------------------------------------------------------------------*/
int C2F(inteig)(char *fname, unsigned long fname_len)
{
int *header1, *header2;
int CmplxA, CmplxB;
int ret;
int Symmetric;
int X;
switch (Rhs)
{
case 1: /* spec(A) */
if (GetType(1) != sci_matrix)
{
OverLoad(1);
return 0;
}
header1 = (int *) GetData(1);
CmplxA = header1[3];
X = 1;
Symmetric = C2F(issymmetric)(&X);
switch (CmplxA)
{
case REAL:
switch (Symmetric)
{
case NO :
ret = sci_dgeev("spec", 4L);
break;
case YES :
ret = sci_dsyev("spec", 4L);
break;
}
break;
case COMPLEX:
switch (Symmetric)
{
case NO :
ret = sci_zgeev("spec", 4L);
break;
case YES:
ret = sci_zheev("spec", 4L);
break;
}
break;
default:
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 1);
break;
} /* end switch (CmplxA) */
break; /* end case 1 */
case 2: /* gspec(A,B) */
if (GetType(1) != sci_matrix)
{
OverLoad(1);
return 0;
}
if (GetType(2) != sci_matrix)
{
OverLoad(2);
return 0;
}
header1 = (int *) GetData(1);
header2 = (int *) GetData(2);
CmplxA = header1[3];
CmplxB = header2[3];
switch (CmplxA)
{
case REAL:
switch (CmplxB)
{
case REAL :
/* A real, Breal */
ret = sci_dggev("gspec", 5L);
break;
case COMPLEX :
/* A real, B complex : complexify A */
X = 1;
C2F(complexify)(&X);
ret = sci_zggev("gspec", 5L);
break;
default:
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 2);
break;
}
break;
case COMPLEX :
switch (CmplxB)
{
case REAL :
/* A complex, B real : complexify B */
X = 2;
C2F(complexify)(&X);
ret = sci_zggev("gspec", 5L);
break;
case COMPLEX :
/* A complex, B complex */
ret = sci_zggev("gspec", 5L);
break;
default:
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 2);
break;
}
break;
default :
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 1);
break;
} /*end switch (CmplxA) */
break;/* end case 2 */
}/* end switch (Rhs) */
return 0;
}
/*--------------------------------------------------------------------------
* sciset(choice-name,x1,x2,x3,x4,x5)
* or xset()
*-----------------------------------------------------------*/
int sci_set(char *fname, void *pvApiCtx)
{
SciErr sciErr;
int i = 0;
int* piAddr1 = NULL;
int isMatrixOfString = 0;
char* pstNewProperty = NULL;
unsigned long hdl;
int iObjUID = 0;
int iType = 0;
int* piType = &iType;
int iSetProperty = 0;
int iRhs = nbInputArgument(pvApiCtx);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
if (isMListType(pvApiCtx, piAddr1) || isTListType(pvApiCtx, piAddr1))
{
OverLoad(1);
return 0;
}
CheckInputArgumentAtLeast(pvApiCtx, 2);
CheckOutputArgument(pvApiCtx, 0, 1);
if (isDoubleType(pvApiCtx, piAddr1)) /* tclsci handle */
{
/* call "set" for tcl/tk see tclsci/sci_gateway/c/sci_set.c */
OverLoad(1);
return 0;
}
if (iRhs == 2)
{
#define NB_PROPERTIES_SUPPORTED 7
/* No object specified */
/* ONLY supported properties are */
/* 'current_entity' */
/* 'hdl' */
/* 'current_figure' */
/* 'current_axes' */
/* 'default_values' */
/* 'figure_style' for compatibility but do nothing */
/* others values must return a error */
char *propertiesSupported[NB_PROPERTIES_SUPPORTED] =
{
"current_entity",
"hdl",
"current_figure",
"current_axes",
"figure_style",
"default_values",
"auto_clear"
};
int iPropertyFound = 0;
int* piAddr2 = NULL;
int iType2 = 0;
int iRows2 = 0;
int iCols2 = 0;
void* pvData = NULL;
char* pstProperty = NULL;
if (isStringType(pvApiCtx, piAddr1) == 0)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, 1);
return 0;
}
if (getAllocatedSingleString(pvApiCtx, piAddr1, &pstProperty))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, 1);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddr2, &iType2);
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 1;
}
switch (iType2)
{
case sci_matrix:
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &iRows2, &iCols2, (double**)&pvData);
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix expected.\n"), fname, 2);
return sciErr.iErr;
}
break;
case sci_handles :
sciErr = getMatrixOfHandle(pvApiCtx, piAddr2, &iRows2, &iCols2, (long long**)&pvData);
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of handle expected.\n"), fname, 3);
return 1;
}
break;
case sci_strings :
if (strcmp(pstProperty, "tics_labels") == 0 || strcmp(pstProperty, "auto_ticks") == 0 ||
strcmp(pstProperty, "axes_visible") == 0 || strcmp(pstProperty, "axes_reverse") == 0 ||
strcmp(pstProperty, "text") == 0 || strcmp(pstProperty, "ticks_format") == 0)
{
isMatrixOfString = 1;
if (getAllocatedMatrixOfString(pvApiCtx, piAddr2, &iRows2, &iCols2, (char***)&pvData))
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Wrong size for input argument #%d: A matrix of string expected.\n"), fname, 2);
return 1;
}
}
else
{
if (getAllocatedSingleString(pvApiCtx, piAddr2, (char**)&pvData))
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, 2);
return 1;
}
iRows2 = (int)strlen((char*)pvData);
iCols2 = 1;
isMatrixOfString = 0;
}
break;
}
for (i = 0; i < NB_PROPERTIES_SUPPORTED; i++)
{
if (strcmp(propertiesSupported[i], pstProperty) == 0)
{
iPropertyFound = 1;
}
}
if (iPropertyFound)
{
callSetProperty(pvApiCtx, 0, pvData, iType2, iRows2, iCols2, pstProperty);
if (iType2 == sci_strings)
{
//free allocated data
if (isMatrixOfString == 1)
{
freeAllocatedMatrixOfString(iRows2, iCols2, (char**)pvData);
}
else
{
freeAllocatedSingleString((char*)pvData);
}
}
}
else
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Wrong value for input argument #%d: a valid property expected.\n"), fname, 1);
if (iType2 == sci_strings)
{
if (isMatrixOfString == 1)
{
freeAllocatedMatrixOfString(iRows2, iCols2, (char**)pvData);
}
else
{
freeAllocatedSingleString((char*)pvData);
}
}
return 0;
}
freeAllocatedSingleString(pstProperty);
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
if (iRhs % 2 != 1)
{
Scierror(999, _("%s: Wrong number of input argument(s) : an odd number is expected.\n"), fname);
return 0;
}
/* after the call to sciSet get the status : 0 <=> OK, */
/* -1 <=> Error, */
/* 1 <=> nothing done */
/* set or create a graphic window */
if (isHandleType(pvApiCtx, piAddr1) == 0 && isStringType(pvApiCtx, piAddr1) == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A handle or a string expected.\n"), fname, 1);
return 0;
}
if (isStringType(pvApiCtx, piAddr1))
{
char* pstPath = NULL;
if (getAllocatedSingleString(pvApiCtx, piAddr1, &pstPath))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, 1);
return 1;
}
iObjUID = search_path(pstPath);
if (iObjUID == 0)
{
Scierror(999, _("%s: Unable to find handle for path %s.\n"), fname, pstPath);
freeAllocatedSingleString(pstPath);
return 1;
}
}
else
{
//matrix of handle are managed by a %h_set
if (isScalar(pvApiCtx, piAddr1) == FALSE)
{
OverLoad(1);
return 0;
}
if (getScalarHandle(pvApiCtx, piAddr1, (long long*)&hdl))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single handle expected.\n"), fname, 1);
return 1;
}
iObjUID = getObjectFromHandle(hdl);
}
if (iObjUID == 0)
{
Scierror(999, _("%s: The handle is not or no more valid.\n"), fname);
return 0;
}
for (i = 1 ; i < iRhs ; i = i + 2)
{
int setStatus = 0;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
int iPos = i + 1;
int isData = 0;
int iRows3 = 0;
int iCols3 = 0;
int iType3 = 0;
void* pvData = NULL;
char* pstProperty = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, iPos, &piAddr2);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, iPos);
return 1;
}
if (isStringType(pvApiCtx, piAddr2) == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, iPos);
return 0;
}
if (getAllocatedSingleString(pvApiCtx, piAddr2, &pstProperty))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, iPos);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, iPos + 1, &piAddr3);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, iPos + 1);
return 1;
}
if ((pstProperty[0] == 'd' || pstProperty[0] == 'D') && stricmp("data", pstProperty) == 0)
{
//send to datamodel
isData = 1;
}
if (stricmp(pstProperty, "user_data") == 0 ||
stricmp(pstProperty, "userdata") == 0 ||
stricmp(pstProperty, "display_function_data") == 0 ||
stricmp(pstProperty, "data") == 0)
{
/* in this case set_user_data_property
* directly uses the third position in the stack
* to get the variable which is to be set in
* the user_data property (any data type is allowed) S. Steer */
pvData = (void*)piAddr3; /*position in the stack */
iRows3 = -1; /*unused */
iCols3 = -1; /*unused */
iType3 = -1;
}
else
{
sciErr = getVarType(pvApiCtx, piAddr3, &iType3);
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, iPos + 1);
return 1;
}
switch (iType3)
{
case sci_matrix :
sciErr = getMatrixOfDouble(pvApiCtx, piAddr3, &iRows3, &iCols3, (double**)&pvData);
break;
case sci_boolean :
sciErr = getMatrixOfBoolean(pvApiCtx, piAddr3, &iRows3, &iCols3, (int**)&pvData);
break;
case sci_handles :
sciErr = getMatrixOfHandle(pvApiCtx, piAddr3, &iRows3, &iCols3, (long long**)&pvData);
break;
case sci_strings :
if (strcmp(pstProperty, "tics_labels") != 0 && strcmp(pstProperty, "auto_ticks") != 0 && strcmp(pstProperty, "tight_limits") != 0 &&
strcmp(pstProperty, "axes_visible") != 0 && strcmp(pstProperty, "axes_reverse") != 0 &&
strcmp(pstProperty, "text") != 0 && stricmp(pstProperty, "string") != 0 &&
stricmp(pstProperty, "tooltipstring") != 0 && stricmp(pstProperty, "ticks_format") != 0) /* Added for uicontrols */
{
if (isScalar(pvApiCtx, piAddr3) == 0)
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, iPos + 1);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr3, (char**)&pvData))
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, iPos + 1);
return 1;
}
iRows3 = (int)strlen((char*)pvData);
iCols3 = 1;
isMatrixOfString = 0;
}
else
{
isMatrixOfString = 1;
getAllocatedMatrixOfString(pvApiCtx, piAddr3, &iRows3, &iCols3, (char***)&pvData);
}
break;
case sci_list :
iCols3 = 1;
sciErr = getListItemNumber(pvApiCtx, piAddr3, &iRows3);
pvData = (void*)piAddr3; /* In this case l3 is the list position in stack */
break;
default :
pvData = (void*)piAddr3; /* In this case l3 is the list position in stack */
break;
}
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, iPos + 1);
return 1;
}
}
setStatus = callSetProperty(pvApiCtx, iObjUID, pvData, iType3, iRows3, iCols3, pstProperty);
if (iType3 == sci_strings)
{
//free allacted data
if (isMatrixOfString == 1)
{
freeAllocatedMatrixOfString(iRows3, iCols3, (char**)pvData);
}
else
{
freeAllocatedSingleString((char*)pvData);
}
}
freeAllocatedSingleString(pstProperty);
}
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_frexp(char *fname, void *pvApiCtx)
{
SciErr sciErr;
int i;
int iRows = 0;
int iCols = 0;
int iType = 0;
int *piAddr = NULL;
double *pdblReal = NULL;
double *pdblCoef = NULL;
double *pdblExp = NULL;
CheckRhs(1, 1);
CheckLhs(2, 2);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddr, &iType);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if (iType != sci_matrix)
{
OverLoad(1);
return 0;
}
if (isVarComplex(pvApiCtx, piAddr))
{
Scierror(999, _("%s: Wrong type for input argument #%d: Real matrix expected.\n"), fname, 1);
return 0;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddr, &iRows, &iCols, &pdblReal);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = allocMatrixOfDouble(pvApiCtx, Rhs + 1, iRows, iCols, &pdblCoef);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = allocMatrixOfDouble(pvApiCtx, Rhs + 2, iRows, iCols, &pdblExp);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
for (i = 0; i < iRows * iCols; i++)
{
pdblCoef[i] = dfrexps(pdblReal[i], &pdblExp[i]);
}
LhsVar(1) = Rhs + 1;
LhsVar(2) = Rhs + 2;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int C2F(intlsq)(char *fname, unsigned long fname_len)
{
int *header1;
int *header2;
int CmplxA;
int Cmplxb;
int ret;
int I2;
/* lsq(A,b) */
if (GetType(1) != sci_matrix)
{
OverLoad(1);
return 0;
}
if (GetType(2) != sci_matrix)
{
OverLoad(2);
return 0;
}
header1 = (int *) GetData(1);
header2 = (int *) GetData(2);
CmplxA = header1[3];
Cmplxb = header2[3];
switch (CmplxA)
{
case REAL:
switch (Cmplxb)
{
case REAL :
/* A real, b real */
ret = C2F(intdgelsy)("lsq", 3L);
break;
case COMPLEX :
/* A real, b complex */
C2F(complexify)((I2 = 1, &I2));
ret = C2F(intzgelsy)("lsq", 3L);
break;
default:
break;
}
return 0;
case COMPLEX :
switch (Cmplxb)
{
case REAL :
/* A complex, b real */
C2F(complexify)((I2 = 2, &I2));
ret = C2F(intzgelsy)("lsq", 3L);
break;
case COMPLEX :
/* A complex, b complex */
ret = C2F(intzgelsy)("lsq", 3L);
break;
default:
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 2);
break;
}
return 0;
break;
default :
Scierror(999, _("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
fname, 1);
return 0;
break;
}
}
