Beispiel #1
0
/*----------------------------------------------------------------------------*/
int sci_stripblanks(char *fname, unsigned long fname_len)
{
    char **Input_String_Matrix_One = NULL;
    char **Output_String_Matrix = NULL;
    int numRow = 0;        /*@ The row number of the output string matrix*/
    int numCol = 0;        /*@ The col number of the output string matrix*/
    int m1 = 0, n1 = 0, mn = 0, i = 0;
    BOOL bREMOVE_TAB = FALSE; /* DEFAULT no TAB */
    int Type_One = VarType(1);

    CheckRhs(1, 2);
    CheckLhs(1, 1);

    if (Rhs == 2)
    {
        int Type_Two = VarType(2);

        if (Type_Two == sci_boolean)
        {
            int m2 = 0, n2 = 0, l2 = 0;
            GetRhsVar(2, MATRIX_OF_BOOLEAN_DATATYPE, &m2, &n2, &l2);
            bREMOVE_TAB = (BOOL) * istk(l2);
        }
        else
        {
            Scierror(999, _("%s: Wrong type for input argument #%d: A boolean expected.\n"), fname, 2);
            return 0;
        }
    }

    switch (Type_One)
    {
        case sci_matrix :
        {
            /* case stripblanks([]) */
            GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &Input_String_Matrix_One);
            if ( (m1 == 0) && (n1 == 0) )
            {
                int l = 0;
                CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l);
                LhsVar(1) = Rhs + 1 ;
                PutLhsVar();
                return 0;
            }
            else
            {
                Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of strings or empty matrix expected.\n"), fname, 1);
                return 0;
            }
        }
        break;
        case sci_strings :
        {
            GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Input_String_Matrix_One);
            mn = m1 * n1;
        }
        break;
        default :
            Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of strings or empty matrix expected.\n"), fname, 1);
            return 0;
    }

    if (mn > 0)
    {
        Output_String_Matrix = (char**)MALLOC(sizeof(char*) * (mn));
    }
    else
    {
        Output_String_Matrix = NULL;
    }

    if (Output_String_Matrix == NULL)
    {
        freeArrayOfString(Input_String_Matrix_One, mn);
        Scierror(999, _("%s : No more memory.\n"), fname);
        return 0;
    }

    for (i = 0; i < mn ; i++)  /*@ To malloc a space the same as input string*/
    {
        Output_String_Matrix[i] = (char*)MALLOC(sizeof(char) * (strlen(Input_String_Matrix_One[i]) + 1));
        if (Output_String_Matrix[i] == NULL)
        {
            freeArrayOfString(Input_String_Matrix_One, mn);
            freeArrayOfString(Output_String_Matrix, i);
            Scierror(999, _("%s : No more memory.\n"), fname);
            return 0;
        }
    }

    /*@ The stripblank function*/
    stripblanks(Input_String_Matrix_One, Output_String_Matrix, mn, bREMOVE_TAB);

    freeArrayOfString(Input_String_Matrix_One, mn);

    /* put result on scilab stack */
    numRow   = m1;
    numCol   = n1;
    CreateVarFromPtr( Rhs + 1, MATRIX_OF_STRING_DATATYPE, &numRow, &numCol, Output_String_Matrix); /*@ Output*/

    /* free pointers */
    freeArrayOfString(Output_String_Matrix, mn);

    LhsVar(1) = Rhs + 1 ;
    PutLhsVar();
    return 0;
}
Beispiel #2
0
/*--------------------------------------------------------------------------*/
int sci_newest(char *fname, unsigned long fname_len)
{
    CheckLhs(1, 1);
    if (Rhs == 0)
    {
        /* newest() returns [] */
        int m1 = 0, n1 = 0, l1 = 0;
        CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE,  &m1, &n1, &l1);
        LhsVar(1) = Rhs + 1;
        PutLhsVar();
    }
    else
    {
        int m1 = 0, n1 = 0, l1 = 0;
        int RetIndex = 1;

        if (Rhs == 1)
        {
            if (GetType(1) == sci_matrix)
            {
                GetRhsVar(1, MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &l1);
                if ( (m1 == 0) && (n1 == 0) ) /* newest([]) returns [] */
                {
                    m1 = 0;
                    n1 = 0;
                    l1 = 0;
                    CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE,  &m1, &n1, &l1);
                    LhsVar(1) = Rhs + 1;
                    PutLhsVar();
                    return 0;
                }
                else
                {
                    Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname);
                    return 0;
                }
            }
            else
            {
                if (GetType(1) == sci_strings)
                {
                    char **Str = NULL;

                    GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Str);
                    RetIndex = GetIndexLastModifiedFileInList(Str, m1 * n1);
                    freeArrayOfString(Str, m1 * n1);
                }
                else
                {
                    Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname);
                    return 0;
                }
            }
        }
        else /* Rhs > 1 */
        {
            int i = 1;
            char **Str = NULL;
            int RhsBackup = Rhs;

            /* check that all input arguments are strings */
            for (i = 1; i <= Rhs ; i++)
            {
                if (GetType(i) != sci_strings)
                {
                    Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, i);
                    return 0;
                }
            }

            Str = (char**)MALLOC(sizeof(char*) * RhsBackup);
            if (Str)
            {
                // Fake call to CheckRhs to initialize gateway name returned by Get_Iname()
                // And used in error messages in GetRhsVar
                // See bug #11398
                CheckRhs(Rhs, Rhs);
                for (i = 1; i <= RhsBackup; i++)
                {
                    GetRhsVar(i, STRING_DATATYPE, &m1, &n1, &l1);
                    Str[i - 1] = strdup(cstk(l1));
                }

                RetIndex = GetIndexLastModifiedFileInList(Str, RhsBackup);
                freeArrayOfString(Str, RhsBackup);
            }
        }

        /* Output on scilab's stack */
        if (RetIndex >= 1)
        {
            int *paramoutINT = (int*)MALLOC(sizeof(int));
            *paramoutINT = RetIndex;

            n1 = 1;
            CreateVarFromPtr(Rhs + 1, MATRIX_OF_INTEGER_DATATYPE, &n1, &n1, &paramoutINT);
            LhsVar(1) = Rhs + 1;

            if (paramoutINT)
            {
                FREE(paramoutINT);
                paramoutINT = NULL;
            }

            PutLhsVar();
        }
        else
        {
            m1 = 0;
            n1 = 0;
            l1 = 0;

            CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE,  &m1, &n1, &l1);
            LhsVar(1) = Rhs + 1;
            PutLhsVar();
        }
    }
    return 0;
}
Beispiel #3
0
/*--------------------------------------------------------------------------*/
int sci_TCL_ExistVar(char *fname,unsigned long l)
{
	static int l1,n1,m1;
	static int l2,n2,m2;

	Tcl_Interp *TCLinterpreter=NULL;

	CheckRhs(1,2);
	CheckLhs(1,1);

	if (GetType(1) == sci_strings)
	{
		char *VarName=NULL;

		GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
		VarName=cstk(l1);

		if (!existsGlobalInterp())
		{
                  Scierror(999,_("%s: Error main TCL interpreter not initialized.\n"),fname);
                  return 0;
		}

		if (Rhs==2)
		{
			/* two arguments given - get a pointer on the slave interpreter */
			if (GetType(2) == sci_strings)
			{
				GetRhsVar(2,STRING_DATATYPE,&m2,&n2,&l2);
				TCLinterpreter=Tcl_GetSlave(getTclInterp(),cstk(l2));
				releaseTclInterp();
				if (TCLinterpreter==NULL)
				{
					Scierror(999,_("%s: No such slave interpreter.\n"),fname);
					return 0;
				}
			}
			else
			{
				Scierror(999,_("%s: Wrong type for input argument #%d: String expected.\n"), fname, 2);
				return 0;
			}
		}
		else
		{
			/* only one argument given - use the main interpreter */
			TCLinterpreter=getTclInterp();
			 releaseTclInterp();
		}

		n1=1;
		if ( Tcl_GetVar(TCLinterpreter, VarName, TCL_GLOBAL_ONLY) )
		{
			CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
			*istk(l1)=(int)(TRUE);
		}
		else
		{
			CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
			*istk(l1)=(int)(FALSE);
		}

		LhsVar(1)=Rhs+1;
		PutLhsVar();
	}
	else
	{
		Scierror(999,_("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
		return 0;
	}

	return 0;
}
Beispiel #4
0
extern int intpbgc(char *fname)
{ 
  int mA,nA,*ia;
  int mb,nb,msol,nsol,nniter,mniter,meps,neps,mkry,nkry,nlfil,mlfil;
  int b,sol,niter,eps,kry,lfil,pierr;
  int mdt=1,ndt=1,pdt,k;
  int mierr=1,nierr=1,iout=6,method=2;  
  int iwk, *jw, *jlu, *ju, *ipar;
  double *w,*alu,*fpar;
  SciSparse A;

  CheckRhs(1,8);
  CheckLhs(1,2);
  if (VarType(1)==5){
    GetRhsVar(1,"s",&mA,&nA,&A);
    if (mA!=nA){
      Scierror(501,"%s: input matrix must be square \r\n",fname);
    }
  } else {
    Scierror(501,"%s: input matrix must be sparse \r\n",fname);
    return 0;
  }
  if (VarType(2)==1){
    GetRhsVar(2,"d",&mb,&nb,&b);
    if ((mb!=nA)||(nb!=1)){
      Scierror(501,"%s: incompatible rhs \r\n",fname);
    }
  } else {
    Scierror(501,"%s: rhs must be a vector \r\n",fname);
    return 0;
  }
  if (VarType(3)==1){
    GetRhsVar(3,"d",&msol,&nsol,&sol);
    if ((msol!=nA)||(nsol!=1)){
      Scierror(501,"%s: incompatible init \r\n",fname);
    }
  } else {
    Scierror(501,"%s: init must be a vector \r\n",fname);
    return 0;
  }
  if (VarType(4)==1){
    GetRhsVar(4,"i",&nniter,&mniter,&niter);
    if (mniter*nniter!= 1){
      Scierror(501,"%s: niter must be a single integer \r\n",fname);
    }
  } else {
    Scierror(501,"%s: niter must be integer \r\n",fname);
    return 0;
  }
  if (VarType(5)==1){
    GetRhsVar(5,"d",&meps,&neps,&eps);
    if (meps*neps!= 1){
      Scierror(501,"%s: eps must be a real \r\n",fname);
    }
  } else {
    Scierror(501,"%s: init must be a real \r\n",fname);
    return 0;
  }
  if (VarType(6)==1){
    GetRhsVar(6,"i",&mlfil,&nlfil,&lfil);
    if (mlfil*nlfil!= 1){
      Scierror(501,"%s: lfil must be a single integer \r\n",fname);
    } 
  } else {
    Scierror(501,"%s: lfil  must be a integer \r\n",fname);
      return 0;
  }
  if (Rhs>=7) {
    if (VarType(7)==1){
      GetRhsVar(7,"d",&mdt,&ndt,&pdt);
      if ((mdt!=1)||(ndt!=1)){
	Scierror(501,"%s: drop must be a double \r\n",fname);
      }
    } else {
      Scierror(501,"%s: drop must be a double \r\n",fname);
      return 0;
    }
  } else {
    CreateVar(7,"d",&mdt,&ndt,&pdt);
    *stk(pdt)=(double) 0.001*eltm(A) ;
  }

  
  CreateVar(8,"i",&mierr,&nierr,&pierr);

  iwk=(A.m)*(2*(*istk(lfil))+1)+1;
  jw=(int *) malloc(2*A.m*sizeof(int));
  w= (double *) malloc(A.m*sizeof(double));
  
  alu= (double *) malloc(iwk*sizeof(double));
  jlu= (int *) malloc(iwk*sizeof(int));
  ju= (int *) malloc((A.m)*sizeof(int));
  ia=Sci2spk(&A);

  C2F(ilut)(&A.m,A.R,A.icol,ia,istk(lfil),stk(pdt),alu,jlu,ju,&iwk,w,jw,istk(pierr));
  free(w);
  free(jw);

  if (*istk(pierr)!=0){
    free(ju);
    free(jlu);
    free(alu);
    if (*istk(pierr)==-1) {
      Scierror(501,"%s: input matrix may be wrong \r\n",fname);
    } else if (*istk(pierr)==-2) {
      Scierror(501,"%s: not enough memory for matrix L \r\n",fname);
    } else if (*istk(pierr)==-3) {
      Scierror(501,"%s: not enough memory for matrix U \r\n",fname);
    } else if (*istk(pierr)==-4) {
      Scierror(501,"%s: illegal value for lfil \r\n",fname);
    } else if (*istk(pierr)==-5) {
      Scierror(501,"%s: zero row encountered in A or U \r\n",fname);
    } else {
      Scierror(501,"%s: zero pivot encountered at step number %d \r\n",fname,*istk(pierr));
    }
  } else {
    iwk=(A.m)*7;
    w= (double *) malloc(iwk*sizeof(double));
    fpar=(double *) malloc(16*sizeof(double));
    ipar=(int *) malloc(16*sizeof(int));
    for (k = 0; k < 16; ++k) 
      ipar[k]=0;
    ipar[1]=2;
    ipar[2]=1;
    ipar[3]=iwk;
    ipar[4]=10;
    ipar[5]=*istk(niter);
    fpar[0]=*stk(eps);
    fpar[1]=(double) 1.0E-20;

    C2F(runrc)(&A.m, stk(b), stk(sol), ipar, fpar ,w ,A.R ,A.icol , ia, alu, jlu, ju, &method, &iout);
    free(fpar);
    *istk(pierr)=ipar[0];
    free(ipar);
    free(w);
    free(ju);
    free(jlu);
    free(alu);
  }
  LhsVar(1)=3;
  LhsVar(2)=8;
  return(0);
}
/*--------------------------------------------------------------------------*/
int sci_legendre(char *fname,unsigned long fname_len)
{
    /*
    *   Interface onto the (Slatec) dxleg.f code.
    *   Scilab calling sequence :
    *
    *   p = legendre(n, m, x [, norm_flag] )
    *
    *      x is a vector with mnx elements (it is better to
    *        have a row vector but this is not forced)
    *
    *      n : a non negative int scalar (or a vector of such
    *          int regularly speced with an increment of 1)
    *      m : same constraints than for n
    *
    *      n and m may not be both vectors
    *
    *      norm_flag : optionnal. When it is present and equal to "norm"
    *                  it is a normalised version which is computed
    *    AUTHOR
    *       Bruno Pincon <*****@*****.**>
    */
    int it = 0, lc = 0, mM = 0, nM = 0, lM = 0, m1 = 0, m2 = 0, mN = 0, nN = 0;
    int lN = 0, n1 = 0, n2 = 0, mx = 0, nx = 0, lx = 0, mnx = 0, ms = 0, ns = 0, ls = 0;
    int M_is_scalar = 0, N_is_scalar = 0, normalised = 0, MNp1 = 0, lpqa = 0, lipqa = 0, *ipqa = NULL;
    double *x = NULL, xx = 0., dnu1 = 0., *pqa = NULL;
    int id = 0, ierror = 0, i = 0, j = 0, nudiff = 0;

    CheckLhs(1, 1);
    CheckRhs(3, 4);
    GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mN, &nN, &lN);

    if ( ! verify_cstr(stk(lN), mN*nN, &n1, &n2) )
    {
        Scierror(999,_("%s: Wrong type for first input argument.\n"), fname);
        return 0;
    };

    if ( mN == 1 && nN == 1) N_is_scalar = 1;

    GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE, &mM, &nM, &lM);
    if ( ! verify_cstr(stk(lM), mM*nM, &m1, &m2) )
    {
        Scierror(999,_("%s: Wrong type for input argument #%d.\n"), fname,2);
        return 0;
    }

    if ( mM == 1 && nM == 1) M_is_scalar = 1;

    if ( ! M_is_scalar  &&  ! N_is_scalar )
    {
        Scierror(999,_("%s: Only one of arg1 and arg2 may be a vector.\n"), fname);
        return 0;
    };

    GetRhsCVar(3,MATRIX_OF_DOUBLE_DATATYPE, &it, &mx, &nx, &lx, &lc);
    if ( it != 0 )
    {
        Scierror(999,_("%s: Wrong type for input argument #%d: Real matrix expected.\n"), fname, 3);
        return 0;
    };

    mnx = mx*nx;
    x = stk(lx);
    for ( i = 0 ; i < mnx ; i++ )
        if ( ! (fabs(x[i]) < 1.0) )
        {
            Scierror(999,_("%s: Wrong value for input argument #%d: Matrix with elements in (%d,%d) expected.\n"), fname,3,-1,1);
            return 0;
        };

    if ( Rhs == 4 )
    {
        GetRhsVar(4,STRING_DATATYPE, &ms, &ns, &ls);
        if ( strcmp(cstk(ls),"norm") == 0)
        {
            normalised = 1;
        }
        else
        {
            normalised = 0;
        }
    }
    else
    {
        normalised = 0;
    }

    MNp1 = Max (n2 - n1, m2 - m1) + 1;

    CreateVar(Rhs+1, MATRIX_OF_DOUBLE_DATATYPE, &MNp1, &mnx, &lpqa);
    pqa = stk(lpqa);
    CreateVar(Rhs+2, MATRIX_OF_INTEGER_DATATYPE, &MNp1, &mnx, &lipqa);
    ipqa = istk(lipqa);

    if ( normalised )
    {
        id = 4;
    }
    else
    {
        id = 3;
    }

    nudiff = n2 - n1;
    dnu1 = (double) n1;

    for ( i = 0 ; i < mnx ; i++ )
    {
        xx = fabs(x[i]); /* dxleg computes only for x in [0,1) */
        F2C(dxlegf) (&dnu1, &nudiff, &m1, &m2, &xx, &id,
                     stk(lpqa+i*MNp1), istk(lipqa+i*MNp1), &ierror);
        if ( ierror != 0 )
        {
            if ( ierror == 207 ) /* @TODO what is 207 ? */
            {
                Scierror(999,_("%s: overflow or underflow of an extended range number\n"), fname);
            }
            else
            {
                Scierror(999,_("%s: error number %d\n"), fname, ierror);
            }
            return 0;
        };
    }

    /*  dxlegf returns the result under a form (pqa,ipqa) (to
    *  compute internaly with an extended exponent range)
    *  When the "exponent" part (ipqa) is 0 then the number is exactly
    *  given by pqa else it leads to an overflow or an underflow.
    */
    for ( i = 0 ; i < mnx*MNp1 ; i++ )
    {
        if ( ipqa[i] < 0 )
        {
            pqa[i] = 0.0;
        }
        if ( ipqa[i] > 0 )
        {
            pqa[i] = pqa[i] * return_an_inf(); /* pqa[i] * Inf  to have the sign */
        }
    }

    /* complete the result by odd/even symmetry for negative x */
    for ( i = 0 ; i < mnx ; i++ )
    {
        if ( x[i] < 0.0 )
        {
            if ( (n1+m1) % 2 == 1 )
            {
                for ( j = 0 ; j < MNp1 ; j+=2 )
                {
                    pqa[i*MNp1 + j] = -pqa[i*MNp1 + j];
                }
            }
            else
            {
                for ( j = 1 ; j < MNp1 ; j+=2 )
                {
                    pqa[i*MNp1 + j] = -pqa[i*MNp1 + j];
                }
            }
        }
    }
    LhsVar(1) = Rhs + 1;
    PutLhsVar();
    return 0;
}
/*--------------------------------------------------------------------------*/
int inteval_cshep2d(char *fname, unsigned long fname_len)
{
    /*
    *   [f [,dfdx, dfdy [, dffdxx, dffdxy, dffdyy]]] = eval_cshep2d(xp, yp, tlcoef)
    */

    int minrhs = 3, maxrhs = 3, minlhs = 1, maxlhs = 6;
    int mx = 0, nx = 0, lx = 0, my = 0, ny = 0, ly = 0, mt = 0, nt = 0, lt = 0;
    char **Str = NULL;
    int m1 = 0, n1 = 0, m2 = 0, n2 = 0, m3 = 0, n3 = 0, m4 = 0, n4 = 0, m5 = 0, n5 = 0, m6 = 0, n6 = 0, m7 = 0, n7 = 0, m8 = 0, n8 = 0;
    int lxyz = 0, lgrid = 0, lrmax = 0, lrw = 0, la = 0;
    double *xp = NULL, *yp = NULL, *xyz = NULL, *grid = NULL, *f = NULL, *dfdx = NULL, *dfdy = NULL, *dffdxx = NULL, *dffdyy = NULL, *dffdxy = NULL;
    int i = 0, ier = 0, n = 0, np = 0, nr = 0, lf = 0, ldfdx = 0, ldfdy = 0, ldffdxx = 0, ldffdyy = 0, ldffdxy = 0;
    SciIntMat Cell, Next;
    int *cell = NULL, *next = NULL;

    CheckRhs(minrhs, maxrhs);
    CheckLhs(minlhs, maxlhs);

    GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
    GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &my, &ny, &ly);

    for (i = 1; i <= minrhs - 1; i++)
    {
        SciErr sciErr;
        int *piAddressVar = NULL;
        sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
        if(sciErr.iErr)
        {
            printError(&sciErr, 0);
            Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
            return 0;
        }

        if (isVarComplex(pvApiCtx, piAddressVar))
        {
            Scierror(202, _("%s: Wrong type for argument %d: Real matrix expected.\n"), fname, i);
            return 0;
        }
    }

    if ( mx != my  ||  nx != ny )
    {
        Scierror(999,_("%s: Wrong size for input arguments #%d and #%d: Same sizes expected.\n"),fname,1,2);
        return 0;
    }

    GetRhsVar(3,TYPED_LIST_DATATYPE,&mt, &nt, &lt);
    GetListRhsVar(3, 1,MATRIX_OF_STRING_DATATYPE, &m1,  &n1, &Str);    /* m1 = 1, n1 = 8 ? a verifier */
    if ( strcmp(Str[0],"cshep2d") != 0)
    {
        /* Free Str */
        if (Str)
        {
            int li = 0;
            while ( Str[li] != NULL)
            {
                FREE(Str[li]);
                Str[li] = NULL;
                li++;
            };
            FREE(Str);
            Str = NULL;
        }
        Scierror(999,_("%s: Wrong type for input argument #%d: %s tlist expected.\n"), fname,2,"cshep2d");
        return 0;
    }
    /* Free Str */
    if (Str)
    {
        int li=0;
        while ( Str[li] != NULL)
        {
            FREE(Str[li]);
            Str[li] = NULL;
            li++;
        };
        FREE(Str);
        Str = NULL;
    }
    GetListRhsVar(3, 2,MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2,  &lxyz);   /* m2 = n , n2 = 3  */
    GetListRhsVar(3, 3,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m3, &n3,  (int *)&Cell);  /* m3 = nr, n3 = nr */
    GetListRhsVar(3, 4,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m4, &n4,  (int *)&Next);  /* m4 = 1 , n4 = n  */
    GetListRhsVar(3, 5,MATRIX_OF_DOUBLE_DATATYPE, &m5, &n5,  &lgrid);  /* m5 = 1 , n5 = 4  */
    GetListRhsVar(3, 6,MATRIX_OF_DOUBLE_DATATYPE, &m6, &n6,  &lrmax);  /* m6 = 1 , n6 = 1  */
    GetListRhsVar(3, 7,MATRIX_OF_DOUBLE_DATATYPE, &m7, &n7,  &lrw);    /* m7 = 1 , n7 = n  */
    GetListRhsVar(3, 8,MATRIX_OF_DOUBLE_DATATYPE, &m8, &n8,  &la);     /* m8 = 9 , n8 = n  */

    cell = (int *)Cell.D; next = (int *)Next.D;
    xp = stk(lx); yp = stk(ly); np = mx*nx;
    n = m2; nr = m3;
    xyz = stk(lxyz); grid = stk(lgrid);

    CreateVar(4,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lf); f = stk(lf);
    if ( Lhs > 1 )
    {
        CreateVar(5,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldfdx); dfdx = stk(ldfdx);
        CreateVar(6,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldfdy); dfdy = stk(ldfdy);
    }
    if ( Lhs > 3 )
    {
        CreateVar(7,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdxx); dffdxx = stk(ldffdxx);
        CreateVar(8,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdxy); dffdyy = stk(ldffdxy);
        CreateVar(9,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdyy); dffdxy = stk(ldffdyy);
    }

    switch( Lhs )
    {
    case ( 1 ) :
        for ( i = 0 ; i < np ; i++ )
            /*            DOUBLE PRECISION FUNCTION CS2VAL (PX,PY,N,X,Y,F,NR,
            *                          LCELL,LNEXT,XMIN,YMIN,DX,DY,RMAX,RW,A)
            */
            f[i] = C2F(cs2val)(&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2*n], &nr,
            cell, next, grid, &grid[1], &grid[2], &grid[3],
            stk(lrmax), stk(lrw), stk(la));
        LhsVar(1) = 4;
        break;

    case ( 2 ) :
    case ( 3 ) :
        for ( i = 0 ; i < np ; i++ )
            /*      SUBROUTINE CS2GRD (PX,PY,N,X,Y,F,NR,LCELL,LNEXT,XMIN,
            *.                   YMIN,DX,DY,RMAX,RW,A, C,CX,CY,IER)
            */
            C2F(cs2grd) (&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2*n], &nr,
            cell, next, grid, &grid[1], &grid[2], &grid[3],
            stk(lrmax), stk(lrw), stk(la), &f[i], &dfdx[i], &dfdy[i], &ier);
        LhsVar(1) = 4;
        LhsVar(2) = 5;
        LhsVar(3) = 6;
        break;

    case ( 4 ) :
    case ( 5 ) :
    case ( 6 ) :
        for ( i = 0 ; i < np ; i++ )
        {
            /*   SUBROUTINE CS2HES (PX,PY,N,X,Y,F,NR,LCELL,LNEXT,XMIN,
            *.                     YMIN,DX,DY,RMAX,RW,A, C,CX,CY,CXX,CXY,CYY,IER)
            */
            C2F(cs2hes) (&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2*n], &nr,
                cell, next, grid, &grid[1], &grid[2], &grid[3],
                stk(lrmax), stk(lrw), stk(la), &f[i], &dfdx[i], &dfdy[i],
                &dffdxx[i], &dffdxy[i], &dffdyy[i], &ier);
        }
        LhsVar(1) = 4;
        LhsVar(2) = 5;
        LhsVar(3) = 6;
        LhsVar(4) = 7;
        LhsVar(5) = 8;
        LhsVar(6) = 9;
        break;
    }
    PutLhsVar();
    return 0;
}
/*--------------------------------------------------------------------------*/
int sci_x_dialog(char *fname,unsigned long fname_len)
{
  int nbRow = 0, nbCol = 0;

  int messageBoxID = 0;

  char **initialValueAdr = 0;

  char **labelsAdr = 0;

  int userValueSize = 0;
  char **userValue = NULL;

  int emptyMatrixAdr = 0;

  CheckRhs(1,2);
  CheckLhs(0,1);

  if (VarType(1) == sci_strings)
    {
      GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &nbRow, &nbCol, &labelsAdr);
    }
  else
    {
      Scierror(999, _("%s: Wrong type for input argument #%d: Vector of strings expected.\n"), fname, 1);
      return FALSE;
    }

  /* Create the Java Object */
  messageBoxID = createMessageBox();

  /* Title is a default title */
  setMessageBoxTitle(messageBoxID, _("Scilab Input Value Request"));
  /* Message */
  setMessageBoxMultiLineMessage(messageBoxID, getStringMatrixFromStack((size_t)labelsAdr), nbCol*nbRow);
  freeArrayOfString(labelsAdr, nbCol*nbRow);
    
  if (Rhs == 2)
    {
      if (VarType(2) ==  sci_strings)
        {
          GetRhsVar(2,MATRIX_OF_STRING_DATATYPE,&nbRow,&nbCol,&initialValueAdr);
        }
      else 
        {
          Scierror(999, _("%s: Wrong type for input argument #%d: Vector of strings expected.\n"), fname, 2);
          return FALSE;
        }

      setMessageBoxInitialValue(messageBoxID, getStringMatrixFromStack((size_t)initialValueAdr), nbCol*nbRow);
      freeArrayOfString(initialValueAdr, nbCol*nbRow);
    }

  /* Display it and wait for a user input */
  messageBoxDisplayAndWait(messageBoxID);

  /* Read the user answer */
  userValueSize = getMessageBoxValueSize(messageBoxID);
  if (userValueSize == 0)
    {
      nbRow = 0;nbCol = 0;
      CreateVar(Rhs+1, MATRIX_OF_DOUBLE_DATATYPE, &nbRow, &nbCol, &emptyMatrixAdr);
    }
  else
    {
      userValue = getMessageBoxValue(messageBoxID);
	  
  
      nbCol = 1;
      CreateVarFromPtr(Rhs+1, MATRIX_OF_STRING_DATATYPE, &userValueSize, &nbCol, userValue);
      /* TO DO : delete of userValue */
      
    }

  LhsVar(1) = Rhs+1;
  PutLhsVar();
  return TRUE;
}
Beispiel #8
0
/*--------------------------------------------------------------------------*/
int sci_fftw_flags(char *fname, unsigned long fname_len)
{
    /* declaration of variables to store scilab parameters address */
    static int l1 = 0, m1 = 0, n1 = 0;
    SciIntMat M1;
    char **Str1 = NULL;

    static int l2 = 0, m2 = 0, n2 = 0;

    char **Str3 = NULL;

    /* please update me ! */
    static int nb_flag = 22;
    static char *Str[] =
    {
        /* documented flags */
        "FFTW_MEASURE",
        "FFTW_DESTROY_INPUT",
        "FFTW_UNALIGNED",
        "FFTW_CONSERVE_MEMORY",
        "FFTW_EXHAUSTIVE",
        "FFTW_PRESERVE_INPUT",
        "FFTW_PATIENT",
        "FFTW_ESTIMATE",

        /* undocumented beyond-guru flags */
        "FFTW_ESTIMATE_PATIENT",
        "FFTW_BELIEVE_PCOST",
        "FFTW_NO_DFT_R2HC",
        "FFTW_NO_NONTHREADED",
        "FFTW_NO_BUFFERING",
        "FFTW_NO_INDIRECT_OP",
        "FFTW_ALLOW_LARGE_GENERIC",
        "FFTW_NO_RANK_SPLITS",
        "FFTW_NO_VRANK_SPLITS",
        "FFTW_NO_VRECURSE",
        "FFTW_NO_SIMD",
        "FFTW_NO_SLOW",
        "FFTW_NO_FIXED_RADIX_LARGE_N",
        "FFTW_ALLOW_PRUNING"
    };

    static unsigned flagt[] =
    {
        /* documented flags */
        FFTW_MEASURE,
        FFTW_DESTROY_INPUT,
        FFTW_UNALIGNED,
        FFTW_CONSERVE_MEMORY,
        FFTW_EXHAUSTIVE,
        FFTW_PRESERVE_INPUT,
        FFTW_PATIENT,
        FFTW_ESTIMATE,

        /* undocumented beyond-guru flags */
        FFTW_ESTIMATE_PATIENT,
        FFTW_BELIEVE_PCOST,
        FFTW_NO_DFT_R2HC,
        FFTW_NO_NONTHREADED,
        FFTW_NO_BUFFERING,
        FFTW_NO_INDIRECT_OP,
        FFTW_ALLOW_LARGE_GENERIC,
        FFTW_NO_RANK_SPLITS,
        FFTW_NO_VRANK_SPLITS,
        FFTW_NO_VRECURSE,
        FFTW_NO_SIMD,
        FFTW_NO_SLOW,
        FFTW_NO_FIXED_RADIX_LARGE_N,
        FFTW_ALLOW_PRUNING
    };

    unsigned flagv = 0;

    int i = 0, j = 0;

    CheckRhs(0, 1);

    if (Rhs == 0)
    {
        // nothing
    }
    else
    {
        switch(VarType(1))
        {
        case sci_ints:

            /* int */
            GetRhsVar(1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &M1);
            CheckDims(1, m1, n1, 1, 1);
            setCurrentFftwFlags(((int *)M1.D)[0]);
            break;
        case sci_matrix:
            /* double */
            GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
            CheckDims(1, m1, n1, 1, 1);
            setCurrentFftwFlags((int)*stk(l1));
            break;
        case sci_strings:
            /* string */
            GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Str1);
            for (j = 0; j < m1 * n1; j++)
            {
                for (i = 0; i < nb_flag; i++)
                {
                    if (strcmp(Str1[j], Str[i]) == 0) break;
                }

                if (i == nb_flag)
                {
                    freeArrayOfString(Str1, m1 * n1);
                    Scierror(999, _("%s: Wrong values for input argument #%d: FFTW flag expected.\n"), fname, 1);
                    return 0;
                }
                else
                {
                    if (i > 0)
                    {
                        flagv = ( flagv | (1U << (i - 1)) );
                    }
                }
            }
            setCurrentFftwFlags(flagv);
            freeArrayOfString(Str1, m1 * n1);
            break;

        default:
            Scierror(53, _("%s: Wrong type for input argument #%d.\n"), fname, 1);
            return 0;
        }
    }

    /* return value of Sci_Plan.flags in position 2 */
    m2 = 1;
    n2 = m2;
    l2 = I_INT32;
    CreateVar(Rhs + 2, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m2, &n2, &l2);
    *istk(l2) = (int) getCurrentFftwFlags();

    /*Test for only FFTW_MEASURE*/
    if (getCurrentFftwFlags() == 0)
    {
        j = 1;
        if ((Str3 = (char **)MALLOC(sizeof(char *))) == NULL)
        {
            Scierror(999, _("%s: No more memory.\n"), fname);
            return 0;
        }

        Str3[0] = strdup(Str[0]);
        if (Str3[0] == NULL)
        {
            Scierror(999, _("%s: No more memory.\n"), fname);
            return 0;
        }
    }
    else
    {
        j = 0;
        for (i = 1;i < nb_flag; i++)
        {
            if((getCurrentFftwFlags() & flagt[i]) == flagt[i])
            {
                j++;
                if (Str3)
                {
                    Str3 = (char **)REALLOC(Str3,sizeof(char *) * j);
                }
                else
                {
                    Str3 = (char **)MALLOC(sizeof(char *) * j);
                }

                if ( Str3 == NULL)
                {
                    Scierror(999, _("%s: No more memory.\n"), fname);
                    return 0;
                }

                Str3[j - 1] = strdup(Str[i]);
                if (Str3[j - 1] == NULL)
                {
                    freeArrayOfString(Str3, j);
                    Scierror(999, _("%s: No more memory.\n"), fname);
                    return 0;
                }
            }
        }
    }

    n1 = 1;
    CreateVarFromPtr(Rhs + 3, MATRIX_OF_STRING_DATATYPE, &j, &n1, Str3);
    freeArrayOfString(Str3, j);

    LhsVar(1) = Rhs + 2;
    LhsVar(2) = Rhs + 3;
    PutLhsVar();
    return 0;
}
Beispiel #9
0
extern int intmshurgmres(char *fname)
{ 
  int mA,nA,*ia;
  int mb,nb,msol,nsol,nniter,mniter,meps,neps,mkry,nkry,nlfil,mlfil,nLU,mLU;
  int b,sol,niter,eps,kry,lfil,pierr,LU;
  int mdt=1,ndt=1,pdt;
  int mierr=1,nierr=1,iout=6,param;  
  int iwk, *jw, *jlu, *ju , *p, *invq, ind;
  double *w,*alu, condest=1.0;
  SciSparse A;

  param=1 + 0*2 + 1*4+ 0*8+ 1*16+ 0*32 + 0*64 + 0*128 +0*256 + 0*512;
  CheckRhs(1,9);
  CheckLhs(1,2);

  /* matrice */
  if (VarType(1)==5){
    GetRhsVar(1,"s",&mA,&nA,&A);
    if (mA!=nA){
      Scierror(501,"%s: input matrix must be square \r\n",fname);
    }
  } else {
    Scierror(501,"%s: input matrix must be sparse \r\n",fname);
    return 0;
  }
  /* rhs */
  if (VarType(2)==1){
    GetRhsVar(2,"d",&mb,&nb,&b);
    if ((mb!=nA)||(nb!=1)){
      Scierror(501,"%s: incompatible rhs \r\n",fname);
    }
  } else {
    Scierror(501,"%s: rhs must be a vector \r\n",fname);
    return 0;
  }
  /* x0  */
  if (VarType(3)==1){
    GetRhsVar(3,"d",&msol,&nsol,&sol);
    if ((msol!=nA)||(nsol!=1)){
      Scierror(501,"%s: incompatible init \r\n",fname);
    }
  } else {
    Scierror(501,"%s: init must be a vector \r\n",fname);
    return 0;
  }
  /* nb iter max */
  if (VarType(4)==1){
    GetRhsVar(4,"i",&nniter,&mniter,&niter);
    if (mniter*nniter!= 1){
      Scierror(501,"%s: niter must be a single integer \r\n",fname);
    }
  } else {
    Scierror(501,"%s: niter must be integer \r\n",fname);
    return 0;
  }
  /* reduc  res */
  if (VarType(5)==1){
    GetRhsVar(5,"d",&meps,&neps,&eps);
    if (meps*neps!= 1){
      Scierror(501,"%s: eps must be a real \r\n",fname);
    }
  } else {
    Scierror(501,"%s: init must be a real \r\n",fname);
    return 0;
  }
  /* taille de l'espace de krylov */
  if (VarType(6)==1){
    GetRhsVar(6,"i",&mkry,&nkry,&kry);
    if (mkry*nkry!= 1){
      Scierror(501,"%s: krylov must be a single integer \r\n",fname);
    }
  } else {
    Scierror(501,"%s: krylov  must be a integer \r\n",fname);
    return 0;

  }
  if (VarType(7)==1){
    GetRhsVar(7,"i",&mlfil,&nlfil,&lfil);
  } else {
    Scierror(501,"%s: lfil  must be integer \r\n",fname);
      return 0;
  }
  if (VarType(8)==1){
    GetRhsVar(8,"d",&mdt,&ndt,&pdt);
  } else {
    Scierror(501,"%s: drop must be a double \r\n",fname);
    return 0;
  }
  if (VarType(9)==1){
    GetRhsVar(9,"i",&mLU,&nLU,&LU);
      }
  CreateVar(10,"i",&mierr,&nierr,&pierr);

  iwk=(LU)*(2*(*istk(lfil))+1)+1+ (A.m-LU)*(2*(*istk(lfil))+1)+1;
  jw=(int *) malloc(21*A.m*sizeof(int));
  w= (double *) malloc(7*A.m*sizeof(double));
  p=(int *) malloc(A.m*sizeof(int));
  invq=(int *) malloc(A.m*sizeof(int));
  for(ind=0;ind<A.m;ind++){
    p[ind]=ind+1;
    invq[ind]=ind+1;
  }
  printf("iwk %i :\n",iwk);
  alu= (double *) malloc(iwk*sizeof(double));
  jlu= (int *) malloc(iwk*sizeof(int));
  ju= (int *) malloc((A.m)*sizeof(int));
  ia=Sci2spk(&A);

  
  /*
C2F(piluc)(&A.m,A.R,A.icol,ia,istk(lfil),stk(pdt),&condest,istk(LU),&param,p,invq,alu,jlu,ju,&iwk,w,jw,istk(pierr));
   */
  C2F(iluc)(&A.m,A.R,A.icol,ia,istk(lfil),stk(pdt),&param,alu,jlu,ju,&iwk,w,jw,istk(pierr));
  printf("----- fin piluc ------\n");
  free(w);
  free(jw);
  free(p);
  free(invq);

  if (*istk(pierr)!=0){
    free(ju);
    free(jlu);
    free(alu);
    if (*istk(pierr)==-1) {
      Scierror(501,"%s: input matrix may be wrong \r\n",fname);
    } else if (*istk(pierr)==-2) {
      Scierror(501,"%s: not enough memory for matrix L \r\n",fname);
    } else if (*istk(pierr)==-3) {
      Scierror(501,"%s: not enough memory for matrix U \r\n",fname);
    } else if (*istk(pierr)==-4) {
      Scierror(501,"%s: illegal value for lfil \r\n",fname);
    } else  {
      Scierror(501,"%s: zero pivot encountered at step number %d \r\n",fname,*istk(pierr));
    }
  } else {
    iwk=(A.m)*(*istk(kry)+1);
    w= (double *) malloc(iwk*sizeof(double));
    C2F(mpgmres)(&A.m,istk(LU), istk(kry), stk(b), stk(sol), w, stk(eps), istk(niter),&iout,A.R ,A.icol , ia, alu, jlu, ju, istk(pierr));
    free(w);
    free(ju);
    free(jlu);
    free(alu);
  }
  /*
  //CreateVar(10,"d",&mb,&nb,&sol);
  */
  LhsVar(1)=3;
  LhsVar(2)=10;
  return(0);
}
Beispiel #10
0
int sci_gen_if(char *fname)
{
    static int l1, m1, n1;
    void *p_sci;
    static int l2, m2, n2;
    static int lr3, lc3;

    static int minrhs=2, maxrhs=2;
    static int minlhs=1, maxlhs=1;
    static int err=0;

    struct sci_var s_ce;
    struct sci_var s_y;

    debug_3 ("[sci_gen_if] ..................... \r\n");
    CheckRhs(minrhs,maxrhs);
    CheckLhs(minlhs,maxlhs);
    // Example:pfir1
    m1=1;
    n1=1;
    GetRhsVar(1,"p",&m1,&n1,&l1);
    // Example:ce -  boolean
    GetRhsVar(2, "b", &m2, &n2, &l2);
    s_ce.is_complex=0;
    s_ce.is_double=0;
    s_ce.is_boolean=1;
    s_ce.p_var=NULL;
    s_ce.p_re=istk(l2);
    s_ce.p_im=NULL;
    s_ce.m=m2;
    s_ce.n=n2;

    p_sci = (void *) ((unsigned long int) *stk(l1));
    s_y = sci_gen_ifcpp(p_sci, &s_ce);
    if (sci_err) {
        sciprint("\n%s:\n info:%d\n",sci_err_msg,sci_info);
        Scierror(999,"%s failed err=%d", fname, sci_err);
        return 0;
    }
    // now when m3,n3 are set - create [mxn] sci variable on stack (it=is_complex)
    if (s_y.is_double)
    {   CreateCVar(3,"d", &s_y.is_complex, &s_y.m, &s_y.n, &lr3, &lc3);
        // alocated mem on scilab stack for [mxn] of (complex) double
        s_y.p_re=stk(lr3);
        s_y.p_im=stk(lc3);
    }
    else if (s_y.is_boolean)
    {   CreateVar(3,"b", &s_y.m, &s_y.n, &lr3);
        // alocated mem on scilab stack for [mxn] boolean
        s_y.p_re=istk(lr3);
        s_y.p_im=NULL;
    }
    else
    {   lr3 = I_INT32;
        CreateVar(3,"I", &s_y.m, &s_y.n, &lr3);
        // alocated mem on scilab stack for [mxn] I_INT32;
        s_y.p_re=istk(lr3);
        s_y.p_im=NULL;
    }
    // copy values
    sci_pop_var(&s_y);
    // remove data from heap
    sci_delete_var(&s_y);
    LhsVar(1) = 3; /* return var */
    debug_3 ("[sci_gen_if] +++++++++++++++++++++ \r\n");
    return 0;
}
Beispiel #11
0
int sci_proc_if(char *fname)
{
    static int l1, m1, n1;
    void *p_sci;
    static int l2, m2, n2;
    static int lr3, lc3, it3, m3, n3;
    static int lr4, lc4;
    static int minrhs=3, maxrhs=3;
    static int minlhs=1, maxlhs=1;
    static int err=0;
    struct sci_var s_ce;
    struct sci_var s_x;
    struct sci_var s_y;

    SciIntMat M1;
    sci_types sci_var_type;

    debug_3 ("[sci_proc_if] ..................... \r\n");
    CheckRhs(minrhs,maxrhs);
    CheckLhs(minlhs,maxlhs);
    // Example:pfir1
    m1=1;
    n1=1;
    GetRhsVar(1,"p",&m1,&n1,&l1);
    // Example:ce -  boolean
    GetRhsVar(2, "b", &m2, &n2, &l2);
    s_ce.is_complex=0;
    s_ce.is_double=0;
    s_ce.is_boolean=1;
    s_ce.p_re=istk(l2);
    s_ce.p_im=NULL;
    s_ce.m=m2;
    s_ce.n=n2;
    s_ce.p_var=NULL;
    // Example:x
    sci_var_type=GetType(3);
    switch(sci_var_type)
    {
    case sci_matrix: // "1 - A matrix of doubles\n"
        GetRhsCVar(3, "d", &it3, &m3, &n3, &lr3, &lc3);
        s_x.is_complex=it3;
        s_x.is_double=1;
        s_x.is_boolean=0;
        s_x.p_re=stk(lr3);
        s_x.p_im=stk(lc3);
        s_x.m=m3;
        s_x.n=n3;
        s_x.p_var=NULL;
        break;
    case sci_boolean: // "4 - A matrix of booleans\n";
        GetRhsVar(3, "b", &m3, &n3, &lr3);
        s_x.is_complex=0;
        s_x.is_double=0;
        s_x.is_boolean=1;
        s_x.p_re=istk(lr3);
        s_x.p_im=NULL;
        s_x.m=m3;
        s_x.n=n3;
        s_x.p_var=NULL;
        break;
    case sci_ints:  // "8 - A matrix of integers\n - 32bit nothing else";
        // This is coded as in an example: modnum_422\ intmodnum_lib.c\ int intspread_c(char *fname)
        GetRhsVar(3, "I", &m3, &n3, &M1);
        // check the type of int (M1.it==I_INT32 | M1.it==I_UINT32)
        s_x.is_complex = 0;
        s_x.is_double = 0;
        s_x.is_boolean = 0;
        s_x.p_re = M1.D;
        s_x.p_im = NULL;
        s_x.m = m3;
        s_x.n = n3;
        s_x.p_var = NULL;
        break;
    default:
        Scierror(999,"Unsupported argument type %s failed err=", fname, -1);
        break;
    }
    p_sci = (void *) ((unsigned long int) *stk(l1));
    s_y = sci_proc_ifcpp(p_sci, &s_ce, &s_x );
    if (sci_err) {
        sciprint("\n%s:\n info:%d\n",sci_err_msg,sci_info);
        Scierror(999,"%s failed err=%d", fname, sci_err);
        return 0;
    }
    // now when m3,n3 are set - create [mxn] sci variable on stack (it=is_complex)
    if (s_y.is_double)
    {   CreateCVar(4,"d", &s_y.is_complex, &s_y.m, &s_y.n, &lr4, &lc4);
        // alocated mem on scilab stack for [mxn] of (complex) double
        s_y.p_re = stk(lr4);
        s_y.p_im = stk(lc4);
    }
    else if (s_y.is_boolean)
    {   CreateVar(4,"b", &s_y.m, &s_y.n, &lr4);
        // alocated mem on scilab stack for [mxn] boolean
        s_y.p_re = istk(lr4);
        s_y.p_im = NULL;
    }
    else
    {   lr4 = I_INT32;
        CreateVar(4,"I", &s_y.m, &s_y.n, &lr4);
        // alocated mem on scilab stack for [mxn] I_INT32;
        s_y.p_re = istk(lr4);
        s_y.p_im = NULL;
    }
    // copy values
    sci_pop_var(&s_y);
    // remove data from heap
    sci_delete_var(&s_y);
    LhsVar(1) = 4; /* return var */
    debug_3 ("[sci_proc_if] +++++++++++++++++++++ \r\n");
    return 0;

}
Beispiel #12
0
/*------------------------------------------------------------------------*/
int sci_plot2d( char * fname, unsigned long fname_len )
{

    int m1 = 0, n1 = 0, l1 = 0, m2 = 0, n2 = 0, l2 = 0, lt = 0;
    int test = 0, i = 0, j = 0, iskip = 0;
    int frame_def = 8;
    int *frame = &frame_def;
    int axes_def = 1;
    int *axes = &axes_def;

    /* F.Leray 18.05.04 : log. case test*/
    int size_x = 0, size_y = 0;
    double xd[2];
    char dataflag = 0;

    char   * logFlags = NULL  ;
    int    * style    = NULL  ;
    double * rect     = NULL  ;
    char   * strf     = NULL  ;
    char   * legend   = NULL  ;
    int    * nax      = NULL  ;
    BOOL     flagNax  = FALSE ;
    char strfl[4];

    static rhs_opts opts[] = { { -1, "axesflag", "?", 0, 0, 0},
        { -1, "frameflag", "?", 0, 0, 0},
        { -1, "leg", "?", 0, 0, 0},
        { -1, "logflag", "?", 0, 0, 0},
        { -1, "nax", "?", 0, 0, 0},
        { -1, "rect", "?", 0, 0, 0},
        { -1, "strf", "?", 0, 0, 0},
        { -1, "style", "?", 0, 0, 0},
        { -1, NULL, NULL, 0, 0, 0}
    };

    if (Rhs == 0)
    {
        sci_demo(fname, fname_len);
        return 0;
    }

    CheckRhs(1, 9);

    iskip = 0;
    if ( get_optionals(fname, opts) == 0)
    {
        PutLhsVar();
        return 0 ;
    }

    if (GetType(1) == sci_strings)
    {
        /* logflags */
        GetLogflags( fname, 1, opts, &logFlags ) ;
        iskip = 1;
    }

    if (FirstOpt() == 2 + iskip)       				/** plot2d([loglags,] y, <opt_args>); **/
    {
        GetRhsVar(1 + iskip, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &l2);

        if (m2 == 1 && n2 > 1)
        {
            m2 = n2;
            n2 = 1;
        }
        m1 = m2;
        n1 = n2;
        CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE,  &m1, &n1, &l1);

        for (i = 0; i < m2 ; ++i)
        {
            for (j = 0 ; j < n2 ;  ++j)
            {
                *stk( l1 + i + m2 * j) = (double) i + 1;
            }
        }
    }
    else if (FirstOpt() >= 3 + iskip)     /** plot2d([loglags,] x, y[, style [,...]]); **/
    {

        /* x */
        GetRhsVar(1 + iskip, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);

        /* y */
        GetRhsVar(2 + iskip, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &l2);

        test = (m1 * n1 == 0) ||
               ((m1 == 1 || n1 == 1) && (m2 == 1 || n2 == 1) && (m1 * n1 == m2 * n2))  ||
               ((m1 == m2) && (n1 == n2)) ||
               ((m1 == 1 && n1 == m2) || (n1 == 1 && m1 == m2));
        CheckDimProp(1 + iskip, 2 + iskip, !test);

        if (m1 * n1 == 0)
        {
            /* default x=1:n */
            CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE,  &m2, &n2, &lt);
            if (m2 == 1 && n2 > 1)
            {
                m2 = n2;
                n2 = 1;
            }
            for (i = 0; i < m2 ; ++i)
            {
                for (j = 0 ; j < n2 ;  ++j)
                {
                    *stk( lt + i + m2 * j) = (double) i + 1;
                }
            }
            m1 = m2;
            n1 = n2;
            l1 = lt;
        }
        else if ((m1 == 1 || n1 == 1) && (m2 != 1 && n2 != 1) )
        {
            /* a single x vector for mutiple columns for y */
            CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE,  &m2, &n2, &lt);
            for (i = 0; i < m2 ; ++i)
            {
                for (j = 0 ; j < n2 ;  ++j)
                {
                    *stk( lt + i + m2 * j) = *stk(l1 + i);
                }
            }
            m1 = m2;
            n1 = n2;
            l1 = lt;
        }
        else if ((m1 == 1 && n1 == 1) && (n2 != 1) )
        {
            /* a single y row vector  for a single x */
            CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE,  &m1, &n2, &lt);
            for (j = 0 ; j < n2 ;  ++j)
            {
                *stk( lt + j ) = *stk(l1);
            }
            n1 = n2;
            l1 = lt;
        }
        else
        {
            if (m2 == 1 && n2 > 1)
            {
                m2 = n2;
                n2 = 1;
            }
            if (m1 == 1 && n1 > 1)
            {
                m1 = n1;
                n1 = 1;
            }
        }
    }
    else
    {
        Scierror(999, _("%s: Wrong number of mandatory input arguments. At least %d expected.\n"), fname, 1);
        return 0;
    }

    if (n1 == -1 || n2 == -1 || m1 == -1 || m2 == -1)
    {
        Scierror(999, _("%s: Wrong size for input arguments #%d and #%d.\n"), fname, 1, 2); /* @TODO : detail error */
        return 0;
    }

    sciGetStyle( fname, 3 + iskip, n1, opts, &style ) ;

    GetStrf( fname, 4 + iskip, opts, &strf ) ;

    GetLegend( fname, 5 + iskip, opts, &legend );

    GetRect( fname, 6 + iskip, opts, &rect );

    GetNax( 7 + iskip, opts, &nax, &flagNax ) ;

    if (iskip == 0)
    {
        GetLogflags( fname, 8, opts, &logFlags ) ;
    }

    if ( isDefStrf( strf ) )
    {
        strcpy(strfl, DEFSTRFN);

        strf = strfl;
        if ( !isDefRect( rect ) )
        {
            strfl[1] = '7';
        }
        if ( !isDefLegend( legend ) )
        {
            strfl[0] = '1';
        }

        GetOptionalIntArg(fname, 9, "frameflag", &frame, 1, opts);
        if ( frame != &frame_def )
        {
            strfl[1] = (char)(*frame + 48);
        }

        GetOptionalIntArg(fname, 9, "axesflag", &axes, 1, opts);

        if (axes != &axes_def)
        {
            strfl[2] = (char)(*axes + 48);
        }
    }

    /* Make a test on log. mode : available or not depending on the bounds set by Rect arg. or xmin/xmax :
    Rect case :
    - if the min bound is strictly posivite, we can use log. mode
    - if not, send error message
    x/y min/max case:
    - we find the first strictly positive min bound in Plo2dn.c ?? */

    switch (strf[1])
    {
        case '0':
            /* no computation, the plot use the previous (or default) scale */
            break;
        case '1' :
        case '3' :
        case '5' :
        case '7':
            /* based on Rect arg */
            if ( rect[0] > rect[2] || rect[1] > rect[3])
            {
                Scierror(999, _("%s: Impossible status min > max in x or y rect data.\n"), fname);
                return -1;
            }

            if ( rect[0] <= 0. && logFlags[1] == 'l') /* xmin */
            {
                Scierror(999, _("%s: Bounds on x axis must be strictly positive to use logarithmic mode.\n"), fname);
                return -1 ;
            }

            if ( rect[1] <= 0. && logFlags[2] == 'l') /* ymin */
            {
                Scierror(999, _("%s: Bounds on y axis must be strictly positive to use logarithmic mode.\n"), fname);
                return -1 ;
            }

            break;
        case '2' :
        case '4' :
        case '6' :
        case '8':
        case '9':
            /* computed from the x/y min/max */
            if ( (int)strlen(logFlags) < 1)
            {
                dataflag = 'g' ;
            }
            else
            {
                dataflag = logFlags[0];
            }

            switch ( dataflag )
            {
                case 'e' :
                    xd[0] = 1.0;
                    xd[1] = (double)m1;
                    size_x = (m1 != 0) ? 2 : 0 ;
                    break;
                case 'o' :
                    size_x = m1;
                    break;
                case 'g' :
                default  :
                    size_x = (n1 * m1) ;
                    break;
            }

            if (size_x != 0)
            {
                if (logFlags[1] == 'l' && sciFindStPosMin(stk(l1), size_x) <= 0.0 )
                {
                    Scierror(999, _("%s: At least one x data must be strictly positive to compute the bounds and use logarithmic mode.\n"), fname);
                    return -1 ;
                }
            }

            size_y = (n1 * m1) ;

            if (size_y != 0)
            {
                if ( logFlags[2] == 'l' && sciFindStPosMin(stk(l2), size_y) <= 0.0 )
                {
                    Scierror(999, _("%s: At least one y data must be strictly positive to compute the bounds and use logarithmic mode\n"), fname);
                    return -1 ;
                }
            }

            break;
    }

    // open a figure if none already exists
    getOrCreateDefaultSubwin();
    Objplot2d (1, logFlags, stk(l1), stk(l2), &n1, &m1, style, strf, legend, rect, nax, flagNax);

    LhsVar(1) = 0;
    PutLhsVar();
    return 0;
}
Beispiel #13
0
/*--------------------------------------------------------------------------*/
int intsplin3d(char * fname,unsigned long fname_len)
{
    /*
    *   [tlist] = splin3d(x, y, z, v [,orderxyz])
    */
    static char *Str[] = {"tensbs3d", "tx", "ty", "tz", "order", "bcoef", "xyzminmax"};

    int minrhs = 4, maxrhs = 5, minlhs = 1, maxlhs = 1;

    int mx = 0, nx = 0, lx = 0, my = 0, ny = 0, ly = 0, mz = 0, nz = 0, lz = 0, mo = 0;
    int no = 0, lo = 0, kx = 0, ky = 0, kz = 0;
    int ntx = 0, nty = 0, ntz = 0, ltx = 0, lty = 0, ltz = 0, lbcoef = 0, lxyzminmax = 0;
    int mwk = 0, mwkx = 0, mwky = 0, mwkz = 0;
    int flag = 0, one = 1, three = 3, six = 6, seven = 7, ltlist = 0, nxyz = 0, lwork = 0;
    int lar = 0, lorder = 0, *order = NULL;
    double *x = NULL, *y = NULL, *z = NULL, *xyzminmax = NULL;
    int i = 0;
    RealHyperMat V;

    CheckRhs(minrhs, maxrhs);
    CheckLhs(minlhs, maxlhs);

    GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
    CheckVector(1, mx, nx); 
    x = stk(lx);
    GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE, &my, &ny, &ly);
    CheckVector(2, my, ny); 
    y = stk(ly);
    GetRhsVar(3,MATRIX_OF_DOUBLE_DATATYPE, &mz, &nz, &lz);
    CheckVector(2, mz, nz); 
    z = stk(lz);

    for (i = 1; i <= minrhs - 1; i++)
    {
        SciErr sciErr;
        int *piAddressVar = NULL;
        sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
        if(sciErr.iErr)
        {
            printError(&sciErr, 0);
            Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
            return 0;
        }

        if (isVarComplex(pvApiCtx, piAddressVar))
        {
            Scierror(202, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), fname, i);
            return 0;
        }
    }

    nx = mx * nx; 
    ny = my * ny; 
    nz = mz * nz;

    if (nx < 3  ||  ny < 3  ||  nz < 3)
    {
        Scierror(999,_("%s: Wrong size for input arguments: x, y and z grids must have at least %d points.\n"), fname, 3);
        return 0;
    }

    GetRhsRealHMat(4, &V);
    if ( V.dimsize != 3 )
    {
        Scierror(999,_("%s: Wrong size for input argument #%d: A real 3-dimension hypermatrix expected.\n"),fname,4);
        return 0;
    }
    if ( V.dims[0] != nx  ||  V.dims[1] != ny  ||  V.dims[2] != nz  )
    {
        Scierror(999,"%s: Wrong value for input argument: Size incompatibility between grid points and grid values.\n", fname);
        return 0;
    }

    if ( Rhs == 5 )
    {
        GetRhsVar(5,MATRIX_OF_DOUBLE_DATATYPE, &mo, &no, &lo);
        if ( (mo != 1 && no != 1)  ||  mo*no != 3 )
        {
            Scierror(999,_("%s: Wrong value for input argument #%d: Vector with %d components expected.\n"),fname,4,3);
            return 0;
        }
        kx = (int)*stk(lo); 
        ky = (int)*stk(lo+1); 
        kz = (int)*stk(lo+2);
        if ( kx < 2  ||  kx >= nx  ||  ky < 2  ||  ky >= ny  ||  kz < 2  ||  kz >= nz )
        {
            Scierror(999,_("%s: Wrong values for input argument #%d.\n"), fname, 5);
            return 0;
        }
    }
    else
    {
        kx = 4;
        ky = 4;
        kz = 4;
    }

    ntx = nx + kx;
    nty = ny + ky;
    ntz = nz + kz;
    mwkx = kx*(nx+1); mwky = ky*(ny+1); mwkz = kz*(nz+1);
    mwkx = Max(mwkx, mwky);
    mwk = nx*ny*nz + 2*(Max(mwkx, mwkz));
    nxyz = nx*ny*nz;

    CreateVar(Rhs+1,TYPED_LIST_DATATYPE, &seven, &one, &ltlist);
    CreateListVarFromPtr(Rhs+1, 1,MATRIX_OF_STRING_DATATYPE, &one,  &seven, Str);
    lar = -1; CreateListVarFrom(Rhs+1, 2,MATRIX_OF_DOUBLE_DATATYPE, &ntx, &one, &ltx, &lar);
    lar = -1; CreateListVarFrom(Rhs+1, 3,MATRIX_OF_DOUBLE_DATATYPE, &nty, &one, &lty, &lar);
    lar = -1; CreateListVarFrom(Rhs+1, 4,MATRIX_OF_DOUBLE_DATATYPE, &ntz, &one, &ltz, &lar);
    lorder = 4;
    lar = -1; CreateListVarFrom(Rhs+1, 5,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &three, &one, &lorder, &lar);
    order = istk(lorder); order[0] = kx; order[1] = ky; order[2] = kz;
    lar = -1; CreateListVarFrom(Rhs+1, 6,MATRIX_OF_DOUBLE_DATATYPE, &nxyz,  &one, &lbcoef, &lar);
    lar = -1; CreateListVarFrom(Rhs+1, 7,MATRIX_OF_DOUBLE_DATATYPE, &six,  &one, &lxyzminmax, &lar);
    xyzminmax = stk(lxyzminmax);
    xyzminmax[0] = x[0];
    xyzminmax[1] = x[nx - 1];
    xyzminmax[2] = y[0];
    xyzminmax[3] = y[ny - 1];
    xyzminmax[4] = z[0];
    xyzminmax[5] = z[nz - 1];
    CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &mwk, &one, &lwork); 

    flag = 0;
    C2F(db3ink) ( stk(lx), &nx, stk(ly), &ny, stk(lz), &nz, V.R,
        &nx, &ny, &kx, &ky, &kz, stk(ltx), stk(lty), stk(ltz),
        stk(lbcoef), stk(lwork), &flag);

    if ( flag != 1 )
    {
        Scierror(999, _("%s: Problem with 'flag' = %d\n"), fname, flag);
        return 0;
    }

    /*  Return only the tlist  */
    LhsVar(1) = Rhs+1;
    PutLhsVar();
    return 0;
}
Beispiel #14
0
/*------------------------------------------------------------------------*/
int sci_regexp(char *fname,unsigned long fname_len)
{
	char typ = CHAR_S;
	char **Str = NULL;
	char **Str2 = NULL;
	int i = 0; /* loop indice */

	int mn = 0; /* dimension parameter 1 m*n */

	int mn2 = 0; /* m2*n2 */

	int outIndex = 0;
	int numRow = 1;

	int *values_start = NULL;
	int *values_end = NULL;

	int *wcvalues_start = NULL;
	int *wcvalues_end = NULL;


	int nbValues_start = 0;
	int nbValues_end=0;
	int nbposition = 0;

	CheckRhs(2,3);
	CheckLhs(1,3);

	if (VarType(1) == sci_strings)
	{
		int m1 = 0;
		int n1 = 0;

		GetRhsVar(1,MATRIX_OF_STRING_DATATYPE,&m1,&n1,&Str);
		mn = m1*n1;
	}
	else
	{
		Scierror(999, _("%s: Wrong type for input argument #%d: Single string expected.\n"), fname,1);
		return 0;
	}

	if (mn != 1)
	{
		freeArrayOfString(Str,mn);
		Scierror(36, _("%s: Wrong size for input argument #%d: Single string expected.\n"), fname,1);
		return 0;
	}

	if (VarType(2) == sci_strings)
	{
		int m2 = 0,n2 = 0;
		GetRhsVar(2,MATRIX_OF_STRING_DATATYPE,&m2,&n2,&Str2);
		mn2 = m2*n2;
	}
	else
	{
		freeArrayOfString(Str,mn);
		Scierror(36, _("%s: Wrong type for input argument #%d: Single string expected.\n"), fname,2);
		return 0;
	}

	if (mn2 != 1)
	{
		freeArrayOfString(Str2,mn2);
		Scierror(36, _("%s: Wrong size for input argument #%d: Single string expected.\n"), fname,2);
		return 0;
	}

	if ( (int)strlen(Str[0]) == 0 )
	{
		values_start = (int *)MALLOC(sizeof(int));
		values_end = (int *)MALLOC(sizeof(int));

		wcvalues_start = (int *)MALLOC(sizeof(int));
		wcvalues_end = (int *)MALLOC(sizeof(int));
	}
	else
	{
		values_start = (int *)MALLOC( sizeof(int) * ( strlen(Str[0]) ) );
		values_end = (int *)MALLOC( sizeof(int) * ( strlen(Str[0]) ) );

		wcvalues_start = (int *)MALLOC( sizeof(int) * ( strlen(Str[0]) ) );
		wcvalues_end = (int *)MALLOC( sizeof(int) * ( strlen(Str[0]) ) );
	}

	if (Rhs == 2 )
	{
		typ = CHAR_S;
	}
	else /* Rhs == 3 */
	{
		int m3 = 0, n3 = 0, l3 = 0;

		GetRhsVar(3,STRING_DATATYPE,&m3,&n3,&l3);

		if ( m3*n3 != 0) typ = cstk(l3)[0];
		if (typ != STR_ONCE)
		{
			freeArrayOfString(Str,mn);
			freeArrayOfString(Str2,mn2);
			Scierror(999,_("%s: Wrong type for input argument #%d: '%s' expected.\n"),fname,3,"o");
			return 0;
		}
	}

	{
		int x = 0;
		pcre_error_code answer = PCRE_FINISHED_OK;

		int start_point = 0;
		int Output_Start = 0;
		int Output_End = 0;

		int wcOutput_Start = 0;
		int wcstart_point = 0;
		int wcOutput_End = 0;

		for (x = 0; x < mn2; ++x)
		{
			char *save = strdup(Str2[x]);
			if (save)
			{
				char *pointer = Str[0];
				start_point = 0;
				wcstart_point = 0;
				do
				{
					strcpy(save,Str2[x]);
					Output_Start = 0;
					Output_End = 0;

					answer = pcre_private(pointer,save,&Output_Start,&Output_End);
					if ( answer == PCRE_FINISHED_OK )
					{
						/* Start = End means that we matched a position and 0 characters.
						* Matching 0 characters, for us, means no match.
						*/
						if (Output_Start != Output_End)
						{
							char *	strOutput_Start = strdup(pointer);
							char *  strOutput_End =  strdup(pointer);

							wchar_t *wcstrOutput_Start = NULL;
							wchar_t *wcstrOutput_End = NULL;

							/* calculates positions with wide characters */
							strOutput_Start[Output_Start] = '\0';
							strOutput_End[Output_End] = '\0';

							wcstrOutput_Start = to_wide_string(strOutput_Start);
							wcstrOutput_End = to_wide_string(strOutput_End);

							if (wcstrOutput_Start)
							{
								wcOutput_Start = (int)wcslen(wcstrOutput_Start);
								FREE(wcstrOutput_Start);wcstrOutput_Start = NULL;
							}
							else
							{
								wcOutput_Start = 0;
							}

							if (wcstrOutput_End)
							{
								wcOutput_End = (int)wcslen(wcstrOutput_End);
								FREE(wcstrOutput_End);wcstrOutput_End = NULL;
							}
							else
							{
								wcOutput_End = 0;
							}

							if (strOutput_Start) {FREE(strOutput_Start); strOutput_Start = NULL;}
							if (strOutput_End) {FREE(strOutput_End); strOutput_End = NULL;}

							/*adding the answer into the outputmatrix*/
							values_start[nbValues_start] = Output_Start + start_point + 1;
							values_end[nbValues_end] = Output_End + start_point;

							wcvalues_start[nbValues_start] = wcOutput_Start + wcstart_point + 1;
							wcvalues_end[nbValues_end] = wcOutput_End + wcstart_point;

							nbValues_start++;
							nbValues_end++;

							/*The number according to the str2 matrix*/
							nbposition++;
						}
						else if(Output_End == 0 && *pointer != '\0')
						{
							/* Avoid an infinite loop */
							pointer++;
						}

						pointer = &pointer[Output_End];
						start_point = start_point + Output_End ;
						wcstart_point = wcstart_point + wcOutput_End ;
					}
					else
					{
						if (answer != NO_MATCH)
						{
							pcre_error(fname,answer);
							freeArrayOfString(Str,mn);
							freeArrayOfString(Str2,mn2);
							return 0;
						}
					}
				}
				while( (answer == PCRE_FINISHED_OK) && (*pointer != '\0') &&  (typ != STR_ONCE) );

				if (save) {FREE(save);save=NULL;}
			}
			else
			{
				freeArrayOfString(Str,mn);
				freeArrayOfString(Str2,mn2);
				Scierror(999, _("%s: No more memory.\n"),fname);
				return 0;
			}
		}
	}

	numRow   = 1; /* Output values[] */
	outIndex = 0;
	CreateVar(Rhs+1,MATRIX_OF_DOUBLE_DATATYPE,&numRow,&nbValues_start,&outIndex);
	for ( i = 0 ; i < nbValues_start ; i++ )
	{
		stk(outIndex)[i] = (double)wcvalues_start[i] ;
	}
	LhsVar(1) = Rhs+1 ;

	if (Lhs >= 2)
	{
		numRow   = 1;
		outIndex = 0;
		CreateVar(Rhs+2,MATRIX_OF_DOUBLE_DATATYPE,&numRow,&nbValues_end,&outIndex);
		for ( i = 0 ; i < nbposition ; i++ )
		{
			stk(outIndex)[i] = (double)wcvalues_end[i] ;
		}
		LhsVar(2) = Rhs+2;
	}

	if (Lhs == 3)
	{
		if (nbValues_start != 0)
		{
			char **match = (char**)MALLOC(sizeof(char*)*(nbValues_start));

			if (match == NULL)
			{
				freeArrayOfString(Str, mn);
				freeArrayOfString(Str2, mn2);

				Scierror(999, _("%s: No more memory.\n"),fname);
				return 0;
			}

			for( i = 0; i < nbValues_start; i++)
			{
				int len = values_end[i] - values_start[i] + 1;
				match[i] = (char*)MALLOC(sizeof(char)*(len + 1));
				strncpy(match[i], Str[0] + values_start[i] - 1, len);

				/* A char* always finished by \0 */
				match[i][len] = '\0';
			}

			numRow =  nbValues_start;
			outIndex = 1 ;
			CreateVarFromPtr(Rhs + 3,MATRIX_OF_STRING_DATATYPE, &numRow, &outIndex, match );
			LhsVar(3) = Rhs + 3 ;
			freeArrayOfString(match,nbValues_start);
		}
		else
		{
			int m3 = 0, n3 = 0, l3 = 0;
			CreateVar(Rhs+3,STRING_DATATYPE,  &m3, &n3, &l3);
			LhsVar(3) = Rhs + 3 ;
		}
	}

	freeArrayOfString(Str, mn);
	freeArrayOfString(Str2, mn2);
	if (values_start) {FREE(values_start); values_start = NULL;}
	if (values_end) {FREE(values_end); values_end = NULL;}
	if (wcvalues_start) {FREE(wcvalues_start); wcvalues_start = NULL;}
	if (wcvalues_end) {FREE(wcvalues_end); wcvalues_end = NULL;}

	PutLhsVar();
	return 0;
}
Beispiel #15
0
/*--------------------------------------------------------------------------*/
int sci_qp_solve(char *fname, unsigned long fname_len)
{
    static int un = 1, deux = 2;
    // n : first dimension of Q
    // nbis : second dimension of Q (nbis is expected to be equal to n)
    static int Q = 0, n = 0, nbis = 0;
    static int p = 0, unbis = 0;
    static int C = 0, m = 0;
    static int b = 0, mbis = 0;
    static int me = 0, pipo = 0;
    static int x = 0, iter = 0, iact = 0, nact = 0, crval = 0, ierr = 0;
    int r = 0;
    static int lw = 0,  k = 0;
    static SciSparse Sp;
    static int issparse = 0;
    double *work = NULL;

    /*   Check rhs and lhs   */
    CheckRhs(5, 5) ;
    CheckLhs(1, 4) ;

    /*Warning this interface does not support arguments passed by reference */

    /* RhsVar: qp_solve(Q,p,C,b,me) */
    /*                1,2,3,4,5   */

    /*   Variable 1 (Q)   */
    GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &n, &nbis, &Q);
    CheckSquare(1, n, nbis);

    /*   Variable 2 (p)   */
    GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &nbis, &unbis, &p);
    CheckLength(2, nbis * unbis, n);

    /*   Variable 3 (C)   */
    issparse =  (GetType(3) == 5);
    if (!issparse)
    {
        GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &nbis, &m, &C);
    }
    else
    {
        GetRhsVar(3, SPARSE_MATRIX_DATATYPE, &nbis, &m, &Sp);
    }

    if ( nbis != n ) // car C est passee en transposee dans la macro qpsolve
    {
        Scierror(999, _("%s: Wrong size for input argument #%d: %d column(s) expected for matrix %s.\n"), fname, 3, n, "C");
        return 0;
    }

    /*   Variable 4 (b)   */
    GetRhsVar(4, MATRIX_OF_DOUBLE_DATATYPE, &mbis, &unbis, &b);
    CheckLength(4, mbis * unbis, m);

    /*   Variable 5 (me)   */
    GetRhsVar(5, MATRIX_OF_INTEGER_DATATYPE, &pipo, &unbis, &me);
    CheckScalar(5, pipo, unbis);
    if ((*istk(me) < 0) || (*istk(me) > n))
    {
        Scierror(999, _("%s: Wrong value for input argument #%d: %s must be an integer in the range 0 to %d.\n"), fname, 5, "me", n);
        return 0;
    }

    /* Lhs variables: x, iact, iter, crval */
    CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &n, &un, &x);
    CreateVar(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &m, &un, &iact);
    CreateVar(Rhs + 3, MATRIX_OF_INTEGER_DATATYPE, &deux, &un, &iter);
    CreateVar(Rhs + 4, MATRIX_OF_DOUBLE_DATATYPE, &un, &un, &crval);

    r = Min(n, m);
    lw =  2 * n + r * (r + 5) / 2 + 2 * m + 1;
    if ((work = (double *)MALLOC(lw * sizeof(double))) == NULL)
    {
        Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
    }
    /* change the sign of  C and b.*/
    ierr = 0;
    if (!issparse)
    {
        /* linear constraints matrix is stored full */
        C2F(qpgen2)(stk(Q), stk(p), &n, &n,  stk(x), stk(crval), stk(C),
                    stk(b), &n, &m, istk(me), istk(iact), &nact, istk(iter), work,
                    &ierr);
    }
    else
    {
        /* linear constraints matrix is a sparse matrix */
        /* Change the linear constraints matrix representation:
        qpgen1sci requires column-compressed sparse matrix internal
        representation while Scilab sparse matrices are row-compressed */
        double *R = NULL, *I = NULL;
        int *ind = NULL;

        if ((R = (double *)MALLOC(Sp.nel * sizeof(double))) == NULL)
        {
            FREE(work);
            work = NULL;
            Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
        }
        if ((ind = (int *)MALLOC((m + Sp.nel) * sizeof(int))) == NULL)
        {
            FREE(work);
            work = NULL;
            FREE(R);
            R = NULL;
            Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
        }

        // Transpose the sparse matrix A
        C2F(spt)(&n, &m, &(Sp.nel) ,  &(Sp.it), (int *)work,
                 Sp.R,  Sp.I,  Sp.mnel,  Sp.icol, R, I, ind, ind + m);

        C2F(qpgen1sci)(stk(Q), stk(p), &n, &n,  stk(x), stk(crval),
                       ind, ind + m,  R,
                       stk(b), &m, istk(me), istk(iact), &nact, istk(iter),
                       work, &ierr);
        FREE(work);
        work = NULL;
        FREE(R);
        R = NULL;
        FREE(ind);
        ind = NULL;
    }
    for (k = nact; k < m; k++) istk(iact)[k] = 0;
    /* LhsVar: [x, iact, iter, f] = qp_solve(...) */

    if (ierr == 0)
    {
        for (k = 0; k < Lhs; k++) LhsVar(1 + k) = Rhs + 1 + k;
        PutLhsVar();
    }
    else if (ierr == 1)
    {
        Scierror(999, _("%s: The minimization problem has no solution.\n"), fname);
    }
    else if (ierr == 2)
    {
        Scierror(999, _("%s: Q is not symmetric positive definite.\n"), fname);
    }
    return 0;
}
Beispiel #16
0
/*--------------------------------------------------------------------------*/
int sci_mget(char *fname,unsigned long fname_len)
{
	int m1 = 0, n1 = 0, l1 = 0;
	int m2 = 0, n2 = 0, l2 = 0;
	int	m3 = 0, n3 = 0, l3 = 0;
	int l4 = 0;
	int err = 0;
	char *type = NULL;
	int fd = ALL_FILES_DESCRIPTOR;
	int n = 1;
	int one = 1;

	Nbvars = 0;
	CheckRhs(1,3);
	CheckLhs(1,1);

	if ( Rhs >= 1)
	{
		if (GetType(1) == sci_matrix)
		{
			GetRhsVar(1,MATRIX_OF_INTEGER_DATATYPE,&m1,&n1,&l1);
			if (m1*n1 == 1)
			{
				n  = *istk(l1);
			}
			else
			{
				Scierror(999, _("%s: Wrong size for input argument #%d: An integer expected.\n"), fname,1);
				return 0;
			}
		}
		else
		{
			Scierror(999, _("%s: Wrong type for input argument #%d: An integer expected.\n"), fname,1);
			return 0;
		}
	}

	if ( Rhs >= 2)
	{
		if (GetType(2) == sci_strings)
		{
			GetRhsVar(2,STRING_DATATYPE,&m2,&n2,&l2);
			type = cstk(l2);
		}
		else
		{
			Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname,2);
			return 0;
		}
	}
	else
	{
		type = LIST_DATATYPE;
	}

	if ( Rhs >= 3)
	{
		if (GetType(3) == sci_matrix)
		{
			GetRhsVar(3,MATRIX_OF_INTEGER_DATATYPE,&m3,&n3,&l3);
			if (m3*n3 == 1)
			{
				fd = *istk(l3);
			}
			else
			{
				Scierror(999, _("%s: Wrong size for input argument #%d: An integer expected.\n"), fname,3);
				return 0;
			}
		}
		else
		{
			Scierror(999, _("%s: Wrong type for input argument #%d: An integer expected.\n"), fname,3);
			return 0;
		}
	}

	CreateVar(Rhs+1,MATRIX_OF_DOUBLE_DATATYPE,&one,&n,&l4);
	LhsVar(1) = Rhs+1;

	C2F(mget)(&fd,stk(l4),&n,type,&err);

	if (err >  0)
	{
		SciError(10000);
		return 0;
	}
	else if ( err < 0)
	{
		int n5 = 0, l5 = 0, i = 0;
		/* n contains now the effectively read data */
		n5 = -err -1;
		if ( n5 < n )
		{
			CreateVar(Rhs+2, MATRIX_OF_DOUBLE_DATATYPE, &one, &n5, &l5);

			for ( i = 0; i < n5 ; i++) 
			{
				*stk(l5+i) = *stk(l4+i);
			}

			LhsVar(1) = Rhs + 2;
		}
	}

	PutLhsVar();

	return 0;
}
Beispiel #17
0
/*--------------------------------------------------------------------------*/
int sci_mclose(char *fname, unsigned long fname_len)
{
    int m1 = 0, n1 = 0, l1 = 0;
    int one = 1, l2 = 0;
    int fd = ALL_FILES_DESCRIPTOR;

    Nbvars = 0;
    CheckRhs(0, 1);
    CheckLhs(1, 1);

    if (Rhs == 0)
    {
        fd = ALL_FILES_DESCRIPTOR;
        CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &one, &one, &l2);

        C2F(mclose)(&fd, stk(l2));

        LhsVar(1) = Rhs + 1;
        PutLhsVar();
    }
    else /* Rhs == 1 */
    {
        if (GetType(1) == sci_matrix)
        {
            GetRhsVar(1, MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &l1);
            if (m1*n1 == 1)
            {
                fd = *istk(l1);
                CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &one, &one, &l2);

                C2F(mclose)(&fd, stk(l2));

                LhsVar(1) = Rhs + 1;
                PutLhsVar();
            }
            else
            {
                Scierror(999, _("%s: Wrong size for input argument #%d: An integer expected.\n"), fname, 1);
            }
        }
        else if (GetType(1) == sci_strings)
        {
            char **input_string = NULL;

            GetRhsVar(1 , MATRIX_OF_STRING_DATATYPE, &m1, &n1, &input_string);
            if (m1*n1 == 1)
            {
                double err = 0.0;

                if (strcmp(input_string[0], "all") == 0)
                {
                    fd = ALL_FILES_DESCRIPTOR;
                }
                else
                {
                    fd = GetIdFromFilename(input_string[0]);
                }

                if ( (fd == FILE_ID_NOT_DEFINED) && getWarningMode() )
                {
                    sciprint(_("%s: No such file %s.\n"), fname, input_string[0]);
                }
                else
                {
                    C2F(mclose)(&fd, &err);
                }

                freeArrayOfString(input_string, m1 * n1);

                CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &one, &one, &l2);
                *stk(l2) = err;

                LhsVar(1) = Rhs + 1;
                PutLhsVar();
            }
            else
            {
                freeArrayOfString(input_string, m1 * n1);
                Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 1);
            }
        }
        else
        {
            Scierror(999, _("%s: Wrong type for input argument #%d: An integer or string expected.\n"), fname, 1);
        }
    }
    return 0;
}
Beispiel #18
0
/*--------------------------------------------------------------------------*/
int sci_prompt(char *fname, unsigned long fname_len)
{
    char currentPrompt[PROMPT_SIZE_MAX];
    static int n1 = 0, m1 = 0, l1 = 0;
    int outIndex = 0 ;

    CheckRhs(0, 1);
    CheckLhs(0, 2);

    if (Rhs == 0) /* Get current Scilab prompt */
    {
        GetCurrentPrompt(currentPrompt);

        m1 = (int)strlen(currentPrompt);
        n1 = 1;
        CreateVar( Rhs + 1, STRING_DATATYPE, &m1, &n1, &outIndex);
        strcpy(cstk(outIndex), currentPrompt);

        if (Lhs == 2)
        {
            m1 = 1;
            n1 = 1;
            l1 = 0;

            CreateVar( Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &l1 );
            *istk(l1) = (int)C2F(recu).paus ;
        }

        LhsVar(1) = Rhs + 1;
        if (Lhs == 2)
        {
            LhsVar(2) = Rhs + 2;
        }
        PutLhsVar();
    }
    else /* Tempory change of Scilab prompt */
    {
        if (Lhs <= 1)
        {
            if (VarType(1) != sci_strings)
            {
                Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 1);
                return FALSE;
            }

            GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);

            if (n1 != 1)
            {
                Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 1);
                return FALSE;
            }

            SetTemporaryPrompt(cstk(l1));

            LhsVar(1) = 0;
            PutLhsVar();
        }
        else
        {
            Scierror(999, _("%s: Wrong number of output argument(s).\n"), fname);
        }
    }
    return 0;
}
Beispiel #19
0
/*--------------------------------------------------------------------------*/
int intbsplin3val(char *fname, unsigned long fname_len)
{
    /*
    *   [fp] = bsplin3val(xp, yp, zp, tlcoef, der)
    */

    int minrhs = 5, maxrhs = 5, minlhs = 1, maxlhs = 1;

    int mxp = 0, nxp = 0, lxp = 0, myp = 0, nyp = 0, lyp = 0, mzp = 0, nzp = 0, lzp = 0;
    int  mt = 0, nt = 0, lt = 0, m1 = 0, n1 = 0, np = 0;
    int one = 1, kx = 0, ky = 0, kz = 0;
    int nx = 0, ny = 0, nz = 0, nxyz = 0, mtx = 0, mty = 0, mtz = 0, m = 0, n = 0, ltx;
    int lty = 0, ltz = 0, lbcoef = 0, mwork = 0, lwork = 0, lfp = 0;
    int i = 0, mder = 0, nder = 0, lder = 0, ox = 0, oy = 0, oz = 0;
    double *fp = NULL, *xp = NULL, *yp = NULL, *zp = NULL, *der = NULL;
    SciIntMat Order;
    int *order = NULL;
    char **Str = NULL;;

    CheckRhs(minrhs, maxrhs);
    CheckLhs(minlhs, maxlhs);

    GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &lxp);
    xp = stk(lxp);
    GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &myp, &nyp, &lyp);
    yp = stk(lyp);
    GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &mzp, &nzp, &lzp);
    zp = stk(lzp);

    for (i = 1; i <= 3; i++)
    {
        SciErr sciErr;
        int *piAddressVar = NULL;
        sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
        if (sciErr.iErr)
        {
            printError(&sciErr, 0);
            Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
            return 0;
        }

        if (isVarComplex(pvApiCtx, piAddressVar))
        {
            Scierror(202, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), fname, i);
            return 0;
        }
    }

    if ( mxp != myp  ||  nxp != nyp || mxp != mzp  ||  nxp != nzp)
    {
        Scierror(999, _("%s: Wrong size for input arguments #%d, #%d and #%d: Same sizes expected.\n"), fname, 1, 2, 3);
        return 0;
    }
    np = mxp * nxp;

    GetRhsVar(4, TYPED_LIST_DATATYPE, &mt, &nt, &lt);
    GetListRhsVar(4, 1, MATRIX_OF_STRING_DATATYPE, &m1,  &n1, &Str);

    if ( strcmp(Str[0], "tensbs3d") != 0)
    {
        /* Free Str */
        if (Str)
        {
            int li = 0;
            while (Str[li] != NULL)
            {
                FREE(Str[li]);
                li++;
            };
            FREE(Str);
            Str = NULL;
        }
        Scierror(999, _("%s: Wrong type for input argument #%d: %s tlist expected.\n"), fname, 4, "tensbs3d");
        return 0;
    }
    /* Free Str */
    if (Str)
    {
        int li = 0;
        while (Str[li] != NULL)
        {
            FREE(Str[li]);
            li++;
        };
        FREE(Str);
        Str = NULL;
    }

    GetListRhsVar(4, 2, MATRIX_OF_DOUBLE_DATATYPE, &mtx, &n,  &ltx);
    GetListRhsVar(4, 3, MATRIX_OF_DOUBLE_DATATYPE, &mty, &n,  &lty);
    GetListRhsVar(4, 4, MATRIX_OF_DOUBLE_DATATYPE, &mtz, &n,  &ltz);
    GetListRhsVar(4, 5, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m  , &n,  (int *)&Order);
    GetListRhsVar(4, 6, MATRIX_OF_DOUBLE_DATATYPE, &nxyz, &n,  &lbcoef);

    GetRhsVar(5, MATRIX_OF_DOUBLE_DATATYPE, &mder, &nder, &lder);
    der = stk(lder);
    if (   mder*nder != 3
        || der[0] != floor(der[0]) || der[0] < 0.0
        || der[1] != floor(der[1]) || der[1] < 0.0
        || der[2] != floor(der[2]) || der[2] < 0.0 )
    {
        Scierror(999, _("%s: Wrong values for input argument #%d.\n"), fname, 5);
        return 0;
    }
    ox = (int) der[0];
    oy = (int) der[1];
    oz = (int) der[2];

    CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &lfp);
    fp = stk(lfp);

    order = (int *)Order.D;
    kx = order[0];
    ky = order[1];
    kz = order[2];
    nx = mtx - kx;
    ny = mty - ky;
    nz = mtz - kz;

    mwork = ky * kz + 3 * Max(kx, Max(ky, kz)) + kz;
    CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &mwork, &one, &lwork);

    for (i = 0; i < np; i++)
    {
        fp[i] = C2F(db3val)(&(xp[i]), &(yp[i]), &(zp[i]), &ox, &oy, &oz,
            stk(ltx), stk(lty), stk(lty), &nx, &ny, &nz,
            &kx, &ky, &kz, stk(lbcoef), stk(lwork));
    }

    LhsVar(1) = Rhs + 1;
    PutLhsVar();
    return 0;
}
Beispiel #20
0
/*----------------------------------------------------------
 * int_imfinfo: 
 *     interface for imfinfo function.
 *     should provide  type=imfinfo(name)  at Scilab level 
 * $Revision: 1.3 $ $Date: 2009-04-14 14:02:45 $
 *----------------------------------------------------------*/
