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

2007-07-18 16:25 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/tests/gtchars.prg
  * harbour/tests/gtcolors.prg
  * harbour/tests/gtkeys.prg
  * harbour/contrib/tip/thtml.prg
  * harbour/contrib/tip/thtml.ch
  * harbour/contrib/libct/misc2.c
  * harbour/contrib/libct/color.c
  * harbour/contrib/libct/numcount.c
  * harbour/contrib/libct/numline.c
  * harbour/contrib/libct/misc3.c
  * harbour/source/rtl/hbhex.c
  * harbour/source/rtl/hbbit.c
    * set valid Id svn:keyword

  * harbour/include/hbcompat.ch
    * reverted hb_adler32() <=> hb_checksum() translations

  * harbour/contrib/libct/keyset.c
  + harbour/contrib/libct/like.c
  * harbour/contrib/libct/finan.c
  * harbour/contrib/libct/justify.c
    * synced with xHarbour modifications and fixes
    * indenting
This commit is contained in:
Przemyslaw Czerpak
2007-07-18 14:26:01 +00:00
parent 534fa59620
commit c5b98d9e87
6 changed files with 567 additions and 509 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
harbour/ChangeLog
View File

@@ -8,6 +8,31 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-07-18 16:25 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/tests/gtchars.prg
* harbour/tests/gtcolors.prg
* harbour/tests/gtkeys.prg
* harbour/contrib/tip/thtml.prg
* harbour/contrib/tip/thtml.ch
* harbour/contrib/libct/misc2.c
* harbour/contrib/libct/color.c
* harbour/contrib/libct/numcount.c
* harbour/contrib/libct/numline.c
* harbour/contrib/libct/misc3.c
* harbour/source/rtl/hbhex.c
* harbour/source/rtl/hbbit.c
* set valid Id svn:keyword
* harbour/include/hbcompat.ch
* reverted hb_adler32() <=> hb_checksum() translations
* harbour/contrib/libct/keyset.c
+ harbour/contrib/libct/like.c
* harbour/contrib/libct/finan.c
* harbour/contrib/libct/justify.c
* synced with xHarbour modifications and fixes
* indenting
2007-07-17 16:48 UTC+0100 Miguel Angel Marchuet <miguelangel/at/marchuet.net>
* contrib/tip/client.prg
* contrib/tip/ftpcln.prg

613
harbour/contrib/libct/finan.c
View File

