fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2007-07-15 09:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/contrib/libct/Makefile
  * harbour/contrib/libct/makefile.bc
  * harbour/contrib/libct/makefile.vc
  * harbour/contrib/libct/misc1.c
  + harbour/contrib/libct/misc2.c
  + harbour/contrib/libct/misc3.c
  * harbour/contrib/libct/num1.c
  * harbour/contrib/libct/numconv.prg
  + harbour/contrib/libct/numcount.c
  + harbour/contrib/libct/numline.c
  * harbour/contrib/libct/numat.c
    * synced with xHarbour modifications and fixes
    + added some missing functions borrowed from xHarbour, in most
      cases it was Pavel Tsarenko code
    ! some fixes
    * indenting

  * harbour/source/rtl/gtfunc.c
    * replaced hb_itemRelease( hb_itemReturn( pItem ) ) by
      hb_itemReturnRelease( pItem )
This commit is contained in:
Przemyslaw Czerpak
2007-07-15 07:20:25 +00:00
parent e19e015ae8
commit e72214aecf
13 changed files with 589 additions and 229 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
harbour/ChangeLog
View File

@@ -8,6 +8,28 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-07-15 09:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/contrib/libct/Makefile
* harbour/contrib/libct/makefile.bc
* harbour/contrib/libct/makefile.vc
* harbour/contrib/libct/misc1.c
+ harbour/contrib/libct/misc2.c
+ harbour/contrib/libct/misc3.c
* harbour/contrib/libct/num1.c
* harbour/contrib/libct/numconv.prg
+ harbour/contrib/libct/numcount.c
+ harbour/contrib/libct/numline.c
* harbour/contrib/libct/numat.c
* synced with xHarbour modifications and fixes
+ added some missing functions borrowed from xHarbour, in most
cases it was Pavel Tsarenko code
! some fixes
* indenting
* harbour/source/rtl/gtfunc.c
* replaced hb_itemRelease( hb_itemReturn( pItem ) ) by
hb_itemReturnRelease( pItem )
2007-07-14 22:55 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/source/rtl/gttrm/gttrm.c
* added protection against corrupted by programmer screen buffer

4
harbour/contrib/libct/Makefile
View File

@@ -46,8 +46,12 @@ C_SOURCES = \
justify.c \
keyset.c \
misc1.c \
misc2.c \
misc3.c \
num1.c \
numat.c \
numcount.c \
numline.c \
pos1.c \
pos2.c \
posdiff.c \

20
harbour/contrib/libct/makefile.bc
View File

@@ -130,8 +130,12 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\justify.obj \
$(OBJ_DIR)\keyset.obj \
$(OBJ_DIR)\misc1.obj \
$(OBJ_DIR)\misc2.obj \
$(OBJ_DIR)\misc3.obj \
$(OBJ_DIR)\num1.obj \
$(OBJ_DIR)\numat.obj \
$(OBJ_DIR)\numcount.obj \
$(OBJ_DIR)\numline.obj \
$(OBJ_DIR)\pos1.obj \
$(OBJ_DIR)\pos2.obj \
$(OBJ_DIR)\posdiff.obj \
@@ -333,6 +337,14 @@ $(OBJ_DIR)\misc1.obj : $(TOOLS_DIR)\misc1.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\misc2.obj : $(TOOLS_DIR)\misc2.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\misc3.obj : $(TOOLS_DIR)\misc3.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\num1.obj : $(TOOLS_DIR)\num1.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
@@ -341,6 +353,14 @@ $(OBJ_DIR)\numat.obj : $(TOOLS_DIR)\numat.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\numcount.obj : $(TOOLS_DIR)\numcount.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\numline.obj : $(TOOLS_DIR)\numline.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\pos1.obj : $(TOOLS_DIR)\pos1.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,

8
harbour/contrib/libct/makefile.vc
View File

