Beispiel #1
0
	/// <summary>
	/// Find the variable name in the codepack
	/// if it isn't exist, find it in the upvalue table
	///
	/// Find the variable in the previous codepack.
	/// if the variable name in the previous codepack and
	///		if it's a local in the previous codepack
	///			let it be a upvalue
	///		else if it's already a upvalue
	///			you guess what
	/// </summary>
	CodeGen::VarType CodeGen::FindVar(GenState * cs, const std::u16string& _Str)
	{
		int _var_id;
		if (cs->TryGetVarId(_Str, _var_id))
			return VarType(VarType::TYPE::LOCAL, _var_id);

		for (int i = 0; i < cs->GetUpValuesVector()->size(); ++i)
			if (cs->GetUpValuesVector()->at(i) == _Str)
				return VarType(VarType::TYPE::UPVAL, i);

		if (cs->GetFather())
		{
			VarType _p = FindVar(cs->GetFather(), _Str);
			switch (_p.type())
			{
			case VarType::TYPE::LOCAL:
			{
				cs->GetRequireUpvaluesVector()->push_back(_p.id());
				auto t = cs->AddUpValue(_Str);
				return VarType(VarType::TYPE::UPVAL, t);
			}
			case VarType::TYPE::UPVAL:
			{
				cs->GetRequireUpvaluesVector()->push_back(-1 - _p.id());
				auto i = cs->AddUpValue(_Str);
				return VarType(VarType::TYPE::UPVAL, i);
			}

			}
		}
		return VarType(VarType::TYPE::NONE);
	}
