/*--------------------------------------------------------------------------*/
int get_colminmax_arg(char *fname,int pos,rhs_opts opts[], int ** colminmax )
{
int m,n,l,first_opt=FirstOpt(),kopt;
if (pos < first_opt)
{
if (VarType(pos))
{
GetRhsVar(pos,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
CheckLength(pos,m*n,2);
*colminmax=istk(l);
}
else
{
/** global value can be modified **/
int zeros[2] = { 0, 0 } ;
setDefColMinMax( zeros ) ;
*colminmax = getDefColMinMax() ;
}
}
else if ((kopt=FindOpt("colminmax",opts)))
{
GetRhsVar(kopt,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
CheckLength(kopt,m*n,2);
*colminmax=istk(l);
}
else
{
/** global value can be modified **/
int zeros[2] = { 0, 0 } ;
setDefColMinMax( zeros ) ;
*colminmax = getDefColMinMax() ;
}
return 1;
}
/*--------------------------------------------------------------------------*/
static int GetScalarDouble(char *fname, int *prev, int *arg, int narg, int *ic, int ir, double *dval)
{
int mx = 0, nx = 0, lx = 0;
if (*prev != 1)
{
*arg = *arg + 1;
*ic = 1;
*prev = 1;
}
GetRhsVar(*arg, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
if (*ic > nx)
{
*arg = *arg + 1;
if (*arg > narg )
{
return NOT_ENOUGH_ARGS;
}
*ic = 1;
GetRhsVar(*arg, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
}
if (ir > mx)
{
return RET_END;
}
*dval = *(stk(lx + ir - 1 + mx * (*ic - 1)));
*ic = *ic + 1;
return OK;
}
/*--------------------------------------------------------------------------*/
int get_legend_arg(char *fname,int pos,rhs_opts opts[], char ** legend )
{
int m,n,l,first_opt=FirstOpt(),kopt;
if (pos < first_opt)
{
if (VarType(pos)) {
GetRhsVar(pos,STRING_DATATYPE, &m, &n, &l);
*legend = cstk(l);
}
else
{
*legend = getDefLegend() ;
}
}
else if ((kopt=FindOpt("leg",opts))) {
GetRhsVar(kopt,STRING_DATATYPE, &m, &n, &l);
*legend = cstk(l);
}
else
{
*legend = getDefLegend() ;
}
return 1;
}
/*--------------------------------------------------------------------------*/
int sci_exportUI(char * fname, unsigned long fname_len)
{
int iFigureId = 0; // id of the figure to export
int iRows = 0;
int iCols = 0;
size_t stackPointer = 0;
CheckLhs(0, 1);
CheckRhs(1, 1);
if (GetType(1) == sci_handles) // exportUI(figHandle)
{
const char *pstFigureUID = NULL;
int iHandleType = -1;
int *piHandleType = &iHandleType;
int *piFigureId = &iFigureId;
GetRhsVar(1, GRAPHICAL_HANDLE_DATATYPE, &iRows, &iCols, &stackPointer);
if (iRows * iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
}
pstFigureUID = getObjectFromHandle((unsigned long) * (hstk(stackPointer)));
getGraphicObjectProperty(pstFigureUID, __GO_TYPE__, jni_int, (void **)&piHandleType);
if (iHandleType == __GO_FIGURE__)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
return FALSE;
}
getGraphicObjectProperty(pstFigureUID, __GO_ID__, jni_int, (void **)&piFigureId);
}
else if (GetType(1) == sci_matrix) // exportUI(figId)
{
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &iRows, &iCols, &stackPointer);
if (iRows * iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
return FALSE;
}
iFigureId = (int) * (stk(stackPointer));
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
return FALSE;
}
// call the export function
exportUserInterface(iFigureId);
LhsVar(1) = 0;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int get_with_mesh_arg(char *fname,int pos,rhs_opts opts[], BOOL * withMesh)
{
int m,n,l,first_opt=FirstOpt(),kopt;
if (pos < first_opt)
{
if (VarType(pos))
{
GetRhsVar(pos,MATRIX_OF_BOOLEAN_DATATYPE, &m, &n, &l);
CheckLength(pos,m*n,1);
*withMesh = *(istk(l));
}
else
{
/** global value can be modified **/
setDefWithMesh( FALSE );
*withMesh = getDefWithMesh() ;
}
}
else if ((kopt=FindOpt("mesh",opts)))
{
GetRhsVar(kopt,MATRIX_OF_BOOLEAN_DATATYPE, &m, &n, &l);
CheckLength(kopt,m*n,1);
*withMesh = *(istk(l));
}
else
{
/** global value can be modified **/
setDefWithMesh( FALSE );
*withMesh = getDefWithMesh() ;
}
return 1;
}
int sci_exec_if(char *fname)
{
static int l1, m1, n1;
void *p_sci;
static int l2, m2, n2;
static int minrhs=2, maxrhs=2;
static int err;
debug_3 ("[sci_exec_if] ..................... \r\n");
CheckRhs(minrhs,maxrhs);
// example: pfir1
m1=1;
n1=1;
GetRhsVar(1,"p",&m1,&n1,&l1);
// example: SCI_RESET
GetRhsVar(2, "i", &m2, &n2, &l2);
p_sci = (void *) ((unsigned long int) *stk(l1));
sci_exec_ifcpp(p_sci, *(istk(l2)));
if (sci_err) {
sciprint("\n%s:\n info:%d\n",sci_err_msg,sci_info);
Scierror(999,"%s failed err=%d", fname, sci_err);
return 0;
}
debug_3 ("[sci_exec_if] +++++++++++++++++++++ \r\n");
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_xfarcs(char *fname, unsigned long fname_len)
{
int m1 = 0, n1 = 0, l1 = 0;
int m2 = 0, n2 = 0, l2 = 0;
long hdl = 0;
int i = 0;
double angle1 = 0.0;
double angle2 = 0.0;
CheckRhs(1, 2);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
if (m1 != 6)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %s expected.\n"), fname, 1, "(6,n)");
return 0;
}
if (Rhs == 2)
{
GetRhsVar(2, MATRIX_OF_INTEGER_DATATYPE, &m2, &n2, &l2);
CheckVector(2, m2, n2);
if (n1 != m2 * n2)
{
Scierror(999, _("%s: Wrong size for input arguments #%d and #%d.\n"), fname, 1, 2);
return 0;
}
}
else
{
m2 = 1;
n2 = n1;
CreateVar(2, MATRIX_OF_INTEGER_DATATYPE, &m2, &n2, &l2);
for (i = 0; i < n2; ++i)
{
*istk(l2 + i) = i + 1;
}
}
getOrCreateDefaultSubwin();
for (i = 0; i < n1; ++i)
{
angle1 = DEG2RAD(*stk(l1 + (6 * i) + 4) / 64.0);
angle2 = DEG2RAD(*stk(l1 + (6 * i) + 5) / 64.0);
Objarc(&angle1, &angle2, stk(l1 + (6 * i)), stk(l1 + (6 * i) + 1),
stk(l1 + (6 * i) + 2), stk(l1 + (6 * i) + 3), istk(l2 + i), istk(l2 + i), TRUE, FALSE, &hdl);
}
/** Construct Compound and make it current object **/
setCurrentObject(ConstructCompoundSeq(n1));
LhsVar(1) = 0;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_ctree2(char *fname, unsigned long fname_len)
{
int one = 1, ipvec = 0, nvec = 0, mvec = 0, noin = 0, moin = 0, ipoin = 0, noinr = 0, moinr = 0, ipoinr = 0;
int ndep = 0, mdep = 0, ipdep = 0, ndepuptr = 0, mdepuptr = 0, ipdepuptr = 0, ipord = 0, ipok = 0, n = 0, nord = 0;
CheckRhs(5, 5);
CheckLhs(2, 2);
GetRhsVar(1, MATRIX_OF_INTEGER_DATATYPE, &nvec, &mvec, &ipvec);
GetRhsVar(2, MATRIX_OF_INTEGER_DATATYPE, &noin, &moin, &ipoin);
GetRhsVar(3, MATRIX_OF_INTEGER_DATATYPE, &noinr, &moinr, &ipoinr);
GetRhsVar(4, MATRIX_OF_INTEGER_DATATYPE, &ndep, &mdep, &ipdep);
GetRhsVar(5, MATRIX_OF_INTEGER_DATATYPE, &ndepuptr, &mdepuptr, &ipdepuptr);
n = nvec * mvec;
CreateVar(6, MATRIX_OF_INTEGER_DATATYPE, &n, &one, &ipord);
CreateVar(7, MATRIX_OF_INTEGER_DATATYPE, &one, &one, &ipok);
ctree2(istk(ipvec), n, istk(ipdep), istk(ipdepuptr), istk(ipoin), istk(ipoinr), istk(ipord), &nord, istk(ipok));
*istk(iadr(C2F(intersci).iwhere[5]) + 1) = nord;
LhsVar(1) = 6;
LhsVar(2) = 7;
PutLhsVar();
return 0;
}
/*
* hand written interface
* Interface for cdfchn
* Non-central Chi-Square
*/
int cdfchnI(char* fname, unsigned long l)
{
int m1 = 0, n1 = 0, l1 = 0, mDf = 0, nDf = 0, lDf = 0, i = 0;
double *Df = NULL;
Nbvars = 0;
CheckRhs(4, 5);
CheckLhs(1, 2);
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
if ( strcmp(cstk(l1), "PQ") == 0)
{
static int callpos[5] = {3, 4, 0, 1, 2};
GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &mDf, &nDf, &lDf);
Df = stk(lDf);
for (i = 0; i < mDf * nDf; ++i)
if ((int) Df[i] - Df[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 3);
}
CdfBase(fname, 3, 2, callpos, "PQ", _("X,Df and Pnonc"), 1, C2F(cdfchn),
cdfchnErr);
}
else if ( strcmp(cstk(l1), "X") == 0)
{
static int callpos[5] = {2, 3, 4, 0, 1};
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mDf, &nDf, &lDf);
Df = stk(lDf);
for (i = 0; i < mDf * nDf; ++i)
if ((int) Df[i] - Df[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 2);
}
CdfBase(fname, 4, 1, callpos, "X", _("Df,Pnonc,P and Q"), 2, C2F(cdfchn),
cdfchnErr);
}
else if ( strcmp(cstk(l1), "Df") == 0)
{
static int callpos[5] = {1, 2, 3, 4, 0};
CdfBase(fname, 4, 1, callpos, "Df", _("Pnonc,P,Q and X"), 3, C2F(cdfchn),
cdfchnErr);
}
else if ( strcmp(cstk(l1), "Pnonc") == 0)
{
static int callpos[5] = {0, 1, 2, 3, 4};
GetRhsVar(5, MATRIX_OF_DOUBLE_DATATYPE, &mDf, &nDf, &lDf);
Df = stk(lDf);
for (i = 0; i < mDf * nDf; ++i)
if ((int) Df[i] - Df[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 5);
}
CdfBase(fname, 4, 1, callpos, "Pnonc", _("P,Q,X and Df"), 4, C2F(cdfchn),
cdfchnErr);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s', '%s' or '%s' expected.\n"), fname, 1, "PQ", "X", "Df", "Pnonc");
}
return 0;
}
int empty(void)
{
int m, n;
int k;
int m1, n1, p1;
int m2, n2, p2;
int NZMAX = 1;
int jc = 5;
int ir;
int *header;
double *value;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &p1);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &p2);
m = (int) * stk(p1);
n = (int) * stk(p2);
CreateData(3, (6 + n + 1)*sizeof(int) + sizeof(double));
header = (int *) GetData(3);
value = (double *) header;
header[0] = 7;
header[1] = m;
header[2] = n;
header[3] = 0;
header[4] = NZMAX;
header[jc] = 0;
ir = jc + n + 1;
for (k = 0; k < n; ++k)
{
header[jc + k + 1] = 0;
}
header[ir] = 0;
value[(5 + header[2] + header[4]) / 2 + 1] = 0.0;
LhsVar(1) = 3;
PutLhsVar();
return 1;
}
/*--------------------------------------------------------------------------*/
int get_colout_arg(char *fname,int pos,rhs_opts opts[], int ** colout )
{
int m,n,l,first_opt=FirstOpt(),kopt;
if (pos < first_opt)
{
if (VarType(pos))
{
GetRhsVar(pos,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
CheckLength(pos,m*n,2);
*colout = istk(l);
}
else
{
/** global value can be modified **/
int newDefCO[2] = { -1, -1 } ;
setDefColOut( newDefCO ) ;
*colout = getDefColOut() ;
}
}
else if ((kopt=FindOpt("colout",opts)))
{
GetRhsVar(kopt,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
CheckLength(kopt,m*n,2);
*colout=istk(l);
}
else
{
/** global value can be modified **/
int newDefCO[2] = { -1, -1 } ;
setDefColOut( newDefCO ) ;
*colout = getDefColOut() ;
}
return 1;
}
/*------------------------------------------------------------------------*/
int sci_grep(char *fname, unsigned long fname_len)
{
CheckRhs(2, 3);
CheckLhs(1, 2);
if (VarType(1) == sci_matrix)
{
int m1 = 0, n1 = 0;
char **Str = NULL;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &Str);
if ((m1 == 0) && (n1 == 0))
{
int l = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l);
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
}
if (Rhs == 3)
{
if (VarType(3) == sci_strings)
{
char typ = 'd'; /*default */
int m3 = 0, n3 = 0, l3 = 0;
GetRhsVar(3, STRING_DATATYPE, &m3, &n3, &l3);
if (m3 * n3 != 0)
{
typ = cstk(l3)[0];
}
if (typ == 'r')
{
sci_grep_common(fname, TRUE);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' expected.\n"), fname, 3, "s");
return 0;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 3);
return 0;
}
}
else /* Rhs == 2 */
{
sci_grep_common(fname, FALSE);
}
return 0;
}
int sci_get_if(char *fname)
{
static int l1, m1, n1;
void *p_sci;
static int l2, m2, n2;
static int lr3, lc3;
static int minrhs=2, maxrhs=2;
static int minlhs=0, maxlhs=1;
static int err;
struct sci_var s_v;
debug_3 ("[if_sci_get] ..................... \r\n");
CheckRhs(minrhs,maxrhs);
CheckLhs(minlhs,maxlhs);
// example: pfir1
m1=1;
n1=1;
GetRhsVar(1,"p",&m1,&n1,&l1);
// example: SCI_TAPS
GetRhsVar(2, "i", &m2, &n2, &l2);
p_sci = (void *) ((unsigned long int) *stk(l1));
s_v = sci_get_ifcpp(p_sci, *istk(l2));
if (sci_err) {
sciprint("\n%s:\n info:%d\n",sci_err_msg,sci_info);
Scierror(999,"%s failed err=%d", fname, sci_err);
return 0;
}
// now when m3,n3 are set - create [mxn] sci variable on stack (it=is_complex)
if (s_v.is_double)
{ CreateCVar(3,"d", &s_v.is_complex, &s_v.m, &s_v.n, &lr3, &lc3);
// alocated mem on scilab stack for [mxn] of (complex) double
s_v.p_re=stk(lr3);
s_v.p_im=stk(lc3);
}
else if (s_v.is_boolean)
{ CreateVar(3,"b", &s_v.m, &s_v.n, &lr3);
// alocated mem on scilab stack for [mxn] boolean
s_v.p_re=istk(lr3);
s_v.p_im=NULL;
}
else
{ lr3 = I_INT32;;
CreateVar(3,"I", &s_v.m, &s_v.n, &lr3);
// alocated mem on scilab stack for [mxn] of U_INT32
s_v.p_re=istk(lr3);
s_v.p_im=NULL;
}
// copy values
sci_pop_var(&s_v);
// remove data from heap
sci_delete_var(&s_v);
LhsVar(1) = 3; /* return var */
debug_3 ("[if_sci_get] +++++++++++++++++++++ \r\n");
return 0;
}
int sci_relocate_handle( char * fname, unsigned long fname_len )
{
int handleCol ;
int handleRow ;
int nbHandle ;
int handleStkIndex ;
int parentCol ;
int parentRow ;
int parentStkIndex ;
int outIndex ;
int i ;
unsigned long * handleArray = NULL ;
/* the function should be called with relocate_handle( handle, parent_handle ) */
CheckRhs(2,2) ;
CheckLhs(0,1) ;
GetRhsVar( 1,GRAPHICAL_HANDLE_DATATYPE, &handleRow, &handleCol, &handleStkIndex );
nbHandle = handleRow * handleCol ;
GetRhsVar( 2,GRAPHICAL_HANDLE_DATATYPE, &parentRow, &parentCol, &parentStkIndex );
if ( parentCol * parentRow != 1 )
{
Scierror(999,_("%s: Handles must be relocated under a single parent.\n"),fname);
return 0 ;
}
/* create an array of handles */
handleArray = MALLOC( nbHandle * sizeof( unsigned long ) ) ;
if ( handleArray == NULL )
{
Scierror(999,_("%s: No more memory.\n"),fname);
return 0 ;
}
for ( i = 0 ; i < nbHandle ; i++ )
{
handleArray[i] = (unsigned long) *hstk( handleStkIndex + i ) ;
}
// FIXME : loop on each handle and call MVC to enable new relationship.
// if ( sciRelocateHandles( handleArray ,
// handleRow * handleCol,
// (unsigned long) *hstk( parentStkIndex ) ) != 0 )
// {
// PutLhsVar();
// return 0 ;
// }
FREE( handleArray ) ;
CreateVar( Rhs + 1,GRAPHICAL_HANDLE_DATATYPE, &handleCol, &handleRow, &outIndex );
*hstk(outIndex) = *hstk(handleStkIndex) ;
LhsVar(1) = Rhs + 1 ;
PutLhsVar();
return 0 ;
}
/*--------------------------------------------------------------------------*/
static int sci_emptystr_two_rhs(char *fname)
{
/*value_param_pos_1 is the number of row ; value_param_pos_2 is the number of col*/
int Type_One = GetType(1);
int Type_Two = GetType(2);
if ((Type_One == sci_matrix) && (Type_Two == sci_matrix))
{
double value_param_pos_1 = 0;
double value_param_pos_2 = 0;
int matrixdimension = 0;
int m1 = 0, n1 = 0, l1 = 0;
int m2 = 0, n2 = 0, l2 = 0;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &l2);
value_param_pos_1 = *stk(l1);
value_param_pos_2 = *stk(l2);
matrixdimension = (int)(value_param_pos_1 * value_param_pos_2);
if (matrixdimension > 0)
{
int m = (int)value_param_pos_1;
int n = (int)value_param_pos_2;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &m, &n, NULL);
}
else
{
/* returns [] */
int l = 0;
int m = 0;
int n = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
if (Type_One != sci_matrix)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of integers expected.\n"), fname, 1);
}
else /* Type_Two */
{
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of integers expected.\n"), fname, 2);
}
}
return 0;
}
/*--------------------------------------------------------------------------*/
int get_rect_arg(char *fname,int pos,rhs_opts opts[], double ** rect )
{
int m,n,l,first_opt=FirstOpt(),kopt,i;
if (pos < first_opt)
{
if (VarType(pos)) {
GetRhsVar(pos,MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
if (m * n != 4) {
Scierror(999,"%s: Wrong size for input argument #%d: %d expected\n",fname,pos,4);
return 0;
}
*rect = stk(l);
for(i=0;i<4;i++)
if(finite((*rect)[i]) == 0){
Scierror(999,"%s: Wrong values (Nan or Inf) for input argument: %d finite values expected\n",fname,4);
return 0;
}
}
else
{
/** global value can be modified **/
double zeros[4] = { 0.0, 0.0, 0.0, 0.0 } ;
setDefRect( zeros ) ;
*rect = getDefRect() ;
}
}
else if ((kopt=FindOpt("rect",opts))) {/* named argument: rect=value */
GetRhsVar(kopt,MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
if (m * n != 4) {
Scierror(999,"%s: Wrong size for input argument #%d: %d expected\n",fname,kopt,4);
return 0;
}
*rect = stk(l);
for(i=0;i<4;i++)
if(finite((*rect)[i]) == 0){
Scierror(999,"%s: Wrong values (Nan or Inf) for input argument: %d finite values expected\n",fname,4);
return 0;
}
}
else
{
/** global value can be modified **/
double zeros[4] = { 0.0, 0.0, 0.0, 0.0 } ;
setDefRect( zeros ) ;
*rect = getDefRect() ;
}
return 1;
}
/*--------------------------------------------------------------------------*/
int cdfpoiI(char* fname, unsigned long l)
{
int m1 = 0, n1 = 0, l1 = 0, mS = 0, nS = 0, lS = 0, i = 0;
double *S = NULL;
Nbvars = 0;
CheckRhs(3, 4);
CheckLhs(1, 2);
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
if ( strcmp(cstk(l1), "PQ") == 0)
{
static int callpos[4] = {2, 3, 0, 1};
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mS, &nS, &lS);
S = stk(lS);
for (i = 0; i < mS * nS; ++i)
if (S[i] == S[i] && S[i] + 1 != S[i]) // NaN and Inf will be handled in the program
if ((int) S[i] - S[i] != 0)
{
Scierror(999, _("%s: Wrong value for input argument #%d: A matrix of integer value expected.\n"), fname, 2);
return 0;
}
CdfBase(fname, 2, 2, callpos, "PQ", _("S and Xlam"), 1, C2F(cdfpoi),
cdfpoiErr);
}
else if ( strcmp(cstk(l1), "S") == 0)
{
static int callpos[4] = {1, 2, 3, 0};
CdfBase(fname, 3, 1, callpos, "S", _("Xlam,P and Q"), 2, C2F(cdfpoi),
cdfpoiErr);
}
else if ( strcmp(cstk(l1), "Xlam") == 0)
{
static int callpos[4] = {0, 1, 2, 3};
GetRhsVar(4, MATRIX_OF_DOUBLE_DATATYPE, &mS, &nS, &lS);
S = stk(lS);
for (i = 0; i < mS * nS; ++i)
if (S[i] == S[i] && S[i] + 1 != S[i]) // NaN and Inf will be handled in the program
if ((int) S[i] - S[i] != 0)
{
Scierror(999, _("%s: Wrong value for input argument #%d: A matrix of integer value expected.\n"), fname, 4);
return 0;
}
CdfBase(fname, 3, 1, callpos, "Xlam", _("P,Q and S"), 3, C2F(cdfpoi),
cdfpoiErr);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s' or '%s' expected.\n"), fname, 1, "PQ", "S", "Xlam");
}
return 0;
}
/**
* retrieve the labels from the command line and store them into labels
*/
int get_labels_arg(char *fname, int pos, rhs_opts opts[], char ** labels)
{
int m,n,l,first_opt=FirstOpt(),kopt;
if (pos < first_opt)
{
if (VarType(pos))
{
GetRhsVar(pos,STRING_DATATYPE, &m, &n, &l);
*labels = cstk(l);
}
else
{
/* jb silvy 03/2006 */
/* do not change the legend if one already exists */
char * pSubWinUID = getOrCreateDefaultSubwin();
if (sciGetLegendDefined(pSubWinUID))
{
*labels = NULL;
}
else
{
*labels = getDefLegend();
}
}
}
else if ((kopt=FindOpt("leg",opts)))
{
GetRhsVar(kopt,STRING_DATATYPE, &m, &n, &l);
*labels = cstk(l);
}
else
{
/* jb silvy 03/2006 */
/* do not change the legend if one already exists */
char* pSubWinUID = getOrCreateDefaultSubwin();
if (sciGetLegendDefined(pSubWinUID))
{
*labels = NULL;
}
else
{
*labels = getDefLegend();
}
}
return 1;
}
int int_imread(char * fname)
{
int mR, nR, lR;
IplImage * pImage;
CheckRhs(1, 1);
CheckLhs(1, 1);
GetRhsVar(1, "c", &mR, &nR, &lR);
// fix default mode for compatibility with previous version of SIVP
pImage = cvLoadImage(cstk(lR), 1);
/* if load image failed */
if(pImage == NULL)
{
Scierror(999, "%s: Can not open file %s.\r\n", fname, cstk(lR));
return -1;
}
IplImg2Mat(pImage, 2);
LhsVar(1) = 2;
cvReleaseImage(&pImage);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_xname(char *fname, unsigned long fname_len)
{
int m1 = 0, n1 = 0, l1 = 0;
char *pstCurrentFigure = NULL;
CheckRhs(1, 1);
CheckLhs(1, 1);
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
pstCurrentFigure = getCurrentFigure();
if (pstCurrentFigure == NULL)
{
pstCurrentFigure = createNewFigureWithAxes();
}
setGraphicObjectProperty(pstCurrentFigure, __GO_NAME__, cstk(l1), jni_string, 1);
LhsVar(1) = 0;
PutLhsVar();
return 0;
}
int sci_multiply_by_two(char * fname)
{
int m_in_var, n_in_var, l_in_var;
int m_out_var, n_out_var, l_out_var;
int i_row, j_col;
// First, access to the input variable (a matrix of doubles)
GetRhsVar(1, "d", &m_in_var, &n_in_var, &l_in_var);
// Create the returned variable (a matrix of doubles)
m_out_var = m_in_var;
n_out_var = n_in_var;
CreateVar(2, "d", &m_out_var, &n_out_var, &l_out_var);
// Perform some simple operations on the matrix
for (i_row = 0; i_row < m_in_var; i_row++)
{
for (j_col = 0; j_col < n_in_var; j_col++)
{
*stk(l_out_var + i_row + j_col * m_out_var) = 2 * (*stk(l_in_var + i_row + j_col * m_in_var));
}
}
// Return the output variable
LhsVar(1) = 2;
return 0;
}
int interface_gravite(char *fname)
{
static int un = 1, nddl = N_DOF;
static int n, nbis;
static int q, G;
/* Define minls=1, maxlhs, minrhs, maxrhs */
static int minlhs = 1, minrhs = 1, maxlhs = 1, maxrhs = 1;
/* Check rhs and lhs */
CheckRhs(minrhs, maxrhs) ;
CheckLhs(minlhs, maxlhs) ;
GetRhsVar(1, "d", &n, &nbis, &q);
if (n * nbis != N_DOF)
{
sciprint("Wrong size!\r\n");
Error(999);
return 0;
}
CreateVar(2, "d", &nddl, &un, &G);
modele_gravite(stk(q), stk(G));
LhsVar(1) = 2;
return 0;
}
int sci_create_if(char *fname)
{
static int l1, m1, n1;
static int l2, m2, n2;
static int minlhs=1, maxlhs=1;
static int minrhs=1, maxrhs=1;
static int err;
void *p_sci;
debug_1 ("[if_sci_create] ..................... \r\n");
CheckRhs(minrhs,maxrhs);
CheckLhs(minlhs,maxlhs);
// Example: SCI_FIR
GetRhsVar(1, "i", &m1, &n1, &l1);
p_sci = sci_create_ifcpp(*(istk(l1)));
if (p_sci == NULL) {
Scierror(999,"%s failed err=%d", fname, sci_err);
}
else {
/* see C:\Program Files\scicoslab-44b7\examples\interface-tour-so\ex10intc.c */
m2=1;
n2=1;
CreateVarFromPtr(2,"p",&m2,&n2, p_sci);
LhsVar(1) =2; /* return pointer */
}
debug_1 ("p_sci = 0x%X \r\n", p_sci);
debug_1 ("[if_sci_create] +++++++++++++++++++++ \r\n");
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_loadfftwlibrary(char *fname,unsigned long fname_len)
{
static int l1,n1,m1;
char *FFTWLibname=NULL;
CheckRhs(1,1);
if (GetType(1) == sci_strings)
{
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
FFTWLibname=cstk(l1);
setfftwlibname(FFTWLibname);
n1=1;
if ( LoadFFTWLibrary(FFTWLibname) )
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(TRUE);
}
else
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(FALSE);
}
LhsVar(1)=Rhs+1;
PutLhsVar();
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d: A string expected.\n"),fname,1);
}
return(0);
}
int InertiaInterface(char *fname)
{
static int ndof = NDOF;
static int n, nbis;
static int q, M;
/* Define minls=1, maxlhs, minrhs, maxrhs */
static int minlhs = 1, minrhs = 1, maxlhs = 1, maxrhs = 1;
/* Check rhs and lhs */
CheckRhs(minrhs, maxrhs) ;
CheckLhs(minlhs, maxlhs) ;
GetRhsVar(1, "d", &n, &nbis, &q);
if (n * nbis != NDOF)
{
sciprint("Wrong size!\r\n");
Error(999);
return 0;
}
CreateVar(2, "d", &ndof, &ndof, &M);
Inertia(stk(M), stk(q));
LhsVar(1) = 2;
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_deletefile(char *fname,unsigned long fname_len)
{
CheckRhs(1,1);
CheckLhs(1,1);
if (GetType(1) == sci_strings)
{
int m1,n1,l1;
char *VarName=NULL;
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
/* Bug 3089 */
VarName = cstk(l1);
n1=1;
if ( deleteafile(VarName) )
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(TRUE);
}
else
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(FALSE);
}
LhsVar(1)=Rhs+1;
PutLhsVar();
}
else
{
Scierror(999,_("%s: Wrong type for input argument: A string expected.\n"),fname);
}
return 0;
}
/*-------------------------------------------------------------------------------------*/
static int sci_strcat_rhs_one_is_a_matrix(char *fname)
{
/* strcat([],'A') returns an empty string matrix */
double *Input_String_One = NULL;
int Row_One = 0, Col_One = 0;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &Row_One, &Col_One, &Input_String_One);
/* check that we have [] */
if ((Row_One == 0) && (Col_One == 0))
{
int one = 1;
int len = (int)strlen(EMPTY_CHAR);
int outIndex = 0;
CreateVar(Rhs + 1, STRING_DATATYPE, &len, &one, &outIndex);
strcpy(cstk(outIndex), EMPTY_CHAR);
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of strings or empty real matrix expected.\n"), fname, 1);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_getsystemmetrics(char *fname, unsigned long l)
{
char *param = NULL;
int nIndex = -1;
int m1 = 0;
int n1 = 0;
int l1 = 0;
CheckRhs(1, 1);
if (GetType(1) != sci_strings)
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
return 0;
}
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
param = cstk(l1);
nIndex = getnIndexFromString(param);
if ( nIndex > -1 )
{
int one = 1;
CreateVar(Rhs + 1, MATRIX_OF_INTEGER_DATATYPE, &one, &one, &l1);
*istk(l1) = GetSystemMetrics(nIndex);
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
Scierror(999, _("%s: Wrong value for input argument: %s.\n"), fname, _("see help"));
}
return 0;
}
int TagsInterface(char *fname)
{
static int one = 1, ndof = NDOF;
static int n, nbis;
static int q, N;
/* Define minls=1, maxlhs, minrhs, maxrhs */
static int minlhs = 1, minrhs = 2, maxlhs = 1, maxrhs = 2;
/* Check rhs and lhs */
CheckRhs(minrhs, maxrhs) ;
CheckLhs(minlhs, maxlhs) ;
GetRhsVar(1, "d", &n, &nbis, &q);
if (n * nbis != NDOF)
{
sciprint("Wrong size!\r\n");
Error(999);
return 0;
}
CreateVar(2, "d", &ndof, &one, &N);
Tags(stk(N), stk(q));
LhsVar(1) = 2;
return 0;
}
/*--------------------------------------------------------------------------*/
int C2F(sci_mode)(char *fname,unsigned long fname_len)
{
Rhs = Max(0, Rhs);
CheckRhs(0,1);
CheckLhs(1,1);
if (Rhs == 0)
{
int n = 1 ,l = 0;
execMode mode = getExecMode();
CreateVar(Rhs+1, MATRIX_OF_INTEGER_DATATYPE, &n, &n,&l);
*istk(l) = (int)mode;
LhsVar(1) = Rhs + 1;
}
else
{
if ( VarType(1)== sci_matrix )
{
int m1 = 0, n1 = 0, l1 = 0;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
if ( (m1 == n1) && (n1 == 1) )
{
double dmode = *stk(l1);
int mode = (int) dmode;
if (dmode != (double)mode)
{
Scierror(999,_("%s: Wrong value for input argument #%d: A int expected.\n"),fname,1);
return 0;
}
setExecMode((execMode)mode);
if ( (mode == 7) || (mode == 4) )
{
int code_message = 26;
int val_message = 0;
C2F(msgs)(&code_message, &val_message);
}
LhsVar(1) = 0;
}
else
{
Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"),fname,1);
return 0;
}
}
else
{
Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"),fname,1);
return 0;
}
}
PutLhsVar();
return 0;
}