@@ -147,8 +147,12 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\justify.obj \
$(OBJ_DIR)\keyset.obj \
$(OBJ_DIR)\misc1.obj \
$(OBJ_DIR)\misc2.obj \
$(OBJ_DIR)\misc3.obj \
$(OBJ_DIR)\num1.obj \
$(OBJ_DIR)\numat.obj \
$(OBJ_DIR)\numcount.obj \
$(OBJ_DIR)\numline.obj \
$(OBJ_DIR)\pos1.obj \
$(OBJ_DIR)\pos2.obj \
$(OBJ_DIR)\posdiff.obj \
@@ -218,8 +222,12 @@ CLEAN:
-@if exist $(OBJ_DIR)\ftoc.* del $(OBJ_DIR)\ftoc.*
-@if exist $(OBJ_DIR)\justify.* del $(OBJ_DIR)\justify.*
-@if exist $(OBJ_DIR)\misc1.* del $(OBJ_DIR)\misc1.*
-@if exist $(OBJ_DIR)\misc2.* del $(OBJ_DIR)\misc2.*
-@if exist $(OBJ_DIR)\misc3.* del $(OBJ_DIR)\misc3.*
-@if exist $(OBJ_DIR)\num1.* del $(OBJ_DIR)\num1.*
-@if exist $(OBJ_DIR)\numat.* del $(OBJ_DIR)\numat.*
-@if exist $(OBJ_DIR)\numcount.* del $(OBJ_DIR)\numcount.*
-@if exist $(OBJ_DIR)\numline.* del $(OBJ_DIR)\numline.*
-@if exist $(OBJ_DIR)\pos1.* del $(OBJ_DIR)\pos1.*
-@if exist $(OBJ_DIR)\pos2.* del $(OBJ_DIR)\pos2.*
-@if exist $(OBJ_DIR)\posdiff.* del $(OBJ_DIR)\posdiff.*

54
harbour/contrib/libct/misc1.c
View File

@@ -50,7 +50,6 @@
*
*/
#include "ct.h"
@@ -103,44 +102,23 @@
HB_FUNC( XTOC )
{
union
union
{
double value;
char string[ sizeof( double )];
} xConvert;
char pcString[ sizeof( double ) ];
char string[sizeof( double )];
} xConvert;
if (ISCHAR( 1 ))
{
hb_retc( hb_parc( 1 ));
}
else if (ISNUM( 1 ))
{
xConvert.value = hb_parnd( 1 );
hb_retclen( xConvert.string, sizeof( double ) );
}
else if (ISLOG( 1 ))
{
if (hb_parl( 1 ) == 0)
pcString[0] = 0x46;
else
pcString[0] = 0x54;
hb_retclen( pcString, 1 );
}
else if (ISDATE( 1 ))
{
hb_retc( hb_pards( 1 ));
}
else
{
pcString[0] = 0x00;
hb_retc( pcString );
}
if( ISCHAR( 1 ) )
hb_retc( hb_parc( 1 ) );
else if( ISDATE( 1 ) )
hb_retc( hb_pards( 1 ) );
else if( ISNUM( 1 ) )
{
xConvert.value = hb_parnd( 1 );
hb_retclen( xConvert.string, sizeof( double ) );
}
else if( ISLOG( 1 ) )
hb_retclen( hb_parl( 1 ) ? "T" : "F", 1 );
else
hb_retc( NULL );
}

103
harbour/contrib/libct/misc2.c Normal file
View File