@@ -119,70 +119,63 @@
HB_FUNC( FV )
{
if( ISNUM(1) && ISNUM(2) && ISNUM(3) )
{
double dPayment = hb_parnd(1);
double dRate = hb_parnd(2);
double dTime = hb_parnd(3);
double dResult;
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) )
{
double dPayment = hb_parnd( 1 );
double dRate = hb_parnd( 2 );
double dTime = hb_parnd( 3 );
double dResult;
if (dRate == 0.0)
{
/* NOTE: CT3 crashes with dRate == 0.0 */
dResult = dPayment*dTime;
}
else
{
hb_mathResetError();
dResult = dPayment*(pow (1.0+dRate, dTime)-1.0)/dRate;
if (hb_mathIsMathErr())
if( dRate == 0.0 )
{
/* the C-RTL provides a kind of matherr() mechanism */
HB_MATH_EXCEPTION hb_exc;
int iLastError = hb_mathGetLastError (&hb_exc);
if (iLastError != HB_MATH_ERR_NONE)
{
if (hb_exc.handled)
{
hb_retnd (dPayment*(hb_exc.retval-1.0)/dRate);
}
else
{
/* math exception is up to the Harbour function, so do this as CTIII compatible as possible:
replace the errorneous value of pow() with 0.0 */
hb_retnd (dPayment*(-1.0)/dRate);
}
return;
}
/* NOTE: CT3 crashes with dRate == 0.0 */
dResult = dPayment * dTime;
}
}
hb_retnd (dResult);
else
{
hb_mathResetError();
dResult = dPayment * ( pow( 1.0 + dRate, dTime ) - 1.0 ) / dRate;
if( hb_mathIsMathErr() )
{
/* the C-RTL provides a kind of matherr() mechanism */
HB_MATH_EXCEPTION hb_exc;
int iLastError = hb_mathGetLastError( &hb_exc );
}
else
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_FV,
NULL, "FV", 0, EF_CANSUBSTITUTE, 3,
hb_paramError (1), hb_paramError (2),
hb_paramError (3));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retnd (0.0);
}
}
return;
if( iLastError != HB_MATH_ERR_NONE )
{
if( hb_exc.handled )
{
hb_retnd( dPayment * ( hb_exc.retval - 1.0 ) / dRate );
}
else
{
/* math exception is up to the Harbour function, so do this as CTIII compatible as possible:
replace the errorneous value of pow() with 0.0 */
hb_retnd( dPayment * ( -1.0 ) / dRate );
}
return;
}
}
}
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_FV, NULL, "FV", 0,
EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS );
}
if( pSubst != NULL )
hb_itemReturnRelease( pSubst );
else
hb_retnd( 0.0 );
}
}
@@ -239,69 +232,63 @@ HB_FUNC( FV )
HB_FUNC( PV )
{
if( ISNUM(1) && ISNUM(2) && ISNUM(3) )
{
double dPayment = hb_parnd(1);
double dRate = hb_parnd(2);
double dTime = hb_parnd(3);
double dResult;
if (dRate == 0.0)
{
/* NOTE: CT3 crashes with dRate == 0.0 */
dResult = dPayment*dTime;
}
else
{
hb_mathResetError();
dResult = dPayment*(1.0-pow (1.0+dRate, -dTime))/dRate;
if (hb_mathIsMathErr())
{
/* the C-RTL provides a kind of matherr() mechanism */
HB_MATH_EXCEPTION hb_exc;
int iLastError = hb_mathGetLastError (&hb_exc);
if (iLastError != HB_MATH_ERR_NONE)
{
if (hb_exc.handled)
{
hb_retnd (dPayment*(1.0-hb_exc.retval)/dRate);
}
else
{
/* math exception is up to the Harbour function, so do this as CTIII compatible as possible:
replace the errorneous value of pow() with 0.0 */
hb_retnd (dPayment/dRate);
}
return;
}
}
}
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) )
{
double dPayment = hb_parnd( 1 );
double dRate = hb_parnd( 2 );
double dTime = hb_parnd( 3 );
double dResult;
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_PV,
NULL, "PV", 0, EF_CANSUBSTITUTE, 3,
hb_paramError (1), hb_paramError (2),
hb_paramError (3));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retnd (0.0);
}
}
return;
if( dRate == 0.0 )
{
/* NOTE: CT3 crashes with dRate == 0.0 */
dResult = dPayment * dTime;
}
else
{
hb_mathResetError();
dResult = dPayment * ( 1.0 - pow( 1.0 + dRate, -dTime ) ) / dRate;
if( hb_mathIsMathErr() )
{
/* the C-RTL provides a kind of matherr() mechanism */
HB_MATH_EXCEPTION hb_exc;
int iLastError = hb_mathGetLastError( &hb_exc );
if( iLastError != HB_MATH_ERR_NONE )
{
if( hb_exc.handled )
{
hb_retnd( dPayment * ( 1.0 - hb_exc.retval ) / dRate );
}
else
{
/* math exception is up to the Harbour function, so do this as CTIII compatible as possible:
replace the errorneous value of pow() with 0.0 */
hb_retnd( dPayment / dRate );
}
return;
}
}
}
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_PV, NULL, "PV", 0,
EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS );
}
if( pSubst != NULL )
hb_itemReturnRelease( pSubst );
else
hb_retnd( 0.0 );
}
}
@@ -356,70 +343,63 @@ HB_FUNC( PV )
HB_FUNC( PAYMENT )
{
if( ISNUM(1) && ISNUM(2) && ISNUM(3) )
{
double dCapital = hb_parnd(1);
double dRate = hb_parnd(2);
double dTime = hb_parnd(3);
double dResult;
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) )
{
double dCapital = hb_parnd( 1 );
double dRate = hb_parnd( 2 );
double dTime = hb_parnd( 3 );
double dResult;
if (dRate == 0.0)
{
/* NOTE: CT3 crashes with dRate == 0.0 */
dResult = dCapital/dTime;
}
else
{
hb_mathResetError();
dResult = dCapital*dRate/(1.0-pow (1.0+dRate, -dTime));
if (hb_mathIsMathErr())
if( dRate == 0.0 )
{
/* the C-RTL provides a kind of matherr() mechanism */
HB_MATH_EXCEPTION hb_exc;
int iLastError = hb_mathGetLastError (&hb_exc);
if (iLastError != HB_MATH_ERR_NONE)
{
if (hb_exc.handled)
{
hb_retnd (dCapital*dRate/(1.0-hb_exc.retval));
}
else
{
/* math exception is up to the Harbour function, so do this as CTIII compatible as possible:
replace the errorneous value of pow() with 0.0 */
hb_retnd (dCapital*dRate);
}
return;
}
/* NOTE: CT3 crashes with dRate == 0.0 */
dResult = dCapital / dTime;
}
}
else
{
hb_mathResetError();
dResult = dCapital * dRate / ( 1.0 - pow( 1.0 + dRate, -dTime ) );
if( hb_mathIsMathErr() )
{
/* the C-RTL provides a kind of matherr() mechanism */
HB_MATH_EXCEPTION hb_exc;
int iLastError = hb_mathGetLastError( &hb_exc );
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_PAYMENT,
NULL, "PAYMENT", 0, EF_CANSUBSTITUTE, 3,
hb_paramError (1), hb_paramError (2),
hb_paramError (3));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retnd (0.0);
}
}
if( iLastError != HB_MATH_ERR_NONE )
{
if( hb_exc.handled )
{
hb_retnd( dCapital * dRate / ( 1.0 - hb_exc.retval ) );
}
else
{
/* math exception is up to the Harbour function, so do this as CTIII compatible as possible:
replace the errorneous value of pow() with 0.0 */
hb_retnd( dCapital * dRate );
}
return;
}
}
}
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_PAYMENT, NULL, "PAYMENT", 0,
EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS );
}
if( pSubst != NULL )
hb_itemReturnRelease( pSubst );
else
hb_retnd( 0.0 );
}
}
@@ -479,80 +459,74 @@ HB_FUNC( PAYMENT )
HB_FUNC( PERIODS )
{
if( ISNUM(1) && ISNUM(2) && ISNUM(3) )
{
double dCapital = hb_parnd(1);
double dPayment = hb_parnd(2);
double dRate = hb_parnd(3);
double dResult;
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) )
{
double dCapital = hb_parnd( 1 );
double dPayment = hb_parnd( 2 );
double dRate = hb_parnd( 3 );
double dResult;
if (dPayment <= dCapital*dRate)
{
/* in this case infinite time is needed to cancel the loan */
hb_retnd (-1.0);
return;
}
if (dRate == 0.0)
{
/* NOTE: CT3 crashes with dRate == 0.0 */
dResult = dCapital/dPayment;
}
else
{
double dResult2;
hb_mathResetError();
/* Note that this first expression will never give an error since dCapital*dRate/dPayment < 1.0, see above */
dResult2 = -log(1.0-(dCapital*dRate/dPayment));
dResult = dResult2/log(1+dRate);
if (hb_mathIsMathErr())
if( dPayment <= dCapital * dRate )
{
/* the C-RTL provides a kind of matherr() mechanism */
HB_MATH_EXCEPTION hb_exc;
int iLastError = hb_mathGetLastError (&hb_exc);
if (iLastError != HB_MATH_ERR_NONE)
{
if (hb_exc.handled)
{
hb_retnd (dResult2/hb_exc.retval);
}
else
{
/* math exception is up to the Harbour function, so do this as CTIII compatible as possible:
replace the errorneous value of log() with -INF */
hb_retnd (-0.0);
}
return;
}
/* in this case infinite time is needed to cancel the loan */
hb_retnd( -1.0 );
return;
}
}
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_PERIODS,
NULL, "PERIODS", 0, EF_CANSUBSTITUTE, 3,
hb_paramError (1), hb_paramError (2),
hb_paramError (3));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retnd (0.0);
}
}
if( dRate == 0.0 )
{
/* NOTE: CT3 crashes with dRate == 0.0 */
dResult = dCapital / dPayment;
}
else
{
double dResult2;
return;
hb_mathResetError();
/* Note that this first expression will never give an error since dCapital*dRate/dPayment < 1.0, see above */
dResult2 = -log( 1.0 - ( dCapital * dRate / dPayment ) );
dResult = dResult2 / log( 1 + dRate );
if( hb_mathIsMathErr() )
{
/* the C-RTL provides a kind of matherr() mechanism */
HB_MATH_EXCEPTION hb_exc;
int iLastError = hb_mathGetLastError( &hb_exc );
if( iLastError != HB_MATH_ERR_NONE )
{
if( hb_exc.handled )
{
hb_retnd( dResult2 / hb_exc.retval );
}
else
{
/* math exception is up to the Harbour function, so do this as CTIII compatible as possible:
replace the errorneous value of log() with -INF */
hb_retnd( -0.0 );
}
return;
}
}
}
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_PERIODS, NULL, "PERIODS", 0,
EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS );
}
if( pSubst != NULL )
hb_itemReturnRelease( pSubst );
else
hb_retnd( 0.0 );
}
}
@@ -605,86 +579,77 @@ HB_FUNC( PERIODS )
HB_FUNC( RATE )
{
if( ISNUM(1) && ISNUM(2) && ISNUM(3) )
{
double dCapital = hb_parnd(1);
double dPayment = hb_parnd(2);
double dTime = hb_parnd(3);
double dAux; /* estimated payment to compare for */
double dEpsilon = 0.00001; /* mimimal to consider 2 numbers as equal*/
double dScale = 1.0; /* fractional step */
double r; /* temptative rate */
double j = 1.0; /* index */
double dExp;
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) )
{
double dCapital = hb_parnd( 1 );
double dPayment = hb_parnd( 2 );
double dTime = hb_parnd( 3 );
double dAux; /* estimated payment to compare for */
double dEpsilon = 0.00001; /* mimimal to consider 2 numbers as equal */
double dScale = 1.0; /* fractional step */
double r; /* temptative rate */
double j = 1.0; /* index */
double dExp;
while( j < 1020.0 ) /* maximum anual rate */
{
r = j * 0.000833333; /* j * ( 0.01 / 12.0) mensual's rate */
while( j < 1020.0 ) /* maximum anual rate */
{
r = j * 0.000833333; /* j * ( 0.01 / 12.0) mensual's rate */
/* replace PAYMENT() function overhead */
hb_mathResetError();
dExp = pow( (1.0 + r), dTime );
if (hb_mathIsMathErr())
{
/* the C-RTL provides a kind of matherr() mechanism */
HB_MATH_EXCEPTION hb_exc;
int iLastError = hb_mathGetLastError (&hb_exc);
if (iLastError != HB_MATH_ERR_NONE)
{
if (hb_exc.handled)
{
dExp = hb_exc.retval;
}
else
{
/* TODO: Check if this is a correct default correction value for pow() */
dExp = 0.0;
}
}
}
dAux = dCapital * ( (dExp * r) / (dExp - 1.0) );
/* replace PAYMENT() function overhead */
hb_mathResetError();
dExp = pow( ( 1.0 + r ), dTime );
if( hb_mathIsMathErr() )
{
/* the C-RTL provides a kind of matherr() mechanism */
HB_MATH_EXCEPTION hb_exc;
int iLastError = hb_mathGetLastError( &hb_exc );
if( dAux > dPayment )
{
j = j - dScale;
dScale = dScale * 0.10;
if( iLastError != HB_MATH_ERR_NONE )
{
if( hb_exc.handled )
{
dExp = hb_exc.retval;
}
else
{
/* TODO: Check if this is a correct default correction value for pow() */
dExp = 0.0;
}
}
}
if( (dAux - dPayment) < dEpsilon)
dAux = dCapital * ( ( dExp * r ) / ( dExp - 1.0 ) );
if( dAux > dPayment )
{
j = j - dScale;
dScale = dScale * 0.10;
if( ( dAux - dPayment ) < dEpsilon )
break;
}
else
j = j + dScale;
}
else
j = j + dScale;
} /* endwhile */
} /* endwhile */
hb_retnd( j * 0.000833333 ); /* return as mensual's rate */
}
else
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_RATE,
NULL, "RATE", 0, EF_CANSUBSTITUTE, 3,
hb_paramError (1), hb_paramError (2),
hb_paramError (3));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retnd (0.0);
}
}
hb_retnd( j * 0.000833333 ); /* return as mensual's rate */
}
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_RATE, NULL, "RATE", 0,
EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS );
}
if( pSubst != NULL )
hb_itemReturnRelease( pSubst );
else
hb_retnd( 0.0 );
}
}