SipExport int 
int_imfinfo(char *fname)
{
   /* Interface variables */ 
   int   mC, nC, lC,  /* for name input  arg */
         mV, nV, lV,  /* for "verbose" optional input arg */
         mL=12, nL=1, lL,  /* for list output arg */
         mS=1, nS=12,
         mFileName, nFileName=1, 
         mFileSize=1, nFileSize=1,
         mFormat, nFormat=1, 
         mWidth=1, nWidth=1, 
         mHeight=1, nHeight=1, 
         mDepth=1, nDepth=1, 
         mStorageType, nStorageType=1, 
         mNumberOfColors=1, nNumberOfColors=1, 
         mResolutionUnit, nResolutionUnit=1, 
         mXResolution=1, nXResolution=1, 
         mYResolution=1, nYResolution=1, 
         pos,
         minlhs=1, maxlhs=1, minrhs=1, maxrhs=2, i;
   unsigned long int *lWidth, *lHeight, *lDepth, *lNumberOfColors,
                     *lFileSize, fsize;
   char *lFileName, *lStorageType, *lFormat, *lResolutionUnit, *arg2;
   double *lXResolution, *lYResolution;
   static char 
      *Str[]= {   "type", "FileName", "FileSize", "Format", 
                  "Width", "Height", "Depth", "StorageType", 
                  "NumberOfColors", "ResolutionUnit", "XResolution", 
                  "YResolution" }; 

   /* ImageMagick variables */
   ExceptionInfo  exception;
   Image          *image;
   ImageInfo      *image_info;

   CheckRhs(minrhs, maxrhs);
   CheckLhs(minlhs, maxlhs);


   /* Get name (#1) and "verbose" optional arg (#2)*/
   GetRhsVar(1, "c", &mC, &nC, &lC);  
   if (Rhs == 2) {
      GetRhsVar(2, "c", &mV, &nV, &lV);
      arg2 = (char *)calloc(strlen(cstk(lV))+1, sizeof(char));
      if (!arg2)
         sip_error("unable to alloc memory");
      strcpy(arg2,cstk(lV));
   }

   InitializeMagick(NULL);
   GetExceptionInfo(&exception);
   image_info=CloneImageInfo((ImageInfo *) NULL);
   (void) strcpy(image_info->filename,cstk(lC));

   image = PingImage(image_info, &exception);
   if (image == (Image *) NULL) {
      /* clean up */
      if (Rhs==2)
        free(arg2);
      if(exception.reason != NULL) {
         char errmsg[50];
         for (i=0; i<49; i++)
            errmsg[i]=' ';
         errmsg[49]='\0';
         strncpy(errmsg,GetLocaleExceptionMessage(exception.severity,exception.reason),50);
         DestroyImageInfo(image_info);
         DestroyExceptionInfo(&exception);
         DestroyMagick();
         sip_error(errmsg);
      }
      DestroyImageInfo(image_info);
      DestroyExceptionInfo(&exception);
      DestroyMagick();
      sip_error("unknown reason");
   }

   pos =1;
   CreateVar(1, "t", &mL, &nL, &lL);
   CreateListVarFromPtr(1,pos++,"S", &mS, &nS, Str);

   lFileName = image->filename;
   mFileName = strlen(image->filename);
   CreateListVarFromPtr(1,pos++,"c", &mFileName, &nFileName, &lFileName);

   fsize = SizeBlob(image);
   lFileSize = &fsize;
   CreateListVarFromPtr(1,pos++,"i", &mFileSize, &nFileSize, &lFileSize);

   lFormat = image->magick;
   mFormat = strlen(image->magick);
   CreateListVarFromPtr(1,pos++,"c", &mFormat, &nFormat, &lFormat);

   lWidth = &(image->columns);
   CreateListVarFromPtr(1,pos++,"i", &mWidth, &nWidth, &lWidth);

   lHeight = &(image->rows);
   CreateListVarFromPtr(1,pos++,"i", &mHeight, &nHeight, &lHeight);

   lDepth = &(image->depth);
   CreateListVarFromPtr(1,pos++,"i", &mDepth, &nDepth, &lDepth);

   lStorageType = (image->storage_class == DirectClass)? "truecolor":"indexed";
   mStorageType = strlen(lStorageType);
   CreateListVarFromPtr(1,pos++,"c", &mStorageType, &nStorageType, &lStorageType);

   lNumberOfColors = &(image->colors);
   CreateListVarFromPtr(1,pos++,"i", &mNumberOfColors, \
                                     &nNumberOfColors, &lNumberOfColors);

   /*
   lComments = image->comments;
   mComments = strlen(image->comments);
   CreateListVarFromPtr(1,pos++,"c", &mComments, &nComments, &lComments);
   */

   lResolutionUnit = (image->units == PixelsPerInchResolution)?"inch":"centimeter";
   mResolutionUnit = strlen(lResolutionUnit);
   CreateListVarFromPtr(1,pos++,"c", &mResolutionUnit, \
                                     &nResolutionUnit, &lResolutionUnit);

   lXResolution = &(image->x_resolution);
   CreateListVarFromPtr(1,pos++,"i", &mXResolution, &nXResolution, &lXResolution);

   lYResolution = &(image->y_resolution);
   CreateListVarFromPtr(1,pos++,"i", &mYResolution, &nYResolution, &lYResolution);

   if (Rhs==2) {
      if (strcmp(arg2,"verbose") != 0)
         sip_error("invalid 2nd argument");
      sciprint("       FileName: %s\n\r", image->filename);
      sciprint("       FileSize: %d\n\r", fsize);
      sciprint("         Format: %s\n\r", image->magick);
      sciprint("          Width: %d\n\r", image->columns);
      sciprint("         Height: %d\n\r", image->rows);
      sciprint("          Depth: %d\n\r", image->depth);
      sciprint("    StorageType: %s\n\r", lStorageType);
      sciprint(" NumberOfColors: %d\n\r", image->colors);
      sciprint(" ResolutionUnit: %s\n\r", lResolutionUnit);
      sciprint("    XResolution: %f\n\r", image->x_resolution);
      sciprint("    YResolution: %f\n\r", image->y_resolution);
      free(arg2);
   }

   /* Terminate Imagemagick */
   DestroyImageInfo(image_info);
   DestroyImage(image);
   DestroyExceptionInfo(&exception);
   DestroyMagick();

   /*  Return variables  */
   LhsVar(1) = 1;
   return true;
}
Beispiel #21
0
/*--------------------------------------------------------------------------*/
int intinterp1(char *fname, unsigned long fname_len)
{
    int minrhs = 4, maxrhs = 5, minlhs = 1, maxlhs = 4;

    int mt = 0, nt = 0, lt = 0, mx = 0, nx = 0, lx = 0, my = 0, ny = 0, ly = 0, md = 0, nd = 0, ld = 0, ns = 0;
    int *str_outmode = NULL;
    int n = 0, m = 0, outmode = 0, lst = 0, ldst = 0, lddst = 0, ldddst = 0;
    int i = 0;

    CheckRhs(minrhs, maxrhs);
    CheckLhs(minlhs, maxlhs);

    GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mt, &nt, &lt);
    GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
    GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &my, &ny, &ly);
    GetRhsVar(4, MATRIX_OF_DOUBLE_DATATYPE, &md, &nd, &ld);

    if ( mx != my  ||  nx != ny  ||  md != mx || nd != nx || (mx != 1  &&  nx != 1) || mx*nx < 2)
    {
        Scierror(999,_("%s: Wrong size for input arguments #%d and #%d: Same sizes expected.\n"),fname,2,3);
        return 0;
    }
    n = mx * nx;    /* number of interpolation points */
    m = mt * nt;    /* number of points to interpolate */

    for (i = 1; i <= minrhs; i++)
    {
        SciErr sciErr;
        int *piAddressVar = NULL;
        sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
        if(sciErr.iErr)
        {
            printError(&sciErr, 0);
            Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
            return 0;
        }

        if (isVarComplex(pvApiCtx, piAddressVar))
        {
            Scierror(202, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), fname, i);
            return 0;
        }
    }

    if ( Rhs == 5 )   /* get the outmode */
    {
        GetRhsScalarString(5, &ns, &str_outmode);
        outmode = get_type(OutModeTable, NB_OUTMODE, str_outmode, ns);
        if ( outmode == UNDEFINED )
        {
            Scierror(999,_("%s: Wrong values for input argument #%d: Unknown '%s' type.\n"),fname,5,"outmode");
            return 0;
        };
    }
    else
    {
        outmode = C0;  /* default outmode */
    }

    /* memory for st, dst, ddst, dddst */
    CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &mt,  &nt, &lst);
    CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &mt,  &nt, &ldst);
    CreateVar(Rhs + 3, MATRIX_OF_DOUBLE_DATATYPE, &mt,  &nt, &lddst);
    CreateVar(Rhs + 4, MATRIX_OF_DOUBLE_DATATYPE, &mt,  &nt, &ldddst);

    /*      subroutine EvalPWHermite(t, st, dst, ddst, dddst, m, x, y, d, n, outmode)
    *      int m, n, outmode
    *      double precision t(m), st(m), dst(m), ddst(m), dddst(m), x(n), y(n), d(n)
    */
    C2F(evalpwhermite) (stk(lt), stk(lst), stk(ldst), stk(lddst), stk(ldddst),
        &m, stk(lx), stk(ly), stk(ld), &n, &outmode);

    LhsVar(1) = Rhs + 1;
    LhsVar(2) = Rhs + 2;
    LhsVar(3) = Rhs + 3;
    LhsVar(4) = Rhs + 4;
    PutLhsVar();
    return 0;
}
/*--------------------------------------------------------------------------*/
int get_style_arg(char *fname,int pos, int n1,rhs_opts opts[], int ** style )
{
  int m,n,l,first_opt=FirstOpt(),kopt,un=1,ix,i,l1;

  Nbvars = Max(Nbvars,Rhs);


  if ( pos < first_opt ) /* regular argument  */
  {
    if (VarType(pos))
    {
	    GetRhsVar(pos,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
	    if (m * n < n1)
      {
	      Scierror(999,_("%s: Wrong size for input argument #%d: %d < %d expected.\n"),fname,pos, m*n,n1);
	      return 0;
	    }
	    if ( n1 == 1 && m * n == 1 )
      {
	      ix = 2;
	      CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l1);
	      *istk(l1)=*istk(l);
	      *istk(l1+1)=1;
	      l=l1;
	    }
	    *style = istk(l);
    }
    else /* zero type argument --> default value */
	  {
	    ix = Max(n1,2);
	    CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l);
	    for ( i = 0 ; i < n1 ; ++i )
      {
        *istk(l + i) = i+1 ;
      }
	    if (n1 == 1)
      {
        *istk(l + 1) = 1 ;
      }
	    *style = istk(l);
	  }
  }
  else if ((kopt=FindOpt("style",opts)))
  { /* named argument: style=value */
    GetRhsVar(kopt,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
    if (m * n < n1)
    {
		Scierror(999,_("%s: Wrong size for input argument #%d: %d < %d expected.\n"),fname,kopt,m*n,n1);
      return 0;
    }
    if (n1==1&&m*n==1)
    {
      ix = 2;
      CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l1);
      *istk(l1)=*istk(l);
      *istk(l1+1)=1;
      l=l1;
    }
    *style = istk(l);
  }
  else /* unspecified argument --> default value */
  {
    ix = Max(n1,2);
    CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l);
    for (i = 0 ; i < n1 ; ++i)
    {
      *istk(l + i) = i+1;
    }
    if (n1 == 1)
    {
      *istk(l +1) = 1;
    }
    *style = istk(l);
  }
  return 1;
}
Beispiel #23
0
/*--------------------------------------------------------------------------*/
int sci_gethistory(char *fname, unsigned long fname_len)
{
    static int l1 = 0, m1 = 0, n1 = 0;
    CheckRhs(0, 1);
    CheckLhs(1, 1);

    if (getNumberOfLinesInScilabHistory() <= 0)
    {
        m1 = 0;
        n1 = 0;
        CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE,  &m1, &n1, &l1);
        LhsVar(1) = Rhs + 1;
        PutLhsVar();
        return 0;
    }

    if (Rhs == 1)
    {
        if (GetType(1) == sci_matrix)
        {
            int N = 0;
            char *line = NULL;
            GetRhsVar(1, MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &l1);
            N = *istk(l1);
            line = getNthLineInScilabHistory(N);
            if (line)
            {
                n1 = 1;
                CreateVarFromPtr(Rhs + 1, STRING_DATATYPE, (m1 = (int)strlen(line), &m1), &n1, &line);
                FREE(line);
            }
            else
            {
                m1 = 0;
                n1 = 0;
                CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE,  &m1, &n1, &l1);
            }
        }
        else
        {
            Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), fname, 1);
            return 0;
        }
    }
    else
    {
        char **lines = NULL;
        int nblines = 0;

        nblines = getSizeAllLinesOfScilabHistory();
        lines = getAllLinesOfScilabHistory();

        if (lines)
        {
            int m = 0, n = 0;

            m = nblines;
            n = 1;

            CreateVarFromPtr(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &m, &n, lines);

            freeArrayOfString(lines, nblines);
        }
        else
        {
            m1 = 0;
            n1 = 0;
            CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE,  &m1, &n1, &l1);
        }
    }

    LhsVar(1) = Rhs + 1;
    PutLhsVar();
    return 0;
}
Beispiel #24
0
/*-------------------------------------------------------------------------------------*/
static int sci_strcat_two_rhs(char *fname)
{
    int Type_One = VarType(1);
    int Type_Two = VarType(2);

    int Number_Inputs_Two = 0;
    char **Input_String_Two = NULL;

    if (Type_Two != sci_strings)
    {
        Scierror(246, _("%s: Wrong type for input argument #%d: Single string expected.\n"), fname, 2);
        return 0;
    }
    else                        /* sci_strings */
    {
        int Row_Two = 0, Col_Two = 0;

        GetRhsVar(2, MATRIX_OF_STRING_DATATYPE, &Row_Two, &Col_Two, &Input_String_Two);
        Number_Inputs_Two = Row_Two * Col_Two;
        /* check we have only a string as second parameter */
        if (Number_Inputs_Two != 1)
        {
            freeArrayOfString(Input_String_Two, Number_Inputs_Two);
            Scierror(36, "%s : Wrong size for input argument #%d: Single string expected.\n", fname, 2);
            return 0;
        }
    }

    if ((Type_One != sci_strings) && (Type_One != sci_matrix))
    {
        freeArrayOfString(Input_String_Two, Number_Inputs_Two);
        Scierror(246, "%s: Wrong type for input argument #%d: Matrix of strings expected.\n", fname, 1);
        return 0;
    }
    else
    {
        if (Type_One == sci_matrix)
        {
            freeArrayOfString(Input_String_Two, Number_Inputs_Two);
            sci_strcat_rhs_one_is_a_matrix(fname);
        }
        else                    /* sci_strings */
        {
            char **Input_String_One = NULL;
            int Row_One = 0, Col_One = 0;
            int Number_Inputs_One = 0;
            int length_output = 0;

            GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &Row_One, &Col_One, &Input_String_One);
            Number_Inputs_One = Row_One * Col_One;

            if (Input_String_One)
            {
                if ((Number_Inputs_One == 1) && (strcmp(Input_String_One[0], "") == 0))
                {
                    /* With no input argument returns a zero length character string */
                    int m1 = 0, n1 = 0, l1 = 0;

                    CreateVar(Rhs + 1, STRING_DATATYPE, &m1, &n1, &l1);

                    freeArrayOfString(Input_String_Two, Number_Inputs_Two);
                    freeArrayOfString(Input_String_One, Number_Inputs_One);

                    LhsVar(1) = Rhs + 1;
                    PutLhsVar();
                    return 0;
                }
                else
                {
                    if (Number_Inputs_One == 1)
                    {
                        length_output = (int)strlen(Input_String_One[0]);
                    }
                    else
                    {
                        int lengthInput_String_Two = (int)strlen(Input_String_Two[0]);

                        length_output = sumlengthstring(1) + (int)(Number_Inputs_One) * lengthInput_String_Two - lengthInput_String_Two;
                    }
                }
            }

            if (length_output > 0)
            {
                static int n1 = 0, m1 = 0;
                int outIndex = 0;
                char *Output_String = NULL;
                int i = 0;
                int Number_Inputs_OneLessOne = Number_Inputs_One - 1;

                m1 = length_output;
                n1 = 1;

                CreateVar(Rhs + 1, STRING_DATATYPE, &m1, &n1, &outIndex);
                Output_String = cstk(outIndex);

                /* strcpy + strcat faster than sprintf */
                strcpy(Output_String, Input_String_One[0]);
                (0 < Number_Inputs_OneLessOne) ? strcat(Output_String, Input_String_Two[0]) : 0;

                for (i = 1; i < Number_Inputs_One; i++)
                {
                    strcat(Output_String, Input_String_One[i]);
                    (i < Number_Inputs_OneLessOne) ? strcat(Output_String, Input_String_Two[0]) : 0;
                }

                freeArrayOfString(Input_String_One, Row_One * Col_One);
                freeArrayOfString(Input_String_Two, Number_Inputs_Two);

                LhsVar(1) = Rhs + 1;
                PutLhsVar();
            }
            else
            {
                if (length_output == 0)
                {
                    int one = 1;
                    int len = (int)strlen(EMPTY_CHAR);
                    int outIndex = 0;

                    CreateVar(Rhs + 1, STRING_DATATYPE, &len, &one, &outIndex);
                    strcpy(cstk(outIndex), EMPTY_CHAR);

                    freeArrayOfString(Input_String_Two, Number_Inputs_Two);
                    freeArrayOfString(Input_String_One, Number_Inputs_One);

                    LhsVar(1) = Rhs + 1;
                    PutLhsVar();
                }
                else
                {
                    freeArrayOfString(Input_String_Two, Number_Inputs_Two);
                    freeArrayOfString(Input_String_One, Number_Inputs_One);
                    Scierror(999, _("%s : Wrong size for input argument(s).\n"), fname);
                }
            }
        }
    }
    return 0;
}
Beispiel #25
0
/*--------------------------------------------------------------------------*/
int sci_buildouttb(char *fname,unsigned long fname_len)
{
	static int l1 = 0, m1 = 0,   n1 = 0;
	static int l2 = 0, m2 = 0,   n2 = 0;
	static int l3 = 0, n3 = 1;
	SciIntMat M1,M2,M3;

	int n_lnksz = 0, n_lnktyp = 0;
	int *lnksz = NULL,*lnktyp = NULL;

	double *ptr_d = NULL;
	double *ptr_dc = NULL;
	int *ptr_i = NULL;
	short *ptr_s = NULL;
	char *ptr_c = NULL;
	int *ptr_ui = NULL;
	short *ptr_us = NULL;
	char *ptr_uc = NULL;

	int nm = 0,i = 0,j = 0,ierr = 0;

	static int minlhs=1, maxlhs=1;
	static int minrhs=2, maxrhs=2;

	/*check number of lhs/rhs*/
	CheckLhs(minlhs, maxlhs);
	CheckRhs(minrhs, maxrhs);

	/*check type of Rhs 1*/
	if (VarType(1) == 1)
	{
		GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
	}
	else if (VarType(1) == sci_ints)
	{
		GetRhsVar(1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &M1);
	}
	else
	{
		Scierror(888, _("%s : lnksz argument must be double or integer.\n"),fname);
		return 0;
	}

	/*check type of Rhs 2*/
	if (VarType(2) == 1)
	{
		GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &l2);
	}
	else if (VarType(2) == sci_ints)
	{
		GetRhsVar(2, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m2, &n2, &M2);
	}
	else
	{
		Scierror(888,_("%s : lnktyp argument must be double or integer.\n"),fname);
		if (lnksz!=NULL) FREE(lnksz);
		return 0;
	}

	/*check size of Rhs 1*/
	if (m1 == 2) n_lnksz = n1;
	else if (n1==2) n_lnksz = m1;
	/*void double input give void list output*/
	else if ((n1==0)||(m1==0))
	{
		if ((n2==0)||(m2==0))
		{
			/*manually code a void list on rhs(1)*/
			ptr_i = (int*)GetData(1);
			ptr_i[0] = sci_list;
			ptr_i[1] = 0;
			ptr_i[2] = 1;
			LhsVar(1) = 1;
			PutLhsVar();
			return 0;
		}
		else
		{
			Scierror(888, _("%s : inconsistent dimension between lnksz and lnktyp.\n"), fname);
			return 0;
		}
	}
	else
	{
		Scierror(888, _("%s : bad dimension for lnksz argument.\n"), fname);
		return 0;
	}

	/*check size of Rhs 2*/
	if (m2 == 1) n_lnktyp = n2;
	else if (n2 == 1) n_lnktyp = m2;
	else if ((n2 == 0)||(m2 == 0))
	{
		if ( (n1 != 0) && (m1 != 0) )
		{
			Scierror(888, _("%s : inconsistent dimension between lnksz and lnktyp.\n"),fname);
			return 0;
		}
	}
	else
	{
		Scierror(888, _("%s : bad dimension for lnktyp argument.\n"),fname);
		return 0;
	}

	/*cross size checking*/
	if (n_lnksz!=n_lnktyp)
	{
		Scierror(888, _("%s : lnksz and lnktyp argument must have the same length.\n"),fname);
		return 0;
	}

	/*allocate lnksz*/
	if ((lnksz=MALLOC(2*n_lnksz*sizeof(int)))==NULL)
	{
		Scierror(999, _("%s : No more free memory.\n"),fname);
		return 0;
	}

	/* Allocate lnktyp*/
	if ((lnktyp=MALLOC(n_lnktyp*sizeof(int)))==NULL)
	{
		Scierror(999, _("%s : No more free memory.\n"),fname);
		if (lnksz!=NULL) FREE(lnksz);
		return 0;
	}

	/*store rhs 1 in lnksz */
	if ((m1 == n1)&&(m2 == m1)) m1 = -1; /* this is done for matrix 2,2 */
	if (VarType(1) == 8)
	{
		switch (M1.it)
		{
		case I_CHAR   : if (m1==2)
						{
							for(j=0;j<n_lnksz;j++)
							{
								lnksz[j]=(int) IC_CHAR(M1.D)[j*2];
								lnksz[n_lnksz+j]=(int) IC_CHAR(M1.D)[2*j+1];
							}
						}
						else
						{
							for(j=0;j<2*n_lnksz;j++)
								lnksz[j]=(int) IC_CHAR(M1.D)[j];
						}
						break;

		case I_INT16  : if (m1==2)
						{
							for(j=0;j<n_lnksz;j++)
							{
								lnksz[j]=(int) IC_INT16(M1.D)[j*2];
								lnksz[n_lnksz+j]=(int) IC_INT16(M1.D)[2*j+1];
							}
						}
						else
						{
							for(j=0;j<2*n_lnksz;j++)
								lnksz[j]=(int) IC_INT16(M1.D)[j];
						}
						break;

		case I_INT32  : if (m1==2)
						{
							for(j=0;j<n_lnksz;j++)
							{
								lnksz[j]=(int) IC_INT32(M1.D)[j*2];
								lnksz[n_lnksz+j]=(int) IC_INT32(M1.D)[2*j+1];
							}
						}
						else
						{
							for(j=0;j<2*n_lnksz;j++)
								lnksz[j]=(int) IC_INT32(M1.D)[j];
						}
						break;

		case I_UCHAR  : if (m1==2)
						{
							for(j=0;j<n_lnksz;j++)
							{
								lnksz[j]=(int) IC_UCHAR(M1.D)[j*2];
								lnksz[n_lnksz+j]=(int) IC_UCHAR(M1.D)[2*j+1];
							}
						}
						else
						{
							for(j=0;j<2*n_lnksz;j++)
								lnksz[j]=(int) IC_UCHAR(M1.D)[j];
						}
						break;

		case I_UINT16 : if (m1==2)
						{
							for(j=0;j<n_lnksz;j++)
							{
								lnksz[j]=(int) IC_UINT16(M1.D)[j*2];
								lnksz[n_lnksz+j]=(int) IC_UINT16(M1.D)[2*j+1];
							}
						}
						else
						{
							for(j=0;j<2*n_lnksz;j++)
								lnksz[j]=(int) IC_UINT16(M1.D)[j];
						}
						break;

		case I_UINT32 : if (m1==2)
						{
							for(j=0;j<n_lnksz;j++)
							{
								lnksz[j]=(int) IC_UINT32(M1.D)[j*2];
								lnksz[n_lnksz+j]=(int) IC_UINT32(M1.D)[2*j+1];
							}
						}
						else
						{
							for(j=0;j<2*n_lnksz;j++)
								lnksz[j]=(int) IC_UINT32(M1.D)[j];
						}
						break;
		}
	}
	else
	{
		if (m1==2)
		{
			for(j=0;j<n_lnksz;j++)
			{
				lnksz[j]=(int) ((double *) stk(l1))[j*2];
				lnksz[n_lnksz+j]=(int) ((double *) stk(l1))[2*j+1];
			}
		}
		else
		{
			for(j=0;j<2*n_lnksz;j++)
				lnksz[j]=(int) ((double *) stk(l1))[j];
		}
	}

	/*store rhs 2 in lnktyp */
	if (VarType(2) == sci_ints)
	{
		switch (M2.it)
		{
		case I_CHAR   : for(j=0;j<n_lnktyp;j++)
							lnktyp[j]=(int) IC_CHAR(M2.D)[j];
			break;

		case I_INT16  : for(j=0;j<n_lnktyp;j++)
							lnktyp[j]=(int) IC_INT16(M2.D)[j];
			break;

		case I_INT32  : for(j=0;j<n_lnktyp;j++)
							lnktyp[j]=(int) IC_INT32(M2.D)[j];
			break;

		case I_UCHAR  : for(j=0;j<n_lnktyp;j++)
							lnktyp[j]=(int) IC_UCHAR(M2.D)[j];
			break;

		case I_UINT16 : for(j=0;j<n_lnktyp;j++)
							lnktyp[j]=(int) IC_UINT16(M2.D)[j];
			break;

		case I_UINT32 : for(j=0;j<n_lnktyp;j++)
							lnktyp[j]=(int) IC_UINT32(M2.D)[j];
			break;
		}
	}
	else
	{
		for(j=0;j<n_lnktyp;j++)
			lnktyp[j]=(int) ((double *) stk(l2))[j];
	}

	/* build output list */
	CreateVar(3,LIST_DATATYPE,&n_lnktyp,&n3,&l3);

	for(i=0;i<n_lnktyp;i++)
	{
		nm=lnksz[i]*lnksz[i+n_lnktyp];
		switch (lnktyp[i])
		{
		case 1  : if ((ptr_d=MALLOC(nm*sizeof(double)))==NULL)
				  {
					  ierr=-1;
					  break;
				  }
				  for (j=0;j<nm;j++) ptr_d[j]=0;
				  CreateListVarFromPtr(3,i+1,MATRIX_OF_DOUBLE_DATATYPE,&lnksz[i],&lnksz[i+n_lnktyp], &ptr_d);
				  FREE(ptr_d);
				  break;

		case 2  : if ((ptr_d=MALLOC(2*nm*sizeof(double)))==NULL)
				  {
					  ierr=-1;
					  break;
				  }
				  for (j=0;j<2*nm;j++) ptr_d[j]=0;
				  ptr_dc = &ptr_d[nm];
				  CreateListCVarFromPtr(3,i+1,MATRIX_OF_DOUBLE_DATATYPE,(j=1,&j),&lnksz[i],&lnksz[i+n_lnktyp],&ptr_d,&ptr_dc);
				  FREE(ptr_d);
				  break;

		case 3  : if ((ptr_i=MALLOC(nm*sizeof(int)))==NULL)
				  {
					  ierr=-1;
					  break;
				  }
				  for (j=0;j<nm;j++) ptr_i[j]=0;
				  M3.m = lnksz[i];
				  M3.n = lnksz[i+n_lnktyp];
				  M3.it = 4;
				  M3.l = -1;
				  M3.D = ptr_i;
				  CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
				  FREE(ptr_i);
				  break;

		case 4  : if ((ptr_s=MALLOC(nm*sizeof(short)))==NULL)
				  {
					  ierr=-1;
					  break;
				  }
				  for (j=0;j<nm;j++) ptr_s[j]=0;
				  M3.m = lnksz[i];
				  M3.n = lnksz[i+n_lnktyp];
				  M3.it = 2;
				  M3.l = -1;
				  M3.D = ptr_s;
				  CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
				  FREE(ptr_s);
				  break;

		case 5  : if ((ptr_c=MALLOC(nm*sizeof(char)))==NULL)
				  {
					  ierr=-1;
					  break;
				  }
				  for (j=0;j<nm;j++) ptr_c[j]=0;
				  M3.m = lnksz[i];
				  M3.n = lnksz[i+n_lnktyp];
				  M3.it = 1;
				  M3.l = -1;
				  M3.D = ptr_c;
				  CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
				  FREE(ptr_c);
				  break;

		case 6  : if ((ptr_ui=MALLOC(nm*sizeof(unsigned int)))==NULL)
				  {
					  ierr=-1;
					  break;
				  }
				  for (j=0;j<nm;j++) ptr_ui[j]=0;
				  M3.m = lnksz[i];
				  M3.n = lnksz[i+n_lnktyp];
				  M3.it = 14;
				  M3.l = -1;
				  M3.D = ptr_ui;
				  CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
				  FREE(ptr_ui);
				  break;

		case 7  : if ((ptr_us=MALLOC(nm*sizeof(unsigned short)))==NULL)
				  {
					  ierr=-1;
					  break;
				  }
				  for (j=0;j<nm;j++) ptr_us[j]=0;
				  M3.m = lnksz[i];
				  M3.n = lnksz[i+n_lnktyp];
				  M3.it = 12;
				  M3.l = -1;
				  M3.D = ptr_us;
				  CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
				  FREE(ptr_us);
				  break;

		case 8  : if ((ptr_uc=MALLOC(nm*sizeof(unsigned char)))==NULL)
				  {
					  ierr=-1;
					  break;
				  }
				  for (j=0;j<nm;j++) ptr_uc[j]=0;
				  M3.m = lnksz[i];
				  M3.n = lnksz[i+n_lnktyp];
				  M3.it = 11;
				  M3.l = -1;
				  M3.D = ptr_uc;
				  CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
				  FREE(ptr_uc);
				  break;

		default : if ((ptr_d=MALLOC(nm*sizeof(double)))==NULL)
				  {
					  ierr=-1;
					  break;
				  }
				  for (j=0;j<nm;j++) ptr_d[j]=0;
				  CreateListVarFromPtr(3,i+1,MATRIX_OF_DOUBLE_DATATYPE,&lnksz[i],&lnksz[i+n_lnktyp], &ptr_d);
				  FREE(ptr_d);
				  break;
		}

		if (ierr==-1)
		{
			Scierror(999,_("%s : No more free memory.\n"),fname);
			FREE(lnksz);
			FREE(lnktyp);
			return 0;
		}
	}

	LhsVar(1) = 3;
	FREE(lnksz);
	FREE(lnktyp);
    PutLhsVar();
	return 0;
}
Beispiel #26
0
/*-------------------------------------------------------------------------------------*/
static int sci_strcat_one_rhs(char *fname)
{
    int Type_One = VarType(1);

    if ((Type_One != sci_strings) && (Type_One != sci_matrix))
    {
        Scierror(246, "%s: Wrong type for input argument #%d: Matrix of strings expected.\n", fname, 1);
        return 0;
    }
    else
    {
        if (Type_One == sci_strings)
        {
            int lenstrcat = sumlengthstring(1);

            if (lenstrcat >= 0)
            {
                char **Input_String_One = NULL;
                int m = 0, n = 0;   /* matrix size */
                int mn = 0;     /* m*n */
                int n1 = 1, m1 = lenstrcat;
                int outIndex = 0;

                char *Output_String = NULL;
                int i = 0;

                int sizeLengths = 0;
                int *lengths = lengthEachString(1, &sizeLengths);

                int l = 0;

                if (lengths == NULL)
                {
                    Scierror(999, _("%s: error.\n"), fname);
                    return 0;
                }

                GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m, &n, &Input_String_One);
                mn = m * n;

                CreateVar(Rhs + 1, STRING_DATATYPE, &m1, &n1, &outIndex);
                Output_String = cstk(outIndex);

                l = 0;
                for (i = 0; i < mn; i++)
                {
                    /* bug 4728 Compatibility with Scilab 4.1.2 */
                    /* replaces strcpy & strcat by memcpy */
                    /* copy of char array and not string */
                    if (i == 0)
                    {
                        memcpy(Output_String, Input_String_One[i], lengths[i]);
                    }
                    else
                    {
                        memcpy(Output_String + l, Input_String_One[i], lengths[i]);
                    }
                    l = l + lengths[i];
                }

                FREE(lengths);
                lengths = NULL;
                if (Input_String_One)
                {
                    freeArrayOfString(Input_String_One, mn);
                }

                LhsVar(1) = Rhs + 1;
                PutLhsVar();
            }
            else
            {
                Scierror(999, _("%s: Wrong size for input argument(s).\n"), fname);
            }
        }
        else                    /* sci_matrix */
        {
            sci_strcat_rhs_one_is_a_matrix(fname);
        }
    }
    return 0;
}
Beispiel #27
0
int
intoperator (char *fname)
{
  int ainf, asup, binf, bsup, op;
  int sa[2], sb[2], flag[1];
  int cinf, csup, f;
  int ma, na, ma2, na2;
  int mb, nb, mb2, nb2;
  int r, s;
  int p, q, t, u;
  int rt;

  CheckRhs (5, 5);
  CheckLhs (2, 3);

  GetRhsVar (1, "d", &na, &ma, &ainf);
  GetRhsVar (2, "d", &na2, &ma2, &asup);
  GetRhsVar (3, "c", &t, &u, &op);
  GetRhsVar (4, "d", &nb, &mb, &binf);
  GetRhsVar (5, "d", &nb2, &mb2, &bsup);

  if (*cstk (op) == 'k' || *cstk (op) == 'y')
    {
      r = na * nb;
      s = ma * mb;
    }

  else
    {
      if (na * ma == 1)
	{
	  r = nb;
	  s = mb;
	}

      else if (nb * mb == 1 || (na == nb && ma == mb))
	{
	  r = na;
	  s = ma;
	}

      else if (ma == nb)
	{
	  r = na;
	  s = mb;
	}

      else
	{
	  r = 0;
	  s = 0;
	}
    }

  p = 1;
  q = 1;

  CreateVar (6, "d", &r, &s, &cinf);
  CreateVar (7, "d", &r, &s, &csup);
  CreateVar (8, "i", &p, &q, &f);

  sa[0] = na;
  sa[1] = ma;
  sb[0] = nb;
  sb[1] = mb;

  if (r * s != 0)
    {
      if (nb2 * mb2 == 0)
	{
	  operate (stk (ainf), stk (asup), sa,
		   stk (binf), NULL, sb,
		   *cstk (op), stk (cinf), stk (csup), flag);
	}

      else if (na2 * ma2 == 0)
	{
	  operate (stk (ainf), NULL, sa,
		   stk (binf), stk (bsup), sb,
		   *cstk (op), stk (cinf), stk (csup), flag);
	}

      else
	{
	  operate (stk (ainf), stk (asup), sa,
		   stk (binf), stk (bsup), sb,
		   *cstk (op), stk (cinf), stk (csup), flag);
	}
    }

  else
    {
      flag[0] = -1;
    }

  *istk (f) = flag[0];

  LhsVar (1) = 6;
  LhsVar (2) = 7;
  LhsVar (3) = 8;

  return 0;

}
Beispiel #28
0
/*-------------------------------------------------------------------------------------*/
static int sci_strcat_three_rhs(char *fname)
{
    int Row_One = 0, Col_One = 0;
    char **Input_String_One = NULL;
    int mn = 0;
    static char def_sep[] = "";
    char *Input_String_Two = def_sep;
    char typ = 0;
    int i = 0;

    if (VarType(1) != sci_strings)
    {
        Scierror(999, _("%s: Wrong type for input argument #%d: a string vector expected.\n"), fname, 1);
        return 0;
    }

    if (VarType(2) != sci_strings)
    {
        Scierror(999, "%s : Wrong size for input argument #%d: Single string expected.\n", fname, 2);
        return 0;
    }

    if (VarType(3) != sci_strings)
    {
        Scierror(999, "%s : Wrong size for input argument #%d: Single string expected.\n", fname, 3);
        return 0;
    }

    GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &Row_One, &Col_One, &Input_String_One);
    mn = Row_One * Col_One;

    if (Rhs >= 2)
    {
        /* second argument always a string and not a matrix of string */
        int l2 = 0;
        int Row_Two = 0, Col_Two = 0;

        GetRhsVar(2, STRING_DATATYPE, &Row_Two, &Col_Two, &l2);
        Input_String_Two = cstk(l2);
    }

    if (Rhs >= 3)
    {
        int Row_Three = 0, Col_Three = 0;
        int l3 = 0;

        GetRhsVar(3, STRING_DATATYPE, &Row_Three, &Col_Three, &l3);
        if (Row_Three * Col_Three != 0)
        {
            typ = cstk(l3)[0];
        }
        if (typ != COL && typ != ROW)
        {
            freeArrayOfString(Input_String_One, mn);
            Scierror(999, _("%s: Wrong type for input argument #%d: '%s' or '%s' expected.\n"), fname, 3, "c", "r");
            return 0;
        }
    }

    switch (typ)
    {
        case STAR:
        {
            int nchars = 0;
            int one = 1;
            int l3 = 0;
            int k = 0;

            /* just return one string */
            for (i = 0; i < mn; i++)
            {
                nchars += (int)strlen(Input_String_One[i]);
            }
            nchars += (mn - 1) * (int)strlen(Input_String_Two);

            CreateVar(Rhs + 1, STRING_DATATYPE, &one, &nchars, &l3);

            for (i = 0; i < mn; i++)
            {
                int j = 0;

                for (j = 0; j < (int)strlen(Input_String_One[i]); j++)
                {
                    *cstk(l3 + k++) = Input_String_One[i][j];
                }
                if (i != mn - 1)
                    for (j = 0; j < (int)strlen(Input_String_Two); j++)
                    {
                        *cstk(l3 + k++) = Input_String_Two[j];
                    }
            }
            freeArrayOfString(Input_String_One, mn);
            LhsVar(1) = Rhs + 1;
        }
        break;
        case COL:
        {
            char **Output_String = NULL;
            int nchars = 0;
            int one = 1;

            /* return a column matrix */
            if ((Output_String = (char **)MALLOC((Row_One + 1) * sizeof(char *))) == NULL)
            {
                freeArrayOfString(Input_String_One, mn);
                Scierror(999, _("%s: No more memory.\n"), fname);
                return 0;
            }
            Output_String[Row_One] = NULL;
            for (i = 0; i < Row_One; i++)
            {
                int j = 0;

                /* length of row i */
                nchars = 0;
                for (j = 0; j < Col_One; j++)
                {
                    nchars += (int)strlen(Input_String_One[i + Row_One * j]);
                }
                nchars += (Col_One - 1) * (int)strlen(Input_String_Two);

                Output_String[i] = (char *)MALLOC((nchars + 1) * sizeof(char));
                if (Output_String[i] == NULL)
                {
                    freeArrayOfString(Output_String, i);
                    freeArrayOfString(Input_String_One, mn);
                    Scierror(999, _("%s: No more memory.\n"), fname);
                    return 0;
                }
                /* fill the string */
                strcpy(Output_String[i], Input_String_One[i]);

                for (j = 1; j < Col_One; j++)
                {
                    strcat(Output_String[i], Input_String_Two);
                    strcat(Output_String[i], Input_String_One[i + Row_One * j]);
                }
            }

            CreateVarFromPtr(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &Row_One, &one, Output_String);
            freeArrayOfString(Input_String_One, mn);
            freeArrayOfString(Output_String, Row_One + 1);
            LhsVar(1) = Rhs + 1;
        }
        break;

        case ROW:
        {
            int j = 0;
            int one = 1;
            char **Output_String = (char **)CALLOC(Col_One, sizeof(char *));

            /* return a row matrix */
            if (Output_String == NULL)
            {
                freeArrayOfString(Input_String_One, mn);
                Scierror(999, _("%s: No more memory.\n"), fname);
                return 0;
            }

            for (j = 0; j < Col_One; j++)
            {
                Output_String[j] = strdup(Input_String_One[j * Row_One]);

                if (Output_String[j] == NULL)
                {
                    freeArrayOfString(Output_String, j);
                    freeArrayOfString(Input_String_One, mn);
                    Scierror(999, _("%s: No more memory.\n"), fname);
                    return 0;
                }

                for (i = 1; i < Row_One; i++)
                {
                    int lenOutput = 0;
                    int lenInput = 0;
                    int lenNew = 0;

                    if (Input_String_Two)
                    {
                        lenOutput = (int)strlen(Output_String[j]);
                        lenInput = (int)strlen(Input_String_Two);
                        lenNew = lenOutput + lenInput + 1;

                        Output_String[j] = (char *)REALLOC(Output_String[j], sizeof(char *) * lenNew);
                        if (Output_String[j] == NULL)
                        {
                            freeArrayOfString(Output_String, j);
                            freeArrayOfString(Input_String_One, mn);
                            Scierror(999, _("%s: No more memory.\n"), fname);
                            return 0;
                        }
                        strcat(Output_String[j], Input_String_Two);
                    }

                    if (Input_String_One[i + Row_One * j])
                    {
                        lenOutput = (int)strlen(Output_String[j]);
                        lenInput = (int)strlen(Input_String_One[i + Row_One * j]);
                        lenNew = lenOutput + lenInput + 1;

                        Output_String[j] = (char *)REALLOC(Output_String[j], sizeof(char *) * lenNew);
                        if (Output_String[j] == NULL)
                        {
                            freeArrayOfString(Output_String, j);
                            freeArrayOfString(Input_String_One, mn);
                            Scierror(999, _("%s: No more memory.\n"), fname);
                            return 0;
                        }
                        strcat(Output_String[j], Input_String_One[i + Row_One * j]);
                    }
                }
            }

            CreateVarFromPtr(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &one, &Col_One, Output_String);
            freeArrayOfString(Input_String_One, mn);
            if (Col_One == 1)
            {
                FREE(Output_String);
                Output_String = NULL;
            }
            else
            {
                freeArrayOfString(Output_String, Col_One);
            }
            LhsVar(1) = Rhs + 1;
        }
        break;

        default:
        {
            freeArrayOfString(Input_String_One, mn);
            Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, 3, "c", "r");
            return 0;
        }
        break;

    }
    PutLhsVar();
    return 0;
}
Beispiel #29
0
/*--------------------------------------------------------------------------*/
int sci_xls_read(char *fname, unsigned long fname_len)
{
    int m1 = 0, n1 = 0, l1 = 0, zero = 0, ierr = 0;
    double *data = NULL;
    int *ind = NULL;
    int M = 0, N = 0, MN = 0;
    int pos = 0, fd = 0;

    CheckLhs(2, 2);
    CheckRhs(2, 2);

    if (VarType(1) != sci_matrix)
    {
        Scierror(999, _("%s: Wrong type for input argument #%d: Scalar expected.\n"), fname, 1);
        return 0;
    }

    if (VarType(2) != sci_matrix)
    {
        Scierror(999, _("%s: Wrong type for input argument #%d: Scalar expected.\n"), fname, 2);
        return 0;
    }


    /*  checking variable fd */
    GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
    fd = (int) * stk(l1);
    /*  checking variable Pos */
    GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
    pos = (int) * stk(l1);

    xls_read(&fd, &pos, &data, &ind, &N, &M,  &ierr);

    switch (ierr)
    {
        case 1 :
            Scierror(999, _("%s: No more memory.\n"), fname);
            return 0;
            break;
        case 2 :
            Scierror(999, _("%s: Failed to read expected data, may be invalid xls file.\n"), fname);
            return 0;
            break;
        case 3 :
            Scierror(999, _("%s: End of file.\n"), fname);
            return 0;
            break;
        default :
            /* no error */
            break;
    }

    MN = M * N;

    if (MN == 0)
    {
        CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &zero, &zero, &l1);
        CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &zero, &zero, &l1);
    }
    else
    {
        CreateVarFromPtr(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &N, &M, &data);
        CreateVarFromPtr(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &N, &M, &ind);
        FREE(data);
        data = NULL;
        FREE(ind);
        ind = NULL;
    }
    LhsVar(1) = Rhs + 1;
    LhsVar(2) = Rhs + 2;
    PutLhsVar();
    return 0;
}
/*--------------------------------------------------------------------------*/
int sci_messagebox(char *fname,unsigned long fname_len)
{
  int messageBoxID = 0;

  /* Used to read input arguments */
  int nbRow = 0, nbCol = 0;
  int nbRowButtons = 0, nbColButtons = 0;
  int nbRowMessage = 0, nbColMessage = 0;

  char **buttonsTextAdr = 0;
  char **messageAdr = 0;
  char **titleAdr = 0;
  char **modalOptionAdr = 0;
  char **iconAdr = 0;

  /* Used to write output argument */
  int buttonNumberAdr = 0;
  int buttonNumber = 0;

  CheckRhs(1,5);
  CheckLhs(0,1);

  /* Message to be displayed */
  if (VarType(1) == sci_strings) 
    {
      GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &nbRowMessage, &nbColMessage, &messageAdr);
    }
  else
    {
      Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 1);
      return FALSE;
    }

  /* Title to be displayed */
  if (Rhs >= 2) 
    {
      if (VarType(2) == sci_strings)
        {
          GetRhsVar(2, MATRIX_OF_STRING_DATATYPE, &nbRow, &nbCol, &titleAdr);
          if (nbRow*nbCol!=1)
            {
              Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 2);
              return FALSE;
            }
          /* The title argument can be used to give the modal option */
          if (isModalOption(getStringMatrixFromStack((size_t)titleAdr)[0]))
            {
              modalOptionAdr = titleAdr;
              titleAdr = NULL;
            }
        }
      else
        {
          Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 2);
          return FALSE;
        }
    }

  /* Icon to be displayed */
  if (Rhs >= 3)
    {
      if (VarType(3) == sci_strings)
        {
          GetRhsVar(3,MATRIX_OF_STRING_DATATYPE,&nbRow,&nbCol,&iconAdr);
          if (nbRow*nbCol == 1)
            {
              /* The icon argument can be used to give the modal option or the buttons names */
              if (isModalOption(getStringMatrixFromStack((size_t)iconAdr)[0]))
                {
                  modalOptionAdr = (char **)iconAdr;
                  iconAdr = NULL;
                }
              else if(!isIconName(getStringMatrixFromStack((size_t)iconAdr)[0]))
                {
                  buttonsTextAdr = (char **)iconAdr;
                  nbRowButtons = nbRow;
                  nbColButtons = nbCol;
                  iconAdr = NULL;
                }
            }
          else  /* More than one string --> buttons names */
            {
              buttonsTextAdr = (char **)iconAdr;
              nbRowButtons = nbRow;
              nbColButtons = nbCol;
              iconAdr = NULL;
            }

        }
      else
        {
          Scierror(999, _("%s: Wrong type for input argument #%d: A string or a string vector expected.\n"), fname, 3);
          return FALSE;
        }
    }

  /* Buttons names */
  if (Rhs >= 4)
    {
      if (VarType(4) == sci_strings)
        {
          GetRhsVar(4,MATRIX_OF_STRING_DATATYPE,&nbRowButtons,&nbColButtons,&buttonsTextAdr);
          if (nbRow*nbCol == 1)
            {
              /* The buttons names argument can be used to give the modal option */
              if (isModalOption(getStringMatrixFromStack((size_t)buttonsTextAdr)[0]))
                {
                  modalOptionAdr = buttonsTextAdr;
                  buttonsTextAdr = NULL;
                }
            }
        }
      else
        {
          Scierror(999, _("%s: Wrong type for input argument #%d: A string or a string vector expected.\n"), fname, 3);
          return FALSE;
        }
    }
  
  /* Modal option */
  if (Rhs == 5)
    {
      if (VarType(5) == sci_strings)
        {
          GetRhsVar(5,MATRIX_OF_STRING_DATATYPE,&nbRow,&nbCol,&modalOptionAdr);
          if (nbRow*nbCol != 1)
            {
              Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 5);
              return FALSE;
            }
        }
      else
        {
          Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 5);
          return FALSE;
        }
    }
  /* Create the Java Object */
  messageBoxID = createMessageBox();

  /* Message */
  setMessageBoxMultiLineMessage(messageBoxID, getStringMatrixFromStack((size_t)messageAdr), nbColMessage*nbRowMessage);

  /* Title */
  if (titleAdr != NULL)
    {
      setMessageBoxTitle(messageBoxID, getStringMatrixFromStack((size_t)titleAdr)[0]);
    }
  else
    {
      setMessageBoxTitle(messageBoxID, _("Scilab Message"));
    }

  /* Icon */
  if (iconAdr != NULL)
    {
      setMessageBoxIcon(messageBoxID, getStringMatrixFromStack((size_t)iconAdr)[0]);
    }
    
  /* Buttons */
  if (buttonsTextAdr != NULL)
    {
      setMessageBoxButtonsLabels(messageBoxID, getStringMatrixFromStack((size_t)buttonsTextAdr), nbColButtons*nbRowButtons);
    }

  /* Modal ? */
  if (modalOptionAdr != NULL)
    {
      setMessageBoxModal(messageBoxID, !stricmp(getStringMatrixFromStack((size_t)modalOptionAdr)[0],"modal"));
    }
  else
    {
      setMessageBoxModal(messageBoxID, FALSE);
    }
  
  /* Display it and wait for a user input */
  messageBoxDisplayAndWait(messageBoxID);

  /* Return the index of the button selected */
  
  if (Lhs == 1)
    {
      /* Read the user answer */
      buttonNumber = getMessageBoxSelectedButton(messageBoxID);
      
      nbRow = 1; nbCol = 1;
      CreateVar(Rhs+1, MATRIX_OF_DOUBLE_DATATYPE, &nbRow, &nbCol, &buttonNumberAdr);
      *stk(buttonNumberAdr) = buttonNumber;
      
      LhsVar(1) = Rhs+1;
    }
  else
    {
      LhsVar(1) = 0;
    }
  
  PutLhsVar();
  return TRUE;
}