@@ -0,0 +1,103 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 Miscellaneous functions: - COMPLEMENT(), NUL()
*
* Copyright 2005 Pavel Tsarenko <tpe2@mail.ru>
* 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, or (at your option)
* any later version.
*
* 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 software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries 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 Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
HB_FUNC( COMPLEMENT )
{
PHB_ITEM pItem = hb_param( 1, HB_IT_ANY );
if( pItem )
{
if( HB_IS_STRING( pItem ) )
{
ULONG ulLen = hb_itemGetCLen( pItem ), ulPos;
if( ulLen > 0 )
{
char *szBuffer = ( char * ) hb_xgrab( ulLen + 1 ), *szSrc = hb_itemGetCPtr( pItem );
for( ulPos = 0; ulPos < ulLen; ulPos++ )
szBuffer[ulPos] = ~szSrc[ulPos];
hb_retclen_buffer( szBuffer, ulLen );
}
else
hb_retc( NULL );
}
else if( HB_IS_DATE( pItem ) )
hb_retdl( 4537847 - hb_itemGetDL( pItem ) );
else if( HB_IS_NUMINT( pItem ) )
hb_retnint( -hb_itemGetNInt( pItem ) );
else if( HB_IS_NUMERIC( pItem ) )
{
int iWidth, iDec;
double dValue;
dValue = hb_itemGetND( pItem );
hb_itemGetNLen( pItem, &iWidth, &iDec );
hb_retndlen( -dValue, iWidth, iDec );
}
else if( HB_IS_LOGICAL( pItem ) )
hb_retl( !hb_itemGetL( pItem ) );
else
hb_ret();
}
else
hb_ret();
}
HB_FUNC( NUL )
{
hb_retc( NULL );
}

90
harbour/contrib/libct/misc3.c Normal file
View File

@@ -0,0 +1,90 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 Miscellaneous functions: - KBDSTAT()
*
* Copyright 2005 Pavel Tsarenko <tpe2@mail.ru>
* 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, or (at your option)
* any later version.
*
* 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 software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries 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 Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
#include "hbapigt.h"
#include "hbapiitm.h"
#include "hbset.h"
HB_FUNC( KBDSTAT )
{
int iRet = 0;
HB_GT_INFO gtInfo;
gtInfo.pNewVal = NULL;
gtInfo.pResult = NULL;
hb_gtInfo( GTI_KBDSHIFTS, &gtInfo );
if( gtInfo.pResult )
{
int iState = hb_itemGetNI( gtInfo.pResult );
hb_itemRelease( gtInfo.pResult );
if( iState & GTI_KBD_SHIFT )
iRet |= 0x01;
if( iState & GTI_KBD_CTRL )
iRet |= 0x04;
if( iState & GTI_KBD_ALT )
iRet |= 0x08;
if( iState & GTI_KBD_SCROLOCK )
iRet |= 0x10;
if( iState & GTI_KBD_NUMLOCK )
iRet |= 0x20;
if( iState & GTI_KBD_CAPSLOCK )
iRet |= 0x40;
if( hb_set.HB_SET_INSERT )
iRet |= 0x80;
}
hb_retni( iRet );
}

127
harbour/contrib/libct/num1.c
View File

@@ -61,7 +61,7 @@
*
*/
#include "ct.h"
@@ -104,36 +104,31 @@
HB_FUNC( CELSIUS )
{
if( ISNUM(1) )
{
double dInput = hb_parnd(1);
double dResult;
dResult = (5.0 / 9.0) * ( dInput - 32.0 );
hb_retnd( dResult );
}
else
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CELSIUS,
NULL, "CELSIUS", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retnd (0.0);
}
}
if( ISNUM( 1 ) )
{
double dInput = hb_parnd( 1 );
double dResult;
return;
dResult = ( 5.0 / 9.0 ) * ( dInput - 32.0 );
hb_retnd( dResult );
}
else
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if( iArgErrorMode != CT_ARGERR_IGNORE )
{
pSubst = ct_error_subst( ( USHORT ) iArgErrorMode, EG_ARG,
CT_ERROR_CELSIUS, NULL, "CELSIUS", 0,
EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS );
}
if( pSubst != NULL )
hb_itemReturnRelease( pSubst );
else
hb_retnd( 0.0 );
}
}
@@ -176,39 +171,34 @@ HB_FUNC( CELSIUS )
HB_FUNC( FAHRENHEIT )
{
if( ISNUM(1) )
{
double dInput = hb_parnd(1);
double dResult;
if( ISNUM( 1 ) )
{
double dInput = hb_parnd( 1 );
double dResult;
dResult = (( 9.0 / 5.0) * dInput ) + 32.0 ;
hb_retnd( dResult );
}
else
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_FAHRENHEIT,
NULL, "FAHRENHEIT", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retnd (0.0);
}
}
dResult = ( ( 9.0 / 5.0 ) * dInput ) + 32.0;
hb_retnd( dResult );
}
else
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
return;
if( iArgErrorMode != CT_ARGERR_IGNORE )
{
pSubst = ct_error_subst( ( USHORT ) iArgErrorMode, EG_ARG,
CT_ERROR_FAHRENHEIT, NULL, "FAHRENHEIT", 0,
EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS );
}
if( pSubst != NULL )
hb_itemReturnRelease( pSubst );
else
hb_retnd( 0.0 );
}
}
/* $DOC$
* $FUNCNAME$
* INFINITY()
@@ -244,19 +234,10 @@ HB_FUNC( FAHRENHEIT )
* $END$
*/
HB_FUNC( INFINITY )
HB_FUNC( INFINITY )
{
if (ISLOG (1) && hb_parl(1))
{
hb_retnd (DBL_MAX);
}
else
{
hb_retnd (93786976294838206460.00);
}
return;
if( ISLOG( 1 ) && hb_parl( 1 ) )
hb_retnd( DBL_MAX );
else
hb_retnd( 93786976294838206460.00 );
}