199
harbour/contrib/libct/justify.c
View File

@@ -61,112 +61,105 @@
#define DO_JUSTIFY_JUSTRIGHT 1
/* helper function for the justxxx() functions */
static void do_justify (int iSwitch)
static void do_justify( int iSwitch )
{
int iNoRet;
int iNoRet;
iNoRet = ct_getref();
iNoRet = ct_getref() && ISBYREF( 1 );
if (ISCHAR (1))
{
if( ISCHAR( 1 ) )
{
char *pcString = hb_parc (1);
size_t sStrLen = hb_parclen (1);
char cJustChar;
char *pc, *pcRet;
size_t sJustOffset;
char *pcString = hb_parc( 1 );
size_t sStrLen = hb_parclen( 1 );
char cJustChar;
char *pc, *pcRet;
size_t sJustOffset;
if (hb_parclen (2) > 0)
cJustChar = *(hb_parc (2));
else if (ISNUM (2))
cJustChar = hb_parnl (2) % 256;
else
cJustChar = 0x20;
pcRet = ( char *)hb_xgrab (sStrLen);
switch (iSwitch)
{
case DO_JUSTIFY_JUSTLEFT:
if( sStrLen == 0 )
{
pc = pcString;
sJustOffset = 0;
while ((*pc == cJustChar) && (pc < pcString+sStrLen))
{
sJustOffset++;
pc++;
}
if( iNoRet )
hb_ret();
else
hb_retc( NULL );
return;
}
hb_xmemcpy (pcRet, pcString+sJustOffset, sStrLen-sJustOffset);
for (pc = pcRet+sStrLen-sJustOffset; pc < pcRet+sStrLen; pc++)
{
*pc = cJustChar;
}
}; break;
case DO_JUSTIFY_JUSTRIGHT:
{
pc = pcString+sStrLen-1;
sJustOffset = 0;
while ((*pc == cJustChar) && (pc >= pcString))
{
sJustOffset++;
pc--;
}
for (pc = pcRet; pc < pcRet+sJustOffset; pc++)
{
*pc = cJustChar;
}
hb_xmemcpy (pcRet+sJustOffset, pcString, sStrLen-sJustOffset);
}; break;
}
if (ISBYREF (1))
hb_storclen (pcRet, sStrLen, 1);
if (iNoRet)
hb_ret();
else
hb_retclen (pcRet, sStrLen);
hb_xfree (pcRet);
}
else /* ISCHAR (1) */
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG,
(iSwitch == DO_JUSTIFY_JUSTLEFT ? CT_ERROR_JUSTLEFT : CT_ERROR_JUSTRIGHT),
NULL,
(iSwitch == DO_JUSTIFY_JUSTLEFT ? "JUSTLEFT" : "JUSTRIGHT"),
0, EF_CANSUBSTITUTE, 2,
hb_paramError (1), hb_paramError (2));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
if (iNoRet)
hb_ret();
if( hb_parclen( 2 ) > 0 )
cJustChar = *( hb_parc( 2 ) );
else if( ISNUM( 2 ) )
cJustChar = ( char ) ( hb_parnl( 2 ) % 256 );
else
hb_retc ("");
}
}
cJustChar = 0x20;
return;
pcRet = ( char * ) hb_xgrab( sStrLen + 1 );
switch ( iSwitch )
{
case DO_JUSTIFY_JUSTLEFT:
pc = pcString;
sJustOffset = 0;
while( ( *pc == cJustChar ) && ( pc < pcString + sStrLen ) )
{
sJustOffset++;
pc++;
}
hb_xmemcpy( pcRet, pcString + sJustOffset, sStrLen - sJustOffset );
for( pc = pcRet + sStrLen - sJustOffset; pc < pcRet + sStrLen; pc++ )
{
*pc = cJustChar;
}
break;
case DO_JUSTIFY_JUSTRIGHT:
pc = pcString + sStrLen - 1;
sJustOffset = 0;
while( ( *pc == cJustChar ) && ( pc >= pcString ) )
{
sJustOffset++;
pc--;
}
for( pc = pcRet; pc < pcRet + sJustOffset; pc++ )
{
*pc = cJustChar;
}
hb_xmemcpy( pcRet + sJustOffset, pcString, sStrLen - sJustOffset );
break;
}
if( ISBYREF( 1 ) )
hb_storclen( pcRet, sStrLen, 1 );
if( iNoRet )
{
hb_ret();
hb_xfree( pcRet );
}
else
hb_retclen_buffer( pcRet, sStrLen );
}
else /* ISCHAR( 1 ) */
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if( iArgErrorMode != CT_ARGERR_IGNORE )
{
pSubst = ct_error_subst( ( USHORT ) iArgErrorMode, EG_ARG,
iSwitch == DO_JUSTIFY_JUSTLEFT ?
CT_ERROR_JUSTLEFT : CT_ERROR_JUSTRIGHT,
NULL, &hb_errFuncName, 0,
EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS );
}
if( pSubst != NULL )
hb_itemReturnRelease( pSubst );
else if( iNoRet )
hb_ret();
else
hb_retc( NULL );
}
}
@@ -198,12 +191,9 @@ static void do_justify (int iSwitch)
* $END$
*/
HB_FUNC (JUSTLEFT)
HB_FUNC( JUSTLEFT )
{
do_justify (DO_JUSTIFY_JUSTLEFT);
return;
do_justify( DO_JUSTIFY_JUSTLEFT );
}
@@ -235,12 +225,7 @@ HB_FUNC (JUSTLEFT)
* $END$
*/
HB_FUNC (JUSTRIGHT)
HB_FUNC( JUSTRIGHT )
{
do_justify (DO_JUSTIFY_JUSTRIGHT);
return;
do_justify( DO_JUSTIFY_JUSTRIGHT );
}