Beispiel #2
0
/*------------------------------------------------------------------------*/
int sci_grep(char *fname, unsigned long fname_len)
{
    CheckRhs(2, 3);
    CheckLhs(1, 2);

    if (VarType(1) == sci_matrix)
    {
        int m1 = 0, n1 = 0;
        char **Str = NULL;

        GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &Str);

        if ((m1 == 0) && (n1 == 0))
        {
            int l = 0;

            CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l);
            LhsVar(1) = Rhs + 1;
            PutLhsVar();

            return 0;
        }
    }

    if (Rhs == 3)
    {
        if (VarType(3) == sci_strings)
        {
            char typ = 'd';     /*default */
            int m3 = 0, n3 = 0, l3 = 0;

            GetRhsVar(3, STRING_DATATYPE, &m3, &n3, &l3);
            if (m3 * n3 != 0)
            {
                typ = cstk(l3)[0];
            }

            if (typ == 'r')
            {
                sci_grep_common(fname, TRUE);
            }
            else
            {
                Scierror(999, _("%s: Wrong value for input argument #%d: '%s' expected.\n"), fname, 3, "s");
                return 0;
            }
        }
        else
        {
            Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 3);
            return 0;
        }
    }
    else                        /* Rhs == 2 */
    {
        sci_grep_common(fname, FALSE);
    }
    return 0;
}
Beispiel #3
0
VarType MakeType(bool I_or_F, int elemCnt)
{
	if (I_or_F) {
		return VarType(VarType::kInt + elemCnt - 1);
	}
	else {
		return VarType(VarType::kFloat + elemCnt - 1);
	}
}
/*--------------------------------------------------------------------------*/
int get_colout_arg(char *fname,int pos,rhs_opts opts[], int ** colout )
{
  int m,n,l,first_opt=FirstOpt(),kopt;

  if (pos < first_opt)
    {
      if (VarType(pos))
	{
	  GetRhsVar(pos,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
	  CheckLength(pos,m*n,2);
	  *colout = istk(l);
	}
      else
	{
	  /** global value can be modified  **/
    int newDefCO[2] = { -1, -1 } ;
    setDefColOut( newDefCO ) ;
	  *colout = getDefColOut() ;
	}
    }
  else if ((kopt=FindOpt("colout",opts)))
    {
      GetRhsVar(kopt,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
      CheckLength(kopt,m*n,2);
      *colout=istk(l);
    }
  else
    {
      /** global value can be modified  **/
      int newDefCO[2] = { -1, -1 } ;
      setDefColOut( newDefCO ) ;
      *colout = getDefColOut() ;
    }
  return 1;
}
/*--------------------------------------------------------------------------*/
int get_with_mesh_arg(char *fname,int pos,rhs_opts opts[], BOOL * withMesh)
{
  int m,n,l,first_opt=FirstOpt(),kopt;

  if (pos < first_opt)
    {
      if (VarType(pos))
	{
	  GetRhsVar(pos,MATRIX_OF_BOOLEAN_DATATYPE, &m, &n, &l);
	  CheckLength(pos,m*n,1);
	  *withMesh = *(istk(l));
	}
      else
	{
	  /** global value can be modified  **/
	  setDefWithMesh( FALSE );
	  *withMesh = getDefWithMesh() ;
	}
    }
  else if ((kopt=FindOpt("mesh",opts)))
    {
      GetRhsVar(kopt,MATRIX_OF_BOOLEAN_DATATYPE, &m, &n, &l);
      CheckLength(kopt,m*n,1);
      *withMesh = *(istk(l));
    }
  else
    {
      /** global value can be modified  **/
      setDefWithMesh( FALSE );
      *withMesh = getDefWithMesh() ;
    }
  return 1;
}
/*--------------------------------------------------------------------------*/
int get_legend_arg(char *fname,int pos,rhs_opts opts[], char ** legend )
{
  int m,n,l,first_opt=FirstOpt(),kopt;

  if (pos < first_opt)
    {
      if (VarType(pos)) {
	GetRhsVar(pos,STRING_DATATYPE, &m, &n, &l);
	*legend = cstk(l);
      }
      else
	{
	  *legend = getDefLegend() ;
	}
    }
  else if ((kopt=FindOpt("leg",opts))) {
    GetRhsVar(kopt,STRING_DATATYPE, &m, &n, &l);
    *legend = cstk(l);
  }
  else
    {
      *legend = getDefLegend() ;
    }
  return 1;
}
/*--------------------------------------------------------------------------*/
int get_colminmax_arg(char *fname,int pos,rhs_opts opts[], int ** colminmax )
{
  int m,n,l,first_opt=FirstOpt(),kopt;

  if (pos < first_opt)
    {
      if (VarType(pos))
	{
	  GetRhsVar(pos,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
	  CheckLength(pos,m*n,2);
	  *colminmax=istk(l);
	}
      else
	{
	  /** global value can be modified  **/
    int zeros[2] = { 0, 0 } ;
    setDefColMinMax( zeros ) ;
	  *colminmax = getDefColMinMax() ;
	}
    }
  else if ((kopt=FindOpt("colminmax",opts)))
    {
      GetRhsVar(kopt,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
      CheckLength(kopt,m*n,2);
      *colminmax=istk(l);
    }
  else
    {
      /** global value can be modified  **/
      int zeros[2] = { 0, 0 } ;
      setDefColMinMax( zeros ) ;
      *colminmax = getDefColMinMax() ;
    }
  return 1;
}
Beispiel #8
0
/*--------------------------------------------------------------------------*/
int C2F(sci_mode)(char *fname,unsigned long fname_len)
{
	Rhs = Max(0, Rhs);

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

	if (Rhs == 0)
	{
		int n = 1 ,l = 0;
		execMode mode = getExecMode();

		CreateVar(Rhs+1, MATRIX_OF_INTEGER_DATATYPE, &n, &n,&l);
		*istk(l) = (int)mode;
		LhsVar(1) = Rhs + 1;
	}
	else
	{
		if ( VarType(1)== sci_matrix )
		{
			int m1 = 0, n1 = 0, l1 = 0;
			GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
			if ( (m1 == n1) && (n1 == 1) )
			{
				double dmode = *stk(l1);
				int mode = (int) dmode;

				if (dmode != (double)mode)
				{
					Scierror(999,_("%s: Wrong value for input argument #%d: A int expected.\n"),fname,1);
					return 0;
				}

				setExecMode((execMode)mode);

				if ( (mode == 7) || (mode == 4) )
				{
					int code_message = 26;
					int val_message = 0;
					C2F(msgs)(&code_message, &val_message);
				}
				LhsVar(1) = 0;
			}
			else
			{
				Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"),fname,1);
				return 0;
			}
		}
		else
		{
			Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"),fname,1);
			return 0;
		}
	}

	PutLhsVar();
	return 0;
}
Beispiel #9
0
/*--------------------------------------------------------------------------*/
static int sci_emptystr_one_rhs(char *fname)
{
    int m1 = 0, n1 = 0; /* m1 is the number of row ; n1 is the number of col*/

    /*With a matrix for input argument returns a zero length character strings matrix of the same size */
    int Type = VarType(1);

    if (Type == sci_matrix)
    {
        char **Input_StringMatrix_One = NULL;

        GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &Input_StringMatrix_One);
        if ((m1 == 0) && (n1 == 0)) /* emptystr([]) */
        {
            int l = 0;
            CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l);
            LhsVar(1) = Rhs + 1 ;
            PutLhsVar();
            return 0;
        }
    }
    else
    {
        if ((Type == sci_mlist) || (Type == sci_tlist))
        {
            /* compatibility with 4.1.2 */
            int lw = 1 + Top - Rhs;
            C2F(overload)(&lw, fname, (int)strlen(fname));
            return 0;
        }
        else
        {
            int RHSPOS = 1;
            int l1 = 0;
            int il = 0;
            int lw = RHSPOS + Top - Rhs;
            l1 = *Lstk(lw);
            il = iadr(l1);

            if (*istk(il ) < 0)
            {
                il = iadr(*istk(il + 1));
            }

            /* get dimensions */
            m1 = getNumberOfLines(il); /* row */
            n1 = getNumberOfColumns(il); /* col */
        }
    }

    /* m1 is the number of row ; n1 is the number of col*/
    CreateVarFromPtr(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, NULL);
    LhsVar(1) = Rhs + 1;
    PutLhsVar();

    return 0;
}
void __fastcall TIntMinerField::CustomDrawCellHandler(Cxgridcustomtableview::TcxCustomGridTableView* Sender, Cxgraphics::TcxCanvas* ACanvas, Cxgridcustomtableview::TcxGridTableDataCellViewInfo* AViewInfo, bool &ADone)
{
  TCellStateRec CellRec;
  int ACol = AViewInfo->Item->Index;
  int ARow = AViewInfo->RecordViewInfo->Index;
  TRect DrawRect = AViewInfo->Bounds;
  int vType = VarType(AViewInfo->Value);
  if((vType == varEmpty) || (vType == varNull)) return;
  CellRec = *(PCellStateRec)(int)AViewInfo->Value;
  DrawCell(CellRec, ACol, ARow, DrawRect, ACanvas->Canvas);
  ADone = true;
}
/*--------------------------------------------------------------------------*/
int get_rect_arg(char *fname,int pos,rhs_opts opts[], double ** rect )
{
	int m,n,l,first_opt=FirstOpt(),kopt,i;

	if (pos < first_opt)
		{
			if (VarType(pos)) {
				GetRhsVar(pos,MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
				if (m * n != 4) {
					Scierror(999,"%s: Wrong size for input argument #%d: %d expected\n",fname,pos,4);
					return 0;
				}
				*rect = stk(l);

				for(i=0;i<4;i++)
					if(finite((*rect)[i]) == 0){
						Scierror(999,"%s: Wrong values (Nan or Inf) for input argument: %d finite values expected\n",fname,4);
						return 0;
					}
			}
			else
				{
					/** global value can be modified  **/
					double zeros[4] = { 0.0, 0.0, 0.0, 0.0 } ;
					setDefRect( zeros ) ;
					*rect = getDefRect() ;
				}
		}
	else if ((kopt=FindOpt("rect",opts))) {/* named argument: rect=value */
		GetRhsVar(kopt,MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
		if (m * n != 4) {
			Scierror(999,"%s: Wrong size for input argument #%d: %d expected\n",fname,kopt,4);
			return 0;
		}
		*rect = stk(l);

		for(i=0;i<4;i++)
			if(finite((*rect)[i]) == 0){
				Scierror(999,"%s: Wrong values (Nan or Inf) for input argument: %d finite values expected\n",fname,4);
				return 0;
			}
	}
	else
		{
			/** global value can be modified  **/
			double zeros[4] = { 0.0, 0.0, 0.0, 0.0 } ;
			setDefRect( zeros ) ;
			*rect = getDefRect() ;
		}

	return 1;
}
/**
 * retrieve the labels from the command line and store them into labels
 */
int get_labels_arg(char *fname, int pos, rhs_opts opts[], char ** labels)
{
    int m,n,l,first_opt=FirstOpt(),kopt;

    if (pos < first_opt)
    {
        if (VarType(pos))
        {
            GetRhsVar(pos,STRING_DATATYPE, &m, &n, &l);
            *labels = cstk(l);
        }
        else
        {
            /* jb silvy 03/2006 */
            /* do not change the legend if one already exists */
            char * pSubWinUID = getOrCreateDefaultSubwin();
            if (sciGetLegendDefined(pSubWinUID))
            {
                *labels = NULL;
            }
            else
            {
                *labels = getDefLegend();
            }
        }
    }
    else if ((kopt=FindOpt("leg",opts)))
    {
        GetRhsVar(kopt,STRING_DATATYPE, &m, &n, &l);
        *labels = cstk(l);
    }
    else
    {
        /* jb silvy 03/2006 */
        /* do not change the legend if one already exists */
        char* pSubWinUID = getOrCreateDefaultSubwin();

        if (sciGetLegendDefined(pSubWinUID))
        {
            *labels = NULL;
        }
        else
        {
            *labels = getDefLegend();
        }
    }
    return 1;
}
Beispiel #13
0
/*-------------------------------------------------------------------------------------*/
static int *lengthEachString(int rhspos, int *sizeArrayReturned)
{
    int *StringsLength = NULL;

    if (VarType(rhspos) == sci_strings)
    {
        int m = 0, n = 0;       /* matrix size */
        int mn = 0;             /* m*n */

        int il = 0;
        int ilrd = 0;
        int l1 = 0;

        int x = 0;

        int lw = rhspos + Top - Rhs;

        l1 = *Lstk(lw);
        il = iadr(l1);

        if (*istk(il) < 0)
        {
            il = iadr(*istk(il + 1));
        }

        /* get dimensions */
        m = getNumberOfLines(il);   /* row */
        n = getNumberOfColumns(il); /* col */
        mn = m * n;
        ilrd = il + 4;

        StringsLength = (int *)MALLOC(sizeof(int) * mn);
        if (StringsLength == NULL)
        {
            return NULL;
        }

        *sizeArrayReturned = mn;

        for (x = 0; x < mn; x++)
        {
            StringsLength[x] = (int)(*istk(ilrd + x + 1) - *istk(ilrd + x));
        }
    }
    return StringsLength;
}
/*--------------------------------------------------------------------------*/
int get_nax_arg(int pos,rhs_opts opts[], int ** nax, BOOL * flagNax )
{
  int i,m,n,l,first_opt=FirstOpt(),kopt;

  if (pos < first_opt)
  {
    if (VarType(pos))
    {
      GetRhsVar(pos,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
      CheckLength(pos,m*n,4);
      for (i = 0 ; i < 4; ++i)
      {
        // When i = 1 or 3 we talk about the number of ticks, this value can be -1 to say 'AutoTicks'
        *istk(l+i) = Max((int)  *istk(l+i),-(i%2));
      }
      *nax=istk(l);
      *flagNax = TRUE;
    }
    else
    {
	    *nax = getDefNax() ;
	    *flagNax = FALSE;
    }
  }
  else if ((kopt=FindOpt("nax",opts)))
  {
    GetRhsVar(kopt,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
    CheckLength(kopt,m*n,4);
    for (i = 0 ; i < 4; ++i)
    {
      // When i = 1 or 3 we talk about the number of ticks, this value can be -1 to say 'AutoTicks'
      *istk(l+i) = Max((int)  *istk(l+i),-(i%2));
    }
    *nax=istk(l);
    *flagNax = TRUE;
  }
  else
  {
    *nax = getDefNax() ;
    *flagNax = FALSE;
  }
  return 1;
}
/*--------------------------------------------------------------------------*/
int get_strf_arg(char *fname,int pos,rhs_opts opts[], char ** strf )
{
  int m,n,l,first_opt=FirstOpt(),kopt;

  if (pos < first_opt)
  {
    if (VarType(pos))
    {
	    GetRhsVar(pos,STRING_DATATYPE, &m, &n, &l);
	    if ( m * n != 3 )
      {
		  Scierror(999,_("%s: Wrong size for input argument #%d: String of %d characters expected.\n"),fname,pos, 3);
	      return 0;
	    }
	  *strf = cstk(l);
    }
    else
	  {
	    /* def value can be changed */
      reinitDefStrf() ;
      *strf = getDefStrf() ;
	  }
  }
  else if ((kopt=FindOpt("strf",opts)))
  {
    GetRhsVar(kopt,STRING_DATATYPE, &m, &n, &l);
    if (m * n != 3)
    {
		Scierror(999,_("%s: Wrong size for input argument #%d: String of %d characters expected.\n"),fname,kopt,3);
		return 0;
    }
    *strf = cstk(l);
  }
  else
  {
    /* def value can be changed */

    reinitDefStrfN() ;
    *strf = getDefStrf() ;

  }
  return 1;
}
Beispiel #16
0
/*--------------------------------------------------------------------------*/
int sci_is_handle_valid(char *fname, unsigned long fname_len)
{

    /* Call isValid = is_handle_valid(h) with h a matrix of handle */
    /* and isValid a matrix of boolean */

    int nbCol = 0;
    int nbRow = 0;
    int nbHandle = 0;
    int handleStackPointer = 0;
    int resultStackPointer = 0;
    int i = 0;

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

    /* Get handles matrix */
    if (VarType(1) != sci_handles)
    {
        Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of handle expected.\n"), fname, 1);
        return  -1;
    }

    GetRhsVar(1, (char *)GRAPHICAL_HANDLE_DATATYPE, &nbRow, &nbCol, &handleStackPointer);
    nbHandle = nbRow * nbCol;

    /* create output matrix */
    CreateVar(Rhs + 1, (char *)MATRIX_OF_BOOLEAN_DATATYPE, &nbRow, &nbCol, &resultStackPointer);

    /* Check each handle */
    for (i = 0; i < nbHandle; i++)
    {
        *istk(resultStackPointer + i) = ((getObjectFromHandle((long)getHandleFromStack((size_t)(handleStackPointer + i))) != NULL)
                                         ? TRUE : FALSE);
    }

    LhsVar(1) = Rhs + 1;
    PutLhsVar();

    return 0;
}
/*--------------------------------------------------------------------------*/
int get_zminmax_arg(char *fname,int pos,rhs_opts opts[], double ** zminmax )
{
  int m,n,l,first_opt=FirstOpt(),kopt;

  if (pos < first_opt)
    {
      if (VarType(pos)) {
        GetRhsVar(pos,MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
	if (m * n != 2) {
      Scierror(999,"%s: Wrong size for input argument #%d: %d expected\n",fname,pos,2);
	  return 0;
	}
	*zminmax = stk(l);
      }
      else
	{
	  /** global value can be modified  **/
    double zeros[2] = { 0.0, 0.0 } ;
    setDefZminMax( zeros ) ;
	  *zminmax = getDefZminMax() ;
	}
    }
  else if ((kopt=FindOpt("zminmax",opts))) {/* named argument: rect=value */
    GetRhsVar(kopt,MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
    if (m * n != 2) {
      Scierror(999,"%s: Wrong size for input argument #%d: %d expected\n",fname,kopt,2);
      return 0;
    }
    *zminmax = stk(l);
  }
  else
    {
      /** global value can be modified  **/
      double zeros[2] = { 0.0, 0.0 } ;
      setDefZminMax( zeros ) ;
      *zminmax = getDefZminMax() ;
    }

  return 1;
}
/*--------------------------------------------------------------------------*/
int get_optional_int_arg(     char  * fname,
                               int    pos  ,
                              char  * name ,
                               int ** value,
                               int    sz   ,
                          rhs_opts    opts[] )
{
  int m,n,l,first_opt=FirstOpt(),kopt;

  if (pos < first_opt)
    {
      if (VarType(pos)) {
	GetRhsVar(pos,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
	CheckLength(pos,m*n,sz)
	  *value = istk(l);
      }
    }
  else if ((kopt=FindOpt(name,opts))) {
    GetRhsVar(kopt,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
    CheckLength(kopt,m*n,sz)
      *value = istk(l);
  }
  return 1;
}
Beispiel #19
0
/*----------------------------------------------------------------------------*/
int sci_str2code(char *fname, unsigned long fname_len)
{
    CheckRhs(1, 1);
    CheckLhs(1, 1);

    if (strcmp(fname, "str2code") == 0)
    {
        if (getWarningMode())
        {
            sciprint(_("%s: Feature %s is obsolete.\n"), _("Warning"), fname);
            sciprint(_("%s: Please use %s instead.\n"), _("Warning"), "ascii");
            sciprint(_("%s: This feature will be permanently removed in Scilab %s\n\n"), _("Warning"), "5.4.1");
        }
    }

    if (VarType(1) == sci_strings)
    {
        char **Input_String = NULL;
        int m1 = 0, n1 = 0;
        int *Output_Matrix = NULL;
        int nbOutput_Matrix = 0;

        GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Input_String);

        if ( ( strcmp(Input_String[0], "") == 0 ) || (Input_String[0] == NULL) )
        {
            /* str2code('') returns [] */
            int l = 0;

            freeArrayOfString(Input_String, m1 * n1);

            m1 = 0;
            n1 = 0;
            CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l);
            LhsVar(1) = Rhs + 1 ;
            PutLhsVar();

            return 0;
        }
        else
        {
            if (strlen(Input_String[0]))
            {
                nbOutput_Matrix = (int)strlen(Input_String[0]);
            }
            Output_Matrix = (int*)MALLOC( sizeof(int) * nbOutput_Matrix );
            if (Output_Matrix)
            {
                int i = 0;
                int numRow   = 1 ;
                int outIndex = 0;

                str2code(Output_Matrix, (const char *const *)Input_String);
                freeArrayOfString(Input_String, m1 * n1);

                /* put on scilab stack */
                CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &nbOutput_Matrix, &numRow, &outIndex); /*Output*/
                for ( i = 0 ; i < nbOutput_Matrix ; i++ )
                {
                    stk(outIndex)[i] = (double)Output_Matrix[i] ;
                }

                /* free pointers */
                FREE(Output_Matrix);
                Output_Matrix = NULL;

                LhsVar(1) = Rhs + 1 ;
                PutLhsVar();
            }
            else
            {
                freeArrayOfString(Input_String, m1 * n1);
                Scierror(999, _("%s: No more memory.\n"), fname);
            }
        }
    }
    else
    {
        Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of strings expected.\n"), fname, 1);
    }
    return 0;
}
Beispiel #20
0
/*--------------------------------------------------------------------------*/
int sci_xls_open(char *fname, unsigned long fname_len)
{
#undef IN
#define max_char_xls_open 256
    int i = 0, m1 = 0, n1 = 0, l1 = 0, l2 = 0, one = 1, fd = 0, f_swap = 0;
    int ierr = 0, ns = 0, result = 0;
    double res;
    char **sst = NULL;
    char **Sheetnames = NULL;
    int *Abspos = NULL;
    int nsheets = 0;
    char *filename_IN = NULL;
    char TMP[max_char_xls_open];

    char sep[2];
    char *TMPDIR = NULL;

#ifdef _MSC_VER
    sep[0] = '\\';
#else
    sep[0] = '/';
#endif
    sep[1] = '\0';

    CheckLhs(4, 4);
    CheckRhs(1, 1);

    if (VarType(1) != sci_strings)
    {
        Scierror(999, "%s: Invalid type of input argument: String expected.", fname);
        return 0;
    }

    /*  checking variable file */
    GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);

    filename_IN = expandPathVariable(cstk(l1));
    if (filename_IN)
    {
        /* bug 5615 */
        /* remove blank characters @ the end */
        int len = (int)strlen(filename_IN);
        int i = 0;

        if (len >= 1)
        {
            for (i = len - 1; i >= 0; i--)
            {
                if (filename_IN[i] == ' ')
                {
                    filename_IN[i] = '\0';
                }
                else
                {
                    break;
                }
            }
        }

        if (!FileExist(filename_IN))
        {
            Scierror(999, _("The file %s does not exist.\n"), filename_IN);
            return 0;
        }
    }

    TMPDIR = getTMPDIR();
    strcpy(TMP, TMPDIR);
    if (TMPDIR)
    {
        FREE(TMPDIR);
        TMPDIR = NULL;
    }

    strcat(TMP, sep);
    strcat(TMP, xls_basename(filename_IN));
    result = ripole(filename_IN, TMP, 0, 0);
    if (result != OLE_OK)
    {
        if (result == OLEER_NO_INPUT_FILE)
        {
            Scierror(999, _("The file %s does not exist.\n"), filename_IN);
        }
        else if (result == OLEER_NOT_OLE_FILE ||
                 result == OLEER_INSANE_OLE_FILE ||
                 result == OLEER_LOADFAT_BAD_BOUNDARY || result == OLEER_MINIFAT_READ_FAIL || result == OLEER_PROPERTIES_READ_FAIL)
        {
            Scierror(999, _("%s: File %s is not an ole2 file.\n"), fname, filename_IN);
            if (filename_IN)
            {
                FREE(filename_IN);
                filename_IN = NULL;
            }
        }
        else if (result == -1)
        {
            Scierror(999, _("%s: Cannot open file %s.\n"), fname, filename_IN);
            if (filename_IN)
            {
                FREE(filename_IN);
                filename_IN = NULL;
            }
        }
        return 0;
    }
    strcat(TMP, sep);
    strcat(TMP, "Workbook");
    C2F(mopen) (&fd, TMP, "rb", &f_swap, &res, &ierr);
    if (ierr != 0)
    {
        Scierror(999, _("%s: There is no xls stream in the ole2 file %s.\n"), fname, filename_IN);
        if (filename_IN)
        {
            FREE(filename_IN);
            filename_IN = NULL;
        }
        return 0;
    }

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

    CreateVar(Rhs + 1, MATRIX_OF_INTEGER_DATATYPE, &one, &one, &l2);
    *istk(l2) = fd;             /* logical unit */

    xls_open(&ierr, &fd, &sst, &ns, &Sheetnames, &Abspos, &nsheets);
    /*return *err:
     * 0 = OK
     * 1 = not an OLE file
     * 2 = no Workbook included
     * 3 = memory allocation problem
     * 4 = incorrect file
     * 5 = not a BIFF8 xls file
     */
    switch (ierr)
    {
        case 0:
            /* OK */
            break;

        case 1:
            Scierror(999, _("%s: Not an ole2 file.\n"), fname);
            return 0;

        case 2:
            Scierror(999, _("%s: The file has no Workbook directory.\n"), fname);
            return 0;

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

        case 4:
            Scierror(990, _("%s: Incorrect or corrupted file.\n"), fname);
            return 0;

        case 5:
            Scierror(999, _("%s: Only BIFF8 file format is handled.\n"), fname);
            return 0;

        default:
            break;

    }

    if (ns != 0)
    {
        /* Create a typed list to return the properties */
        CreateVarFromPtr(Rhs + 2, MATRIX_OF_STRING_DATATYPE, &one, &ns, sst);
        freeArrayOfString(sst, ns);
    }
    else
    {
        CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &ns, &ns, &l2);
    }

    if (nsheets != 0)
    {
        /* Create a typed list to return the properties */
        CreateVarFromPtr(Rhs + 3, MATRIX_OF_STRING_DATATYPE, &one, &nsheets, Sheetnames);
        freeArrayOfString(Sheetnames, nsheets);

        CreateVar(Rhs + 4, MATRIX_OF_DOUBLE_DATATYPE, &one, &nsheets, &l2);
        for (i = 0; i < nsheets; i++)
        {
            *stk(l2 + i) = Abspos[i];
        }
        if (Abspos)
        {
            FREE(Abspos);
            Abspos = NULL;
        }
    }
    else
    {
        CreateVar(Rhs + 3, MATRIX_OF_DOUBLE_DATATYPE, &nsheets, &nsheets, &l2);
        CreateVar(Rhs + 4, MATRIX_OF_DOUBLE_DATATYPE, &nsheets, &nsheets, &l2);
    }

    LhsVar(1) = Rhs + 1;
    LhsVar(2) = Rhs + 2;
    LhsVar(3) = Rhs + 3;
    LhsVar(4) = Rhs + 4;

    PutLhsVar();

    return 0;
}
Beispiel #21
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;
}
Beispiel #22
0
/*-----------------------------------------------------------------------------------*/
int sci_addinter(char *fname, unsigned long fname_len)
{
    CheckRhs(3, 3);
    CheckLhs(1, 1);

    if ( (VarType(1) == sci_strings) &&
            (VarType(2) == sci_strings) &&
            (VarType(3) == sci_strings) )
    {

        char **sharedlibname = NULL;
        char **spname = NULL;
        char **fcts = NULL;
        int nbfcts = 0;
        int ierr = 0;

        int m1 = 0, n1 = 0;
        int m2 = 0, n2 = 0;
        int m3 = 0, n3 = 0;

        GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &sharedlibname);
        if ( (m1 != n1) && (n1 != 1) )
        {
            freeArrayOfString(sharedlibname, m1 * n1);
            Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), fname, 1);
            return 0;
        }

        GetRhsVar(2, MATRIX_OF_STRING_DATATYPE, &m2, &n2, &spname);
        GetRhsVar(3, MATRIX_OF_STRING_DATATYPE, &m3, &n3, &fcts);

        if ( (m2 != n2) && (n2 != 1) )
        {
            freeArrayOfString(sharedlibname, m1 * n1);
            freeArrayOfString(spname, m2 * n2);
            freeArrayOfString(fcts, m3 * n3);
            Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), fname, 2);
            return 0;
        }

        if ( (m3 > 1) &&  (n3 > 1) ) /* check vector string */
        {
            freeArrayOfString(sharedlibname, m1 * n1);
            freeArrayOfString(spname, m2 * n2);
            freeArrayOfString(fcts, m3 * n3);
            Scierror(999, _("%s: Wrong size for input argument #%d: String vector expected.\n"), fname, 3);
            return 0;
        }

        if ( (m3 == 1) && (n3 >= 1) )
        {
            nbfcts = n3;
        }
        else if ( (n3 == 1) && (m3 >= 1) )
        {
            nbfcts = m3;
        }

        if (nbfcts >= NumberMaxFunctionsByGateway)
        {
            freeArrayOfString(sharedlibname, m1 * n1);
            freeArrayOfString(spname, m2 * n2);
            freeArrayOfString(fcts, m3 * n3);
            Scierror(999, _("%s: Wrong size for input argument #%d: String vector < %d expected.\n"), fname, 3, NumberMaxFunctionsByGateway);
            return 0;
        }

        ierr = AddInterfaceToScilab(sharedlibname[0], spname[0], fcts, nbfcts);
        if (ierr == 0)
        {
            LhsVar(1) = 0;
            PutLhsVar();
        }
        else
        {
            dl_genErrorMessage(fname, ierr, sharedlibname[0]);
        }

        freeArrayOfString(sharedlibname, m1 * n1);
        freeArrayOfString(spname, m2 * n2);
        freeArrayOfString(fcts, m3 * n3);
    }
    else
    {
        Scierror(999, _("%s: Wrong type for input arguments: Strings expected.\n"), fname);
    }
    return 0;
}
Beispiel #23
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 #24
0
/*--------------------------------------------------------------------------*/
int sci_x_dialog(char *fname, unsigned long fname_len)
{
    SciErr sciErr;

    int* piAddrlabelsAdr = NULL;
    int* piAddrinitialValueAdr = NULL;
    double* emptyMatrixAdr = NULL;

    int nbRow = 0, nbCol = 0;

    int messageBoxID = 0;

    char **initialValueAdr = 0;

    char **labelsAdr = 0;

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

    CheckInputArgument(pvApiCtx, 1, 2);
    CheckOutputArgument(pvApiCtx, 0, 1);

    if ((checkInputArgumentType(pvApiCtx, 1, sci_strings)))
    {
        sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrlabelsAdr);
        if (sciErr.iErr)
        {
            printError(&sciErr, 0);
            return 1;
        }

        // Retrieve a matrix of string at position 1.
        if (getAllocatedMatrixOfString(pvApiCtx, piAddrlabelsAdr, &nbRow, &nbCol, &labelsAdr))
        {
            Scierror(202, _("%s: Wrong type for argument #%d: String matrix expected.\n"), fname, 1);
            return 1;
        }
    }
    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, labelsAdr, nbCol * nbRow);
    freeAllocatedMatrixOfString(nbRow, nbCol, labelsAdr);

    if (nbInputArgument(pvApiCtx) == 2)
    {
        if (VarType(2) ==  sci_strings)
        {
            sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrinitialValueAdr);
            if (sciErr.iErr)
            {
                printError(&sciErr, 0);
                return 1;
            }

            // Retrieve a matrix of string at position 2.
            if (getAllocatedMatrixOfString(pvApiCtx, piAddrinitialValueAdr, &nbRow, &nbCol, &initialValueAdr))
            {
                Scierror(202, _("%s: Wrong type for argument #%d: String matrix expected.\n"), fname, 2);
                return 1;
            }
        }
        else
        {
            Scierror(999, _("%s: Wrong type for input argument #%d: Vector of strings expected.\n"), fname, 2);
            return FALSE;
        }

        setMessageBoxInitialValue(messageBoxID, initialValueAdr, nbCol * nbRow);
        freeAllocatedMatrixOfString(nbRow, nbCol, initialValueAdr);
    }

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

    /* Read the user answer */
    userValueSize = getMessageBoxValueSize(messageBoxID);
    if (userValueSize == 0)
    {
        nbRow = 0;
        nbCol = 0;

        sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, nbRow, nbCol, &emptyMatrixAdr);
        if (sciErr.iErr)
        {
            printError(&sciErr, 0);
            Scierror(999, _("%s: Memory allocation error.\n"), fname);
            return 1;
        }
    }
    else
    {
        userValue = getMessageBoxValue(messageBoxID);

        nbCol = 1;
        CreateVarFromPtr(nbInputArgument(pvApiCtx) + 1, MATRIX_OF_STRING_DATATYPE, &userValueSize, &nbCol, userValue);
        /* TO DO : delete of userValue */
    }

    AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
    ReturnArguments(pvApiCtx);
    return TRUE;
}
Beispiel #25
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 #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
extern int intpqmr(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=6;
    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)*11;
        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_x_choose_modeless(char *fname, unsigned long fname_len)
{
    SciErr sciErr;

    int* piAddritemsAdr = NULL;
    int* piAddrmessageAdr = NULL;
    int* piAddrbuttonLabelAdr = NULL;
    double* userValueAdr = NULL;

    int nbRow = 0, nbCol = 0;
    int nbRowItems = 0, nbColItems = 0;

    int messageBoxID = 0;

    char **itemsAdr = NULL;
    char **buttonLabelAdr = NULL;

    char **messageAdr = NULL;

    int userValue = 0;

    CheckInputArgument(pvApiCtx, 2, 3);
    CheckOutputArgument(pvApiCtx, 0, 1);

    if ((checkInputArgumentType(pvApiCtx, 1, sci_strings)))
    {
        sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddritemsAdr);
        if (sciErr.iErr)
        {
            printError(&sciErr, 0);
            return 1;
        }

        // Retrieve a matrix of string at position 1.
        if (getAllocatedMatrixOfString(pvApiCtx, piAddritemsAdr, &nbRowItems, &nbColItems, &itemsAdr))
        {
            Scierror(202, _("%s: Wrong type for argument #%d: String matrix expected.\n"), fname, 1);
            return 1;
        }
    }
    else
    {
        Scierror(999, _("%s: Wrong type for input argument #%d: Vector of strings expected.\n"), fname, 1);
        return FALSE;
    }

    if ((checkInputArgumentType(pvApiCtx, 2, sci_strings)))
    {
        sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrmessageAdr);
        if (sciErr.iErr)
        {
            printError(&sciErr, 0);
            return 1;
        }

        // Retrieve a matrix of string at position 2.
        if (getAllocatedMatrixOfString(pvApiCtx, piAddrmessageAdr, &nbRow, &nbCol, &messageAdr))
        {
            freeAllocatedMatrixOfString(nbRowItems, nbColItems, itemsAdr);
            Scierror(202, _("%s: Wrong type for argument #%d: String matrix expected.\n"), fname, 2);
            return 1;
        }

    }
    else
    {
        freeAllocatedMatrixOfString(nbRowItems, nbColItems, itemsAdr);
        Scierror(999, _("%s: Wrong type for input argument #%d: Vector of strings expected.\n"), fname, 2);
        return FALSE;
    }

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

    /* Title is a default title */
    setMessageBoxTitle(messageBoxID, _("Scilab Choose Message"));
    /* Message */
    setMessageBoxMultiLineMessage(messageBoxID, messageAdr, nbCol * nbRow);
    /* ListBox Items */
    setMessageBoxListBoxItems(messageBoxID, itemsAdr, nbColItems * nbRowItems);
    /* Modality */
    setMessageBoxModal(messageBoxID, FALSE);

    freeAllocatedMatrixOfString(nbRowItems, nbColItems, itemsAdr);
    freeAllocatedMatrixOfString(nbRow, nbCol, messageAdr);

    if (nbInputArgument(pvApiCtx) == 3)
    {
        if (VarType(3) ==  sci_strings)
        {
            sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrbuttonLabelAdr);
            if (sciErr.iErr)
            {
                printError(&sciErr, 0);
                return 1;
            }

            // Retrieve a matrix of string at position 3.
            if (getAllocatedMatrixOfString(pvApiCtx, piAddrbuttonLabelAdr, &nbRow, &nbCol, &buttonLabelAdr))
            {
                Scierror(202, _("%s: Wrong type for argument #%d: String matrix expected.\n"), fname, 3);
                return 1;
            }

            if (nbRow*nbCol != 1)
            {
                freeAllocatedMatrixOfString(nbRow, nbCol, buttonLabelAdr);
                Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 3);
                return FALSE;
            }
        }
        else
        {
            Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 3);
            return FALSE;
        }

        setMessageBoxButtonsLabels(messageBoxID, buttonLabelAdr, nbCol * nbRow);
        freeAllocatedMatrixOfString(nbRow, nbCol, buttonLabelAdr);
    }

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

    /* Read the user answer */
    userValue = getMessageBoxSelectedItem(messageBoxID);

    nbRow = 1;
    nbCol = 1;

    sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, nbRow, nbCol, &userValueAdr);
    if (sciErr.iErr)
    {
        printError(&sciErr, 0);
        Scierror(999, _("%s: Memory allocation error.\n"), fname);
        return 1;
    }

    *userValueAdr = userValue;

    AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
    ReturnArguments(pvApiCtx);
    return TRUE;
}
Beispiel #29
0
/*--------------------------------------------------------------------------*/
int C2F(sci_predef)(char *fname,unsigned long fname_len)
{
    int previous_n_var_protected = 0;

    Rhs = Max(0, Rhs);

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

    previous_n_var_protected = getNumberPredefVariablesProtected();

    if (Rhs == 0)
    {
        int one = 1 ,l = 0;

        CreateVar(Rhs+1, MATRIX_OF_INTEGER_DATATYPE, &one, &one,&l);
        *istk(l) = (int) previous_n_var_protected;

        LhsVar(1) = Rhs + 1;
        PutLhsVar();
    }
    else /* Rhs == 1 */
    {
        int *out_values = NULL;
        int nout = 0 , mout = 0;
        int new_n_var_protected = 0;

        if ( VarType(1) == sci_matrix )
        {
            int m1 = 0, n1 = 0, l1 = 0;
            GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
            if ( (m1 == n1) && (n1 == 1) )
            {
                double dn_var = *stk(l1);
                int n_var = (int) dn_var;

                if (dn_var != (double)n_var)
                {
                    Scierror(999,_("%s: Wrong value for input argument #%d: A int expected.\n"),fname,1);
                    return 0;
                }

                setNumberPredefVariablesProtected(n_var);
            }
            else
            {
                Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"),fname,1);
                return 0;
            }
        }
        else if ( VarType(1) == sci_strings )
        {	
            int m1 = 0, n1 = 0, l1 = 0;
            char *protectMode = NULL;

            GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
            protectMode = cstk(l1);
            if (protectMode)
            {
                if ( ((strlen(protectMode) == 1 ) && (protectMode[0] == 'c')) ||
                    (strcmp(protectMode,"clear") == 0) )
                {
                    clearPredef();
                }
                else if ( ((strlen(protectMode) == 1 ) && (protectMode[0] == 'a')) ||
                    (strcmp(protectMode,"all") == 0) )
                {
                    predefAll();
                }
                else if (strcmp(protectMode,"names") == 0)
                {
                    int nbElements = 0;
                    char **variablesPredef = getPredefinedVariablesName(&nbElements);
                    if (variablesPredef && (nbElements > 0))
                    {
                        SciErr sciErr = createMatrixOfString(pvApiCtx, Rhs + 1, nbElements, 1, variablesPredef);
                        freeArrayOfString(variablesPredef, nbElements);
                        variablesPredef = NULL;
                        if(sciErr.iErr)
                        {
                            printError(&sciErr, 0);
                            Scierror(999,_("%s: Memory allocation error.\n"), fname);
                        }
                        else
                        {
                            LhsVar(1) = Rhs + 1;
                            PutLhsVar();
                        }
                        return 0;
                    }
                    else
                    {
                        createEmptyMatrix(pvApiCtx, Rhs + 1);
                        LhsVar(1) = Rhs + 1;
                        PutLhsVar();
                        return 0;
                    }
                }
                else
                {
                    Scierror(999,_("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"),fname,1,"clear","all");
                    return 0;
                }
            }
        }
        else
        {
            Scierror(999,_("%s: Wrong type for input argument #%d: A scalar or a string expected.\n"),fname,1);
            return 0;
        }

        new_n_var_protected = getNumberPredefVariablesProtected();

        out_values = (int*)MALLOC(sizeof(int)*2);
        out_values[0] = previous_n_var_protected;
        out_values[1] = new_n_var_protected;

        nout = 1 ; mout = 2;
        CreateVarFromPtr(Rhs+1,MATRIX_OF_INTEGER_DATATYPE, &nout, &mout, &out_values);
        if (out_values) {FREE(out_values); out_values = NULL;}

        LhsVar(1) = Rhs + 1;
        PutLhsVar();
    }
    return 0;
}
Beispiel #30
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;
}