188
harbour/contrib/libct/numat.c
View File

@@ -52,7 +52,6 @@
*
*/
#include "ct.h"
@@ -84,116 +83,93 @@
* $END$
*/
HB_FUNC(NUMAT)
HB_FUNC( NUMAT )
{
if( ( ISCHAR( 1 ) ) && ( ISCHAR( 2 ) ) )
{
char *pcStringToMatch = ( char * ) hb_parc( 1 );
size_t sStrToMatchLen = ( size_t ) hb_parclen( 1 );
char *pcString = ( char * ) hb_parc( 2 );
size_t sStrLen = ( size_t ) hb_parclen( 2 );
int iMultiPass = ct_getatmupa();
int iAtLike = ct_getatlike();
char cAtLike = ct_getatlikechar();
size_t sIgnore, sMatchStrLen, sSubStrLen;
ULONG ulCounter;
char *pc, *pcSubStr;
if ((ISCHAR (1)) && (ISCHAR (2)))
{
char *pcStringToMatch = (char *)hb_parc (1);
size_t sStrToMatchLen = (size_t)hb_parclen (1);
char *pcString = (char *)hb_parc (2);
size_t sStrLen = (size_t)hb_parclen (2);
int iMultiPass = ct_getatmupa();
int iAtLike = ct_getatlike();
char cAtLike = ct_getatlikechar();
size_t sIgnore, sMatchStrLen, sSubStrLen;
ULONG ulCounter;
char *pc, *pcSubStr;
/* eventually ignore some characters */
if (ISNUM (3))
sIgnore = (size_t)hb_parnl (3);
else
sIgnore = 0;
if (sIgnore >= sStrLen)
{
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_NUMAT,
NULL, "NUMAT", 0, EF_CANDEFAULT, 3,
hb_paramError (1), hb_paramError (2),
hb_paramError (3));
}
hb_retnl (0);
return;
}
else
{
pcString += sIgnore;
sStrLen -= sIgnore;
}
ulCounter = 0;
pcSubStr = pcString;
sSubStrLen = sStrLen;
do
{
switch (iAtLike)
{
case CT_SETATLIKE_EXACT:
{
pc = ct_at_exact_forward (pcSubStr, sSubStrLen,
pcStringToMatch, sStrToMatchLen,
&sMatchStrLen);
}; break;
case CT_SETATLIKE_WILDCARD:
{
pc = ct_at_wildcard_forward (pcSubStr, sSubStrLen,
pcStringToMatch, sStrToMatchLen,
cAtLike, &sMatchStrLen);
}; break;
default:
{
pc = NULL;
};
}
ulCounter++;
if (iMultiPass)
pcSubStr = pc+1;
/* eventually ignore some characters */
if( ISNUM( 3 ) )
sIgnore = ( size_t ) hb_parnl( 3 );
else
pcSubStr = pc+sMatchStrLen;
sSubStrLen = sStrLen-(pcSubStr-pcString);
} while (pc != NULL);
sIgnore = 0;
hb_retnl (ulCounter-1);
if( sIgnore >= sStrLen )
{
int iArgErrorMode = ct_getargerrormode();
}
else /* ((ISCHAR (1)) && (ISCHAR (2))) */
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_NUMAT,
NULL, "NUMAT", 0, EF_CANSUBSTITUTE, 3,
hb_paramError (1), hb_paramError (2),
hb_paramError (3));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retnl (0);
}
return;
}
if( iArgErrorMode != CT_ARGERR_IGNORE )
{
ct_error( ( USHORT ) iArgErrorMode, EG_ARG, CT_ERROR_NUMAT, NULL,
"NUMAT", 0, EF_CANDEFAULT, HB_ERR_ARGS_BASEPARAMS );
}
hb_retni( 0 );
return;
}
else
{
pcString += sIgnore;
sStrLen -= sIgnore;
}
return;
ulCounter = 0;
pcSubStr = pcString;
sSubStrLen = sStrLen;
do
{
switch ( iAtLike )
{
case CT_SETATLIKE_EXACT:
pc = ct_at_exact_forward( pcSubStr, sSubStrLen, pcStringToMatch,
sStrToMatchLen, &sMatchStrLen );
break;
case CT_SETATLIKE_WILDCARD:
pc = ct_at_wildcard_forward( pcSubStr, sSubStrLen,
pcStringToMatch, sStrToMatchLen,
cAtLike, &sMatchStrLen );
break;
default:
pc = NULL;
}
ulCounter++;
if( iMultiPass )
pcSubStr = pc + 1;
else
pcSubStr = pc + sMatchStrLen;
sSubStrLen = sStrLen - ( pcSubStr - pcString );
}
while( pc != NULL );
hb_retnl( ulCounter - 1 );
}
else /* ( ISCHAR( 1 ) && ISCHAR( 2 ) ) */
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if( iArgErrorMode != CT_ARGERR_IGNORE )
{
pSubst = ct_error_subst( ( USHORT ) iArgErrorMode, EG_ARG,
CT_ERROR_NUMAT, NULL, "NUMAT", 0,
EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS );
}
if( pSubst != NULL )
hb_itemReturnRelease( pSubst );
else
hb_retni( 0 );
}
}