173
harbour/contrib/libct/keyset.c
View File

@@ -55,22 +55,98 @@
#include "ct.h"
#if defined (HB_OS_DOS)
#if defined( HB_OS_DOS )
#if defined(__DJGPP__)
#include "pc.h"
#include "sys\exceptn.h"
#include "sys\farptr.h"
#elif defined(__MSC_VER)
#include "signal.h"
#elif defined(__BORLANDC__)
#ifndef FAR
#define FAR far /* Because FAR is not defined for Borland C 3.x */
#endif
# if defined(__DJGPP__)
# include "pc.h"
# include "sys\exceptn.h"
# include "sys\farptr.h"
# elif defined(__MSC_VER)
# include "signal.h"
# elif defined(__BORLANDC__)
# ifndef FAR
# define FAR far /* Because FAR is not defined for Borland C 3.x */
# endif
# endif
static void SetGet( char cKey )
{
#if defined(__WATCOMC__) && defined(__386__)
hb_retl( *( ( char * ) 0x0417 ) & cKey );
#elif defined(__DJGPP__)
hb_retl( _farpeekb( 0x0040, 0x0017 ) & cKey );
#else
hb_retl( *( ( char FAR * ) MK_FP( 0x0040, 0x0017 ) ) & cKey );
#endif
static void SetGet( char cKey );
if( hb_pcount() >= 1 )
{
cKey = hb_parl( 1 ) * cKey;
#if defined(__WATCOMC__) && defined(__386__)
*( ( char * ) 0x0417 ) = ( *( ( char * ) 0x0417 ) & ( !cKey ) ) | cKey;
#elif defined(__DJGPP__)
_farpokeb( 0x0040, 0x0017, ( _farpeekb( 0x0040, 0x0017 ) & ( !cKey ) ) | cKey );
#else
*( ( char FAR * ) MK_FP( 0x0040, 0x0017 ) ) =
( *( ( char FAR * ) MK_FP( 0x0040, 0x0017 ) ) & ( !cKey ) ) | cKey;
#endif
}
}
#elif defined( HB_OS_WIN_32 )
/*
The following function ONLY works with GTWVT/GTWVW/GTALLEG.
They will NOT WORK on pure CONSOLE mode
*/
# include "hbapi.h"
# include <windows.h>
# define HB_VK_INSERT 0x2D
# define HB_VK_CAPITAL 0x14
# define HB_VK_NUMLOCK 0x90
# define HB_VK_SCROLL 0x91
static void SetGet( char cKey )
{
BYTE kbBuffer[256];
BOOL bRetval;
USHORT uKey = 0;
switch( cKey )
{
case 0x10:
uKey = HB_VK_SCROLL;
break;
case 0x20:
uKey = HB_VK_NUMLOCK;
break;
case 0x40:
uKey = HB_VK_CAPITAL
break;
case 0x80:
uKey = HB_VK_INSERT
break;
}
GetKeyboardState( kbBuffer );
hb_retl( ( kbBuffer[uKey] & 0x01 ) != 0 );
if( hb_pcount() >= 1 )
{
kbBuffer[uKey] = hb_parl( 1 ) ? 1 : 0;
SetKeyboardState( kbBuffer );
}
}
#endif
#if defined( HB_OS_DOS ) || defined( HB_OS_WIN_32 )
/* $DOC$
* $FUNCNAME$
@@ -97,13 +173,9 @@ static void SetGet( char cKey );
* $END$
*/
HB_FUNC (KSETINS)
HB_FUNC( KSETINS )
{
char cKey = 0x80;
SetGet( cKey );
SetGet( 0x80 );
}
@@ -132,13 +204,9 @@ char cKey = 0x80;
* $END$
*/
HB_FUNC (KSETCAPS)
HB_FUNC( KSETCAPS )
{
char cKey = 0x40;
SetGet( cKey );
SetGet( 0x40 );
}
@@ -167,13 +235,9 @@ char cKey = 0x40;
* $END$
*/
HB_FUNC (KSETNUM)
HB_FUNC( KSETNUM )
{
char cKey = 0x20;
SetGet( cKey );
SetGet( 0x20 );
}
@@ -202,52 +266,9 @@ char cKey = 0x20;
* $END$
*/
HB_FUNC (KSETSCROLL)
HB_FUNC( KSETSCROLL )
{
char cKey = 0x10;
SetGet( cKey );
SetGet( 0x10 );
}
static void SetGet( char cKey )
{
#if defined(__WATCOMC__) && defined(__386__)
hb_retl( *( ( char * ) 0x0417 ) & cKey );
#elif defined(__DJGPP__)
hb_retl( _farpeekb( 0x0040, 0x0017 ) & cKey );
#else
hb_retl( *( ( char FAR * ) MK_FP( 0x0040, 0x0017 ) ) & cKey );
#endif
if ( hb_pcount() >= 1 )
{
cKey = hb_parl( 1 ) * cKey;
#if defined(__WATCOMC__) && defined(__386__)
*( ( char * ) 0x0417 ) = ( *( ( char * ) 0x0417 ) & ( !cKey ) ) | cKey;
#elif defined(__DJGPP__)
_farpokeb( 0x0040, 0x0017, ( _farpeekb( 0x0040, 0x0017 ) & ( !cKey ) ) | cKey );
#else
*( ( char FAR * ) MK_FP( 0x0040, 0x0017 ) ) = ( *( ( char FAR * ) MK_FP( 0x0040, 0x0017 ) ) & ( !cKey ) ) | cKey;
#endif
}
}
#endif /* #if defined (HB_OS_DOS) */
#endif /* defined( HB_OS_DOS ) || defined( HB_OS_WIN_32 ) */

