277 lines
6.7 KiB
C
277 lines
6.7 KiB
C
/*
|
|
* $Id$
|
|
*/
|
|
|
|
/*
|
|
* Harbour Project source code:
|
|
* The Array API (Harbour level)
|
|
*
|
|
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
|
|
* www - http://www.harbour-project.org
|
|
*
|
|
* This program is free software; you can redistribute it and/or modify
|
|
* it under the terms of the GNU General Public License as published by
|
|
* the Free Software Foundation; either version 2 of the License, or
|
|
* (at your option) any later version, with one exception:
|
|
*
|
|
* The exception is that if you link the Harbour Runtime Library (HRL)
|
|
* and/or the Harbour Virtual Machine (HVM) with other files to produce
|
|
* an executable, this does not by itself cause the resulting executable
|
|
* to be covered by the GNU General Public License. Your use of that
|
|
* executable is in no way restricted on account of linking the HRL
|
|
* and/or HVM code into it.
|
|
*
|
|
* This program is distributed in the hope that it will be useful,
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
* GNU General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU General Public License
|
|
* along with this program; if not, write to the Free Software
|
|
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
|
|
* their web site at http://www.gnu.org/).
|
|
*
|
|
*/
|
|
|
|
#include "hbapi.h"
|
|
#include "hbapiitm.h"
|
|
#include "hbapierr.h"
|
|
#include "hbapilng.h"
|
|
|
|
/* This function creates an array item using 'iDimension' as an index
|
|
* to retrieve the number of elements from the parameter list.
|
|
*/
|
|
static void hb_arrayNewRagged( PHB_ITEM pArray, int iDimension )
|
|
{
|
|
ULONG ulElements;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_arrayNewRagged(%p, %d)", pArray, iDimension));
|
|
|
|
ulElements = ( ULONG ) hb_parnl( iDimension );
|
|
|
|
/* create an array */
|
|
hb_arrayNew( pArray, ulElements );
|
|
|
|
if( ++iDimension <= hb_pcount() )
|
|
{
|
|
/* call self recursively to create next dimensions
|
|
*/
|
|
while( ulElements )
|
|
hb_arrayNewRagged( hb_arrayGetItemPtr( pArray, ulElements-- ), iDimension );
|
|
}
|
|
}
|
|
|
|
HB_FUNC( ARRAY )
|
|
{
|
|
int iPCount = hb_pcount();
|
|
|
|
if( iPCount > 0 )
|
|
{
|
|
BOOL bError = FALSE;
|
|
int iParam;
|
|
|
|
for( iParam = 1; iParam <= iPCount; iParam++ )
|
|
{
|
|
if( ! ISNUM( iParam ) )
|
|
{
|
|
bError = TRUE;
|
|
break;
|
|
}
|
|
|
|
if( hb_parnl( iParam ) < 0 ) /* || hb_parnl( iParam ) <= 4096 */
|
|
{
|
|
hb_errRT_BASE( EG_BOUND, 1131, NULL, hb_langDGetErrorDesc( EG_ARRDIMENSION ) );
|
|
bError = TRUE;
|
|
break;
|
|
}
|
|
}
|
|
|
|
if( ! bError )
|
|
hb_arrayNewRagged( &hb_stack.Return, 1 );
|
|
}
|
|
}
|
|
|
|
HB_FUNC( AADD )
|
|
{
|
|
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
|
|
|
|
if( pArray )
|
|
{
|
|
PHB_ITEM pValue = hb_param( 2, IT_ANY );
|
|
|
|
if( pValue && hb_arrayAdd( pArray, pValue ) )
|
|
hb_itemReturn( pValue );
|
|
else
|
|
hb_errRT_BASE( EG_BOUND, 1187, NULL, "AADD" );
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1123, NULL, "AADD" );
|
|
|
|
if( pResult )
|
|
{
|
|
hb_itemReturn( pResult );
|
|
hb_itemRelease( pResult );
|
|
}
|
|
}
|
|
}
|
|
|
|
/* NOTE: CA-Cl*pper 5.3 and older will return NIL on bad parameter, 5.3a,b
|
|
will throw a runtime error. [vszakats] */
|
|
|
|
HB_FUNC( ASIZE )
|
|
{
|
|
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
|
|
|
|
if( pArray && ISNUM( 2 ) )
|
|
{
|
|
long lSize = hb_parnl( 2 );
|
|
|
|
hb_arraySize( pArray, HB_MAX( lSize, 0 ) );
|
|
|
|
hb_itemReturn( pArray ); /* ASize() returns the array itself */
|
|
}
|
|
#ifdef HB_COMPAT_C53 /* From CA-Cl*pper 5.3a */
|
|
else
|
|
hb_errRT_BASE( EG_ARG, 2023, NULL, "ASIZE" );
|
|
#endif
|
|
}
|
|
|
|
HB_FUNC( ATAIL )
|
|
{
|
|
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
|
|
|
|
if( pArray )
|
|
hb_arrayLast( pArray, &hb_stack.Return );
|
|
}
|
|
|
|
HB_FUNC( AINS )
|
|
{
|
|
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
|
|
|
|
if( pArray )
|
|
{
|
|
if( ISNUM( 2 ) )
|
|
hb_arrayIns( pArray, hb_parnl( 2 ) );
|
|
|
|
hb_itemReturn( pArray ); /* AIns() returns the array itself */
|
|
}
|
|
}
|
|
|
|
HB_FUNC( ADEL )
|
|
{
|
|
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
|
|
|
|
if( pArray )
|
|
{
|
|
if( ISNUM( 2 ) )
|
|
hb_arrayDel( pArray, hb_parnl( 2 ) );
|
|
|
|
hb_itemReturn( pArray ); /* ADel() returns the array itself */
|
|
}
|
|
}
|
|
|
|
HB_FUNC( AFILL )
|
|
{
|
|
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
|
|
|
|
if( pArray )
|
|
{
|
|
PHB_ITEM pValue = hb_param( 2, IT_ANY );
|
|
|
|
if( pValue )
|
|
{
|
|
ULONG ulStart = hb_parnl( 3 );
|
|
ULONG ulCount = hb_parnl( 4 );
|
|
|
|
hb_arrayFill( pArray,
|
|
pValue,
|
|
ISNUM( 3 ) ? &ulStart : NULL,
|
|
ISNUM( 4 ) ? &ulCount : NULL );
|
|
}
|
|
|
|
hb_itemReturn( pArray ); /* AFill() returns the array itself */
|
|
}
|
|
}
|
|
|
|
HB_FUNC( ASCAN )
|
|
{
|
|
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
|
|
PHB_ITEM pValue = hb_param( 2, IT_ANY );
|
|
|
|
if( pArray && pValue )
|
|
{
|
|
ULONG ulStart = hb_parnl( 3 );
|
|
ULONG ulCount = hb_parnl( 4 );
|
|
|
|
hb_retnl( hb_arrayScan( pArray,
|
|
pValue,
|
|
ISNUM( 3 ) ? &ulStart : NULL,
|
|
ISNUM( 4 ) ? &ulCount : NULL ) );
|
|
}
|
|
else
|
|
hb_retnl( 0 );
|
|
}
|
|
|
|
HB_FUNC( AEVAL )
|
|
{
|
|
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
|
|
PHB_ITEM pBlock = hb_param( 2, IT_BLOCK );
|
|
|
|
if( pArray && pBlock )
|
|
{
|
|
ULONG ulStart = hb_parnl( 3 );
|
|
ULONG ulCount = hb_parnl( 4 );
|
|
|
|
hb_arrayEval( pArray,
|
|
pBlock,
|
|
ISNUM( 3 ) ? &ulStart : NULL,
|
|
ISNUM( 4 ) ? &ulCount : NULL );
|
|
|
|
hb_itemReturn( pArray ); /* AEval() returns the array itself */
|
|
}
|
|
else
|
|
hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL" );
|
|
}
|
|
|
|
HB_FUNC( ACOPY )
|
|
{
|
|
PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY );
|
|
PHB_ITEM pDstArray = hb_param( 2, IT_ARRAY );
|
|
|
|
if( pSrcArray && pDstArray )
|
|
{
|
|
/* CA-Cl*pper works this way. */
|
|
if( ! hb_arrayIsObject( pSrcArray ) && ! hb_arrayIsObject( pDstArray ) )
|
|
{
|
|
ULONG ulStart = hb_parnl( 3 );
|
|
ULONG ulCount = hb_parnl( 4 );
|
|
ULONG ulTarget = hb_parnl( 5 );
|
|
|
|
hb_arrayCopy( pSrcArray,
|
|
pDstArray,
|
|
ISNUM( 3 ) ? &ulStart : NULL,
|
|
ISNUM( 4 ) ? &ulCount : NULL,
|
|
ISNUM( 5 ) ? &ulTarget : NULL );
|
|
}
|
|
|
|
hb_itemReturn( pDstArray ); /* ACopy() returns the target array */
|
|
}
|
|
}
|
|
|
|
/* NOTE: Clipper will return NIL if the parameter is not an array. [vszakats] */
|
|
|
|
HB_FUNC( ACLONE )
|
|
{
|
|
PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY );
|
|
|
|
if( pSrcArray && ! hb_arrayIsObject( pSrcArray ) )
|
|
{
|
|
PHB_ITEM pDstArray = hb_arrayClone( pSrcArray );
|
|
|
|
hb_itemReturn( pDstArray ); /* AClone() returns the new array */
|
|
hb_itemRelease( pDstArray );
|
|
}
|
|
}
|
|
|