37
harbour/contrib/libct/numconv.prg
View File

@@ -85,22 +85,28 @@
FUNCTION NTOC( xNum, nBase, nLenght, cPad )
LOCAL cNum
Default cPad to "0"
Default cPad to " "
Default nBase to 10
IF VALTYPE( xNum ) == "C"
xNum = ALLTRIM( xNum )
xNum = UPPER( xNum )
xNum = UPPER( ALLTRIM( xNum ) )
xNum = CTON( xNum, 16 )
ENDIF
IF nBase > 36 .OR. nBase < 2
RETURN ""
ENDIF
if xNum < 0
xNum += 4294967296
endif
cNum = B10TOBN( xNum, @nBase )
IF ISNUMBER( nLenght ) .AND. ISCHARACTER( cPad ) .AND. LEN( cNum ) < nLenght
cNum = REPLICATE( cPad, nLenght - LEN( cNum ) ) + cNum
IF ISNUMBER( nLenght )
IF LEN(cNum) > nLenght
cNum = REPLICATE( "*", nLenght )
ELSEIF ISCHARACTER( cPad ) .AND. LEN( cNum ) < nLenght
cNum = REPLICATE( cPad, nLenght - LEN( cNum ) ) + cNum
ENDIF
ENDIF
RETURN cNum
@@ -133,22 +139,27 @@ RETURN cNum
*/
FUNCTION CTON( xNum, nBase, lMode )
LOCAL i, nNum:=0
LOCAL i, nNum := 0, nPos
Default lMode TO .F.
Default nBase TO 10
xNum = ALLTRIM(xNum)
IF ISCHARACTER(xNum) .and. nBase >= 2 .and. nBase <= 36
IF nBase >= 2 .AND. nBase <= 36
xNum := UPPER( ALLTRIM( xNum) )
FOR i=1 TO LEN( xNum )
nNum += (nBase ** (i-1)) * ( AT( SUBSTR( xNum, -i, 1 ), WORLD ) - 1 )
nPos := AT( SUBSTR( xNum, i, 1 ), WORLD )
IF nPos == 0 .or. nPos > nBase
EXIT
ELSE
nNum := nNum * nBase + ( nPos - 1 )
ENDIF
NEXT
IF lMode
IF nNum > 32767
nNum = nNum - 65536
nNum := nNum - 65536
ENDIF
ENDIF
@@ -158,11 +169,15 @@ RETURN nNum
STATIC FUNCTION B10TOBN( nNum, nBase )
LOCAL nInt
IF nNum > 0
RETURN B10TOBN( INT( nNum / nBase), @nBase ) +;
nInt := INT( nNum / nBase)
RETURN IIF(nInt==0, "", B10TOBN( nInt, @nBase )) +;
SUBSTR( WORLD, ( nNum % nBase ) + 1, 1 )
ELSEIF nNum == 0
RETURN "0"
ENDIF
RETURN ""