62
harbour/contrib/libct/like.c Normal file
View File

@@ -0,0 +1,62 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 string functions:
* LIKE()
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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"
HB_FUNC( LIKE )
{
char * szPattern = hb_parc( 1 );
* szString = hb_parc( 2 );
hb_retl( szPattern && szString &&
hb_strMatchWildExact( szString, szPattern ) );
}

4
harbour/include/hbcompat.ch
View File

@@ -74,7 +74,7 @@
#xtranslate hb_libFree([<x,...>]) => libFree(<x>)
#xtranslate hb_CStr([<x,...>]) => CStr(<x>)
#xtranslate hb_checksum([<x,...>]) => hb_adler32(<x>)
#xtranslate hb_adler32([<x,...>]) => hb_checksum(<x>)
#else
@@ -97,7 +97,7 @@
#xtranslate libFree([<x,...>]) => hb_libFree(<x>)
#xtranslate CStr([<x,...>]) => hb_CStr(<x>)
#xtranslate hb_adler32([<x,...>]) => hb_checksum(<x>)
#xtranslate hb_checksum([<x,...>]) => hb_adler32(<x>)
#xtranslate HASH([<x,...>]) => HB_HASH(<x>)
#xtranslate HHASKEY([<x,...>]) => HB_HHASKEY(<x>)