71
harbour/contrib/libct/numcount.c Normal file
View File

@@ -0,0 +1,71 @@
/*
* $Id: numcount.c,v 1.1 2004/11/29 22:11:31 ptsarenko Exp $
*/
/*
* xHarbour Project source code:
* CT3 numeric functions
*
* NUMCOUNT()
* Copyright 2004 Pavel Tsarenko <tpe2.mail.ru>
* www - http://www.xharbour.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, or (at your option)
* any later version.
*
* 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 software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries 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 Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
static LONG s_lCounter = 0;
HB_FUNC( NUMCOUNT )
{
BOOL bMode = ISLOG( 2 ) && hb_parl( 2 );
if( ISNUM( 1 ) )
{
if( bMode )
s_lCounter = hb_parnl( 1 );
else
s_lCounter += hb_parnl( 1 );
}
hb_retnl( s_lCounter );
}

92
harbour/contrib/libct/numline.c Normal file
View File

@@ -0,0 +1,92 @@
/*
* $Id: numline.c,v 1.1 2004/11/29 22:11:31 ptsarenko Exp $
*/
/*
* xHarbour Project source code:
* CT3 numeric functions
*
* NUMLINE()
* Copyright 2004 Pavel Tsarenko <tpe2.mail.ru>
* www - http://www.xharbour.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, or (at your option)
* any later version.
*
* 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 software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries 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 Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
HB_FUNC( NUMLINE )
{
LONG lLines = 0;
if( ISCHAR( 1 ) )
{
char *pcString = hb_parc( 1 );
char *pBuffer;
LONG lStrLen = hb_parclen( 1 );
LONG lLength = ISNUM( 2 ) ? hb_parnl( 2 ) : 80;
while( lStrLen > 0 )
{
pBuffer = ( char * ) memchr( pcString, 13, lStrLen );
if( !pBuffer )
{
pBuffer = pcString + lStrLen;
}
if( ( pBuffer - pcString ) > lLength )
{
pBuffer = pcString + lLength;
}
else
{
pBuffer++;
if( *pBuffer == 10 )
pBuffer++;
}
lStrLen -= pBuffer - pcString;
pcString = pBuffer;
lLines++;
}
}
hb_retnl( lLines );
}

2
harbour/source/rtl/gtfunc.c
View File

@@ -113,7 +113,7 @@ HB_FUNC( HB_GTINFO )
hb_gtInfo( hb_parni( 1 ), &gtInfo );
if( gtInfo.pResult )
hb_itemRelease( hb_itemReturn( gtInfo.pResult ) );
hb_itemReturnRelease( gtInfo.pResult );
else
hb_ret();
}