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

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

Browse Source 
* harbour/contrib/libnf/at2.prg
  * harbour/contrib/libnf/min2dhm.prg
  * harbour/contrib/libnf/ontick.c
  * harbour/contrib/libnf/sqzn.prg
  * harbour/contrib/libnf/bytexor.prg
  * harbour/contrib/libnf/asum.prg
  * harbour/contrib/libnf/sleep.prg
  * harbour/contrib/libnf/any2any.prg
  * harbour/contrib/libnf/origin.c
  * harbour/contrib/libnf/mouse.c
  * harbour/contrib/libnf/stod.c
  * harbour/contrib/libnf/vertmenu.prg
  * harbour/contrib/libnf/aredit.prg
  * harbour/contrib/libnf/n2color.c
  * harbour/contrib/libnf/xbox.prg
  * harbour/contrib/libnf/hex2dec.prg
  * harbour/contrib/libnf/getver.c
  * harbour/contrib/libnf/Makefile
  * harbour/contrib/libnf/invclr.prg
  * harbour/contrib/libnf/popadder.prg
  * harbour/contrib/libnf/d2e.prg
  * harbour/contrib/libnf/anomatch.prg
  * harbour/contrib/libnf/color2n.c
  * harbour/contrib/libnf/datecnfg.prg
  * harbour/contrib/libnf/easter.prg
  * harbour/contrib/libnf/ntow.prg
  * harbour/contrib/libnf/floptst.prg
  * harbour/contrib/libnf/pchr.prg
  * harbour/contrib/libnf/tbwhile.prg
  * harbour/contrib/libnf/e2d.prg
  * harbour/contrib/libnf/sysmem.prg
  * harbour/contrib/libnf/dfile.prg
  * harbour/contrib/libnf/clrsel.prg
  + harbour/contrib/libnf/fttext.c
  + harbour/contrib/libnf/putkey.c
    * basic cleanup and syncing with some of xHarbour fixes and extensions.
      I'd like to ask Windows users to update non GNU make file

  * harbour/source/pp/ppcore.c
    + added support for .T., .F., .Y., .N. in PP and #IF ... / #ELIF ...
      expressions. It was reported by Nick Van Dyck on xHarbour devel list
      that old PP supported it. I haven't known that old PP suported .T.
      and .F. in #IF directive. Please not that there are other diferences
      between new PP and the old one in expresions which can be used in
      #IF ... / #ELIF directives. New PP supports C like expressions with
      support for pseudo functions like defined(), operates on integer
      numbers only to not damage 64bit values during conversion to double
      and keep C compatible results (the old one used double values) and
      is much more restrictive in checking for valid expression.
This commit is contained in:
Przemyslaw Czerpak
2007-08-08 13:21:15 +00:00
parent e3236dec41
commit 8db4f58efb
37 changed files with 1662 additions and 303 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
harbour/ChangeLog
View File

@@ -8,6 +8,57 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-08-08 15:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/contrib/libnf/at2.prg
* harbour/contrib/libnf/min2dhm.prg
* harbour/contrib/libnf/ontick.c
* harbour/contrib/libnf/sqzn.prg
* harbour/contrib/libnf/bytexor.prg
* harbour/contrib/libnf/asum.prg
* harbour/contrib/libnf/sleep.prg
* harbour/contrib/libnf/any2any.prg
* harbour/contrib/libnf/origin.c
* harbour/contrib/libnf/mouse.c
* harbour/contrib/libnf/stod.c
* harbour/contrib/libnf/vertmenu.prg
* harbour/contrib/libnf/aredit.prg
* harbour/contrib/libnf/n2color.c
* harbour/contrib/libnf/xbox.prg
* harbour/contrib/libnf/hex2dec.prg
* harbour/contrib/libnf/getver.c
* harbour/contrib/libnf/Makefile
* harbour/contrib/libnf/invclr.prg
* harbour/contrib/libnf/popadder.prg
* harbour/contrib/libnf/d2e.prg
* harbour/contrib/libnf/anomatch.prg
* harbour/contrib/libnf/color2n.c
* harbour/contrib/libnf/datecnfg.prg
* harbour/contrib/libnf/easter.prg
* harbour/contrib/libnf/ntow.prg
* harbour/contrib/libnf/floptst.prg
* harbour/contrib/libnf/pchr.prg
* harbour/contrib/libnf/tbwhile.prg
* harbour/contrib/libnf/e2d.prg
* harbour/contrib/libnf/sysmem.prg
* harbour/contrib/libnf/dfile.prg
* harbour/contrib/libnf/clrsel.prg
+ harbour/contrib/libnf/fttext.c
+ harbour/contrib/libnf/putkey.c
* basic cleanup and syncing with some of xHarbour fixes and extensions.
I'd like to ask Windows users to update non GNU make file
* harbour/source/pp/ppcore.c
+ added support for .T., .F., .Y., .N. in PP and #IF ... / #ELIF ...
expressions. It was reported by Nick Van Dyck on xHarbour devel list
that old PP supported it. I haven't known that old PP suported .T.
and .F. in #IF directive. Please not that there are other diferences
between new PP and the old one in expresions which can be used in
#IF ... / #ELIF directives. New PP supports C like expressions with
support for pseudo functions like defined(), operates on integer
numbers only to not damage 64bit values during conversion to double
and keep C compatible results (the old one used double values) and
is much more restrictive in checking for valid expression.
2007-08-07 03:12 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbclass.ch
! fixed typo: AddClsMthds() => AddClsMethod()

3
harbour/contrib/libnf/Makefile
View File

@@ -13,6 +13,8 @@ C_SOURCES = \
descend.c \
dispc.c \
ftattr.c \
fttext.c \
ftshadow.c \
getenvrn.c \
getver.c \
getvid.c \
@@ -25,6 +27,7 @@ C_SOURCES = \
origin.c \
proper.c \
prtscr.c \
putkey.c \
rmdir.c \
shift.c \
stod.c \

3
harbour/contrib/libnf/anomatch.prg
View File

@@ -87,4 +87,5 @@ FUNCTION FT_ANOMATCHES(aArray, bCompareBlock, nStartIndex, nEndIndex)
IIF(EVAL(bCompareBlock, xElement), nNoOfMatches++, NIL) }, ;
nStartIndex, nEndIndex - nStartIndex + 1)
RETURN (nNoOfMatches) // FT_ANoMatches
RETURN (nNoOfMatches) // FT_ANoMatches

3
harbour/contrib/libnf/any2any.prg
View File

@@ -165,4 +165,5 @@ FUNCTION FT_XTOY(xValueToConvert, cTypeToConvertTo, lWantYesNo)
ENDCASE
RETURN (xValueToConvert) // XToY
RETURN (xValueToConvert) // XToY

2
harbour/contrib/libnf/aredit.prg
View File

@@ -300,4 +300,4 @@ FUNCTION FT_ArEdit( nTop, nLeft, nBot, nRight, ;
* if no bGetFunc then ESC returns 0, otherwise return value of last element
RETURN IF( VALTYPE(bGetFunc) == NIL .AND. nKey == K_ESC, ;
0, ar[b:colPos, nElem] )
* EOFcn FT_ArEdit()
* EOFcn FT_ArEdit()

3
harbour/contrib/libnf/asum.prg
View File

@@ -83,4 +83,5 @@ FUNCTION FT_ASUM(aArray, nStartIndex, nEndIndex)
IF(IS_CHAR(xElement),LEN(xElement),0) }) }, ;
nStartIndex, nEndIndex - nStartIndex + 1)
RETURN (nSumTotal) // FT_ASum
RETURN (nSumTotal) // FT_ASum

68
harbour/contrib/libnf/at2.prg
View File

@@ -59,7 +59,7 @@
*
* FT_AT2( cSearch, cTarget, 2, .F. ) // Returns ( 9 )
* $SEEALSO$
* FT_FINDITH()
* FT_FINDITH(), FT_RAT2()
* $END$
*/
@@ -134,3 +134,69 @@ FUNCTION FT_AT2( cSearch, cTarget, nOccurs, lCaseSens )
RETURN ( nPos2 )
/* $DOC$
* $FUNCNAME$
* FT_RAT2()
* $CATEGORY$
* String
* $ONELINER$
* Find position of the reversed nth occurrence of a substring
* $SYNTAX$
* FT_RAT2( <cSearch>, <cTarget> [, <nOccurs> [, <lCaseSens> ] ] ) -> nPos
* $ARGUMENTS$
* <cSearch> is the character substring to search for.
*
* <cTarget> is the character string to search.
*
* <nOccurs> is the occurrence of cSearch to look for,
* defaults to 1.
*
* <lCaseSens> is a logical value denoting case sensitivity.
* If .F., then search is NOT sensitive to case,
* defaults to .T.
* $RETURNS$
* The position of the nth occurrence of a reversed substring
* $DESCRIPTION$
* This function will find the nth occurrence of a reversed
* substring within a string.
* $EXAMPLES$
* cSearch := "t"
* cTarget := "This is the day that the Lord has made."
*
* FT_RAT2( cSearch, cTarget ) // Returns ( 22 )
*
* FT_RAT2( cSearch, cTarget, 2 ) // Returns ( 20 )
*
* FT_RAT2( cSearch, cTarget, 2, .F. ) // Returns ( 22 )
* $SEEALSO$
* FT_FINDITH(), FT_AT2()
* $END$
*/
FUNCTION FT_RAT2( cSearch, cTarget, nOccurs, lCaseSens )
LOCAL nCount, nPos, nPos2 := 0
LOCAL cSubstr := cTarget
// Set default parameters as necessary.
IF lCaseSens == NIL
lCaseSens := .T.
ENDIF
IF nOccurs == NIL
nOccurs := 1
ENDIF
FOR nCount := 1 TO nOccurs
// Store position of next occurrence of cSearch.
IF lCaseSens
nPos := RAT( cSearch, cSubstr )
ELSE
nPos := RAT( UPPER( cSearch ), UPPER( cSubstr ) )
ENDIF
// Store position of cSearch relative to original string.
nPos2 := nPos
// Resize cSubstr
cSubstr := SUBSTR( cSubstr, 1, RAT( cSearch, cSubstr ) - 1 )
// Breakout if there are no occurences here
IF nPos == 0
EXIT
ENDIF
NEXT
RETURN ( nPos2 )

3
harbour/contrib/libnf/bytexor.prg
View File

@@ -79,4 +79,5 @@ FUNCTION FT_BYTEXOR(cByte1, cByte2)
NEXT
ENDIF
RETURN cNewByte
RETURN cNewByte

3
harbour/contrib/libnf/clrsel.prg
View File

@@ -783,4 +783,5 @@ DO WHILE lIdentical .AND. n <= LEN(aArr1)
n++
ENDDO
RETURN lIdentical
RETURN lIdentical

132
harbour/contrib/libnf/color2n.c
View File

@@ -52,134 +52,14 @@
*/
#include "hbapi.h"
#include "hbapigt.h"
static int _ftColor2I( char * cColor );
static int _ftGetColorNum( char * cColor );
static char * _ftStripIt( char * cColor );
HB_FUNC(FT_COLOR2N)
HB_FUNC( FT_COLOR2N )
{
/* #if defined(HB_OS_DOS) || defined(HB_OS_WIN_32)
{ */
int iRet = 0;
int iRet = 0;
if( ISCHAR( 1 ) )
iRet = hb_gtColorToN( hb_parc( 1 ) );
// make sure parameter is a char type and that it is 8 chars or less
if ( ISCHAR( 1 ) && hb_parclen( 1 ) < 8 )
iRet = _ftColor2I( hb_parc( 1 ) );
hb_retni( iRet );
return;
/* }
#endif */
}
// ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
// Function : _ftColor2I
// Purpose : Converts an Xbase color string to an int
// Parameters: cColor - a pointer to the color string
// Returns : int complement of color string, or 0 if string is invalid
// ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
static int _ftColor2I( char * cColor )
{
char * cFore = " ", * cBack = " ";
unsigned int iBlink = 0, iIntense = 0, iBack = 0, i = 0;
// copy the Clipper string to buffer, check for attributes, and
// make lower case
while ( ( cFore[ i ] = cColor[ i ] ) != 0 )
{
// check for a blink attrib
if ( cFore[ i ] == '*' && iBlink == 0 ) iBlink = 128;
// check for an intensity attrib
if ( cFore[ i ] == '+' && iIntense == 0 ) iIntense = 8;
// make sure all chars are lower case
if ( 91 > cFore[ i ] && cFore[ i ] > 64 ) cFore[ i ] += 32;
i++;
}
// check for the background color
while ( cColor[ iBack++ ] != '/' && cColor[ iBack ] != 0 );
if ( cColor[--iBack ] == '/' )
{
cBack = cFore + iBack + 1;
cFore[ iBack ] = 0;
}
// calculate and return the value
return ( iIntense + iBlink + _ftGetColorNum( _ftStripIt( cFore ) ) +
( 16 * _ftGetColorNum( _ftStripIt( cBack ) ) ) );
}
// ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
// Function : _ftGetColorNum
// Purpose : Returns the corresponding number for an Xbase color
// Parameters: cColor - a pointer to the color string
// Returns : int complement of a single color
// ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
static int _ftGetColorNum( char * cColor )
{
unsigned * iColor = ( unsigned * ) cColor;
if ( cColor[ 1 ] == 0 ) switch ( cColor[ 0 ] )
{
case 'n' : *iColor = 0; break;
case 'b' : *iColor = 1; break;
case 'g' : *iColor = 2; break;
case 'r' : *iColor = 4; break;
case 'w' : *iColor = 7; break;
}
else
{
if ( ( cColor[ 0 ] == 'b' ) && cColor[ 1 ] == 'g' ) *iColor = 3;
if ( ( cColor[ 0 ] == 'r' ) && cColor[ 1 ] == 'b' ) *iColor = 5;
if ( ( cColor[ 0 ] == 'g' ) && cColor[ 1 ] == 'r' ) *iColor = 6;
}
return *iColor;
}
// ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
// Function : _ftStripIt
// Purpose : Removes the intensity/blink chars from the passed string
// Parameters: cColor - a pointer to the color string
// Returns : a pointer to the modified color string
// ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
static char * _ftStripIt( char * cColor )
{
unsigned i = 0;
// move past any leading markers
while ( *cColor == '+' || *cColor == '*' ) cColor++;
// truncate any trailing markers
while ( cColor[ i ] && cColor[ i ] != '+' && cColor[ i ] != '*' ) i++;
// null terminate the string
cColor[ i ] = 0;
return cColor;
hb_retni( iRet );
}

3
harbour/contrib/libnf/d2e.prg
View File

@@ -86,4 +86,5 @@ function ft_d2e( nDec, nPrecision )
endif another kludge for stuff like '999999999'
sScn := ltrim( str( nDec, nPrecision + 3, nPrecision ) )
return( sScn + 'E' + alltrim( str( nExp, 5, 0 ) ) )
return( sScn + 'E' + alltrim( str( nExp, 5, 0 ) ) )

3
harbour/contrib/libnf/datecnfg.prg
View File

@@ -327,4 +327,5 @@ FUNCTION FT_DATECNFG( cFYStart ,nDow )
aDatePar[2] := nDow
ENDIF
RETURN ACLONE( aDatePar )
RETURN ACLONE( aDatePar )

3
harbour/contrib/libnf/dfile.prg
View File

@@ -224,4 +224,5 @@ function FT_DFCLOSE()
nHandle := 0
endif
return (NIL)
return (NIL)

2
harbour/contrib/libnf/e2d.prg
View File

@@ -65,4 +65,4 @@ function ft_e2d( sNumE )
len( sNumE ) - at( 'E', sNumE ) ;
) ;
)
return( nMant * 10 ^ nExp )
return( nMant * 10 ^ nExp )

13
harbour/contrib/libnf/easter.prg
View File

@@ -1,7 +1,7 @@
/*
* File......: EASTER.PRG
* Author....: Paul Tucker
* CIS ID....: ?
* Email.....: <ptucker@sympatico.ca>
*
* While I can say that I wrote the program, the algorithm is from Donald
* Knuth's The Art of Computer Programming, Section 1.3.2. So, the source
@@ -52,11 +52,7 @@
FUNCTION FT_EASTER (nYear)
local nGold, nCent, nCorx, nCorz, nSunday, nEpact, nMoon,;
nMonth := 0, nDay := 0, lCent := __SetCentury( .t. )
// --------------------------------
// NOTE: __SetCentury() is internal
// --------------------------------
nMonth := 0, nDay := 0
IF VALTYPE (nYear) == "C"
nYear = VAL(nYear)
@@ -121,7 +117,4 @@ FUNCTION FT_EASTER (nYear)
nYear = 0
ENDIF
set century (lCent)
RETURN CTOD (RIGHT ("00"+LTRIM (STR (nMonth)),2) + "/" +;
RIGHT ("00"+LTRIM (STR (INT (nDay))) ,2) + "/" +STR (nYear,4))
RETURN StoD( Str( nYear,4) + PadL( nMonth, 2, "0" ) + PadL( Int( nDay ), 2, "0" ) )

3
harbour/contrib/libnf/floptst.prg
View File

@@ -287,6 +287,3 @@ STATIC FUNCTION _CallInt13hRetry( ; // logical: did the interrupt succeed?
nDriveStatus_o := highByte( aRegisters[AX] )
RETURN lSuccess
// EOF

1196
harbour/contrib/libnf/fttext.c Normal file
View File

File diff suppressed because it is too large Load Diff

10
harbour/contrib/libnf/getver.c
View File

@@ -66,7 +66,7 @@ HB_FUNC(_GET_DOSVER)
char * pszPlatform;
union REGS regs;
pszPlatform = ( char * ) hb_xgrab( 256 );
regs.h.ah = 0x30;
HB_DOS_INT86( 0x21, &regs, &regs );
@@ -123,7 +123,7 @@ HB_FUNC(_FT_NWKSTAT)
HB_FUNC(_FT_SETMODE)
{
#if defined(HB_OS_DOS)
{
{
union REGS regs;
regs.h.ah=0;
regs.h.al=hb_parni(1);
@@ -135,7 +135,7 @@ HB_FUNC(_FT_GETMODE)
{
int iMode;
#if defined(HB_OS_DOS)
{
{
union REGS regs;
regs.h.ah=0x0F;
HB_DOS_INT86(0x10,&regs,&regs);
@@ -164,7 +164,7 @@ HB_FUNC(_FT_TEMPFIL)
union REGS regs;
struct SREGS sregs;
segread(&sregs);
cPath=hb_parc(1);
cPath=hb_parcx(1);
regs.h.ah=0x5A;
regs.HB_XREGS.cx=iMode;
sregs.ds=FP_SEG(cPath);
@@ -178,7 +178,7 @@ HB_FUNC(_FT_TEMPFIL)
nax=0;
iflags=0;
cPath=hb_parc(1);
cPath=hb_parcx(1);
}
#endif
{

2
harbour/contrib/libnf/hex2dec.prg
View File

@@ -65,4 +65,4 @@ FUNCTION FT_HEX2DEC( cHexNum )
nHexPower *= 16
next
RETURN nDec
RETURN nDec

2
harbour/contrib/libnf/invclr.prg
View File

@@ -70,4 +70,4 @@ FUNCTION FT_INVCLR(cDsrdColor)
cBackground := ALLTRIM(SUBSTR(cDsrdColor, AT("/", cDsrdColor) + 1))
RETURN (STRTRAN(STRTRAN(cBackground, "+"), "*") + cModifiers + "/" + ;
STRTRAN(STRTRAN(cForeground, "+"), "*"))
STRTRAN(STRTRAN(cForeground, "+"), "*"))

2
harbour/contrib/libnf/min2dhm.prg
View File

@@ -55,4 +55,4 @@ function FT_MIN2DHM(nMINS)
aDHM_[2] = ltrim(str(int((nMINS%1440)/60)))
aDHM_[3] = ltrim(str(int((nMINS%1440)%60)))
return aDHM_
return aDHM_

27
harbour/contrib/libnf/mouse.c
View File

@@ -51,9 +51,6 @@
*
*/
/* NOTE: we need this to prevent base types redefinition */
#define _CLIPDEFS_H
#include "extend.h"
#if defined(HB_OS_DOS)
#include "dos.h"
@@ -500,6 +497,29 @@ HB_FUNC( _M_MBUTPRS)
}
}
HB_FUNC( _M_MBUTREL )
{
#if defined(HB_OS_DOS)
union REGS regs;
regs.HB_XREGS.ax=0x0A;
regs.HB_XREGS.bx=hb_parni(1);
HB_DOS_INT86(0x33,&regs,&regs);
hb_reta( 4 );
hb_storni( regs.HB_XREGS.bx, -1, 1 );
hb_storni( regs.HB_XREGS.cx, -1, 2 );
hb_storni( regs.HB_XREGS.dx, -1, 3 );
hb_storni( regs.HB_XREGS.ax, -1, 4 );
#else
hb_reta( 4 );
hb_storni( 0, -1, 1 );
hb_storni( 0, -1, 2 );
hb_storni( 0, -1, 3 );
hb_storni( 0, -1, 4 );
#endif
}
HB_FUNC( _M_MDEFCRS)
{
#if defined(HB_OS_DOS)
@@ -563,4 +583,3 @@ int inButton;
hb_itemRelease(pnButton);
}
}

120
harbour/contrib/libnf/n2color.c
View File

@@ -52,118 +52,18 @@
*/
#include "hbapi.h"
#include "hbapigt.h"
static void _ftI2Color( int iColor, char * cColor );
static int _ftGetColorStr( int iColor, char * cColor );
HB_FUNC(FT_N2COLOR )
HB_FUNC( FT_N2COLOR )
{
/* #if defined(HB_OS_DOS)
{ */
char * cColor = " ";
int iColor = ISNUM( 1 ) ? hb_parni( 1 ) : -1;
// make sure parameter is a numeric type
if ( ISNUM(1))
_ftI2Color( hb_parni( 1 ), cColor );
if( iColor >= 0x00 && iColor <= 0xff )
{
char szColorString[ 10 ];
hb_gtColorsToString( &iColor, 1, szColorString, 10 );
hb_retc( szColorString );
}
else
cColor = NULL;
hb_retc( cColor );
return;
/* }
#endif */
}
// ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
// Function : _ftI2Color
// Purpose : Converts a color int to an Xbase color string
// Parameters: iColor - the color number
// *cColor - pointer to the color string
// Returns : void (string is modified directly)
// ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
static void _ftI2Color( int iColor, char * cColor )
{
unsigned int iBack, iFore, i = 0;
// check for blink attribute
if ( iColor > 127 )
{
cColor[ i++ ] = '*';
iColor %= 128;
}
// check for background and foreground colors
// if ( iColor > 15 )
// {
iFore = iColor % 16;
iBack = ( iColor - iFore ) / 16;
// }
// check for intensity attrib
if ( iFore > 7 )
{
cColor[ i++ ] = '+';
iFore %= 8;
}
// get forground color
i += _ftGetColorStr( iFore, ( cColor + i ) );
// add the seperator
cColor[ i++ ] = '/';
// get background color
i += _ftGetColorStr( iBack, ( cColor + i ) );
// null terminate the color string
cColor[ i ] = 0;
return ;
}
// ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
// Function : _ftGetColorStr
// Purpose : Returns the corresponding Xbase color for passed number
// Parameters: iColor - a color number
// *cColor - pointer to the color string
// Returns : length of added color string
// ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
static int _ftGetColorStr( int iColor, char * cColor )
{
int iLen = 0;
switch ( iColor )
{
case 0 : cColor[iLen++] = 'n'; break;
case 1 : cColor[iLen++] = 'b'; break;
case 2 : cColor[iLen++] = 'g'; break;
case 3 : cColor[iLen++] = 'b';
cColor[iLen++] = 'g'; break;
case 4 : cColor[iLen++] = 'r'; break;
case 5 : cColor[iLen++] = 'r';
cColor[iLen++] = 'b'; break;
case 6 : cColor[iLen++] = 'g';
cColor[iLen++] = 'r'; break;
case 7 : cColor[iLen++] = 'w';
}
return iLen;
hb_retc( NULL );
}

2
harbour/contrib/libnf/ntow.prg
View File

@@ -131,4 +131,4 @@ static function sol10( nNumber )
local sTemp
sTemp := ltrim( str( int(nNumber), 0) )
return( len(sTemp) - 1 )
return( len(sTemp) - 1 )

2
harbour/contrib/libnf/ontick.c
View File

@@ -136,4 +136,4 @@ CLIPPER FT_OnTick( void )
_evLow( 5, TickTock, FALSE );
return;
}
}

11
harbour/contrib/libnf/origin.c
View File

@@ -64,14 +64,5 @@
HB_FUNC(FT_ORIGIN)
{
#if defined(HB_OS_DOS) || defined(HB_OS_WIN_32)
{
extern char **_argv;
hb_retc( *_argv );
return;
}
#endif
hb_retc( hb_cmdargARGV()[0] );
}

2
harbour/contrib/libnf/pchr.prg
View File

@@ -221,4 +221,4 @@ Function FT_PCHR(c_nums)
Enddo
Return c_ret
Return c_ret

4
harbour/contrib/libnf/popadder.prg
View File

@@ -1962,6 +1962,4 @@ RETURN LEN(cString)-LEN(LTRIM(cString))
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
*/
STATIC FUNCTION _ftPosIns(cString,cChar,nPosit)
RETURN LEFT(cString,nPosit-1)+cChar+SUBSTR(cString,nPosit)
RETURN LEFT(cString,nPosit-1)+cChar+SUBSTR(cString,nPosit)

260
harbour/contrib/libnf/putkey.c Normal file
View File

@@ -0,0 +1,260 @@
/*
* $Id$
*/
/* File......: PUTKEY.ASM
* Author....: Ted Means
* CIS ID....: 73067,3332
*
* This is an original work by Ted Means and is placed in the
* public domain.
*
* Modification history:
* ---------------------
*
* Rev 1.4 16 Oct 1992 00:00:56 GLENN
* Just making sure we have Ted's latest revisions.
*
* Rev 1.3 01 Jul 1992 01:07:02 GLENN
* PUTKEY.ASM now bypasses the BIOS completely and uses Clipper's
* internal event handler to stuff the keystroke. Modifications by
* Ted Means.
*
* Rev 1.2 15 Aug 1991 23:07:10 GLENN
* Forest Belt proofread/edited/cleaned up doc
*
* Rev 1.1 14 Jun 1991 19:54:56 GLENN
* Minor edit to file header
*
* Rev 1.0 01 Apr 1991 01:03:48 GLENN
* Nanforum Toolkit
*
* $DOC$
* $FUNCNAME$
* FT_PUTKEY()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Stuff a keystroke into the keyboard buffer
* $SYNTAX$
* FT_PUTKEY( <nKeyValue> ) -> lResult
* $ARGUMENTS$
* <nKeyValue> is the INKEY() value of the keystroke to be stuffed.
* $RETURNS$
* .T. if the keystroke was put into the keyboard buffer.
* .F. if nKeyValue was invalid or the buffer was full.
* $DESCRIPTION$
* This function is similar to the KEYBOARD command, with a few
* exceptions. First, this function does not clear the keyboard buffer
* before inserting the keystroke. In addition, since it uses the
* Inkey() value, you can stuff any key, including function keys, into
* the keyboard buffer. However, this also means that unlike the KEYBOARD
* command, you can only stuff one keystroke at a time.
*
* You can easily create a User-Defined Command that makes this function
* even more like the KEYBOARD command. For example,
*
* #command KEYSTROKE <key> => FT_PUTKEY( <key> )
*
* will create a command called KEYSTROKE that could be used as a
* companion command to KEYBOARD. The only difference is that it would
* insert a single keystroke instead of a string.
*
* Be aware that this function makes use of Clipper's internal event
* handler. If you don't like using internals, then don't use this
* function, you sniveling coward.
*
* This function is written to adhere to Turbo Assembler's IDEAL mode.
* To use another assembler, rearrange the SEGMENT and PROC directives
* and make any other necessary changes to the source code.
* $EXAMPLES$
* FT_PUTKEY( -9 ) // Stuff the F10 key
* FT_PUTKEY( 276 ) // Stuff the Alt T key
* KEYSTROKE 28 // Stuff the F1 key using a User-Defined Command
* $END$
*/
/*This is the Original FT_PUTKEY() code
IDEAL
Public FT_PutKey
Extrn __ParInfo:Far
Extrn __Parni:Far
Extrn __RetL:Far
Extrn __evLow:Far ; Internal!! Sniveling cowards
; beware!
Segment _NanFor Word Public "CODE"
Assume CS:_NanFor
Proc FT_PutKey Far
Xor AX,AX ; Prepare to count params
Push AX ; Save on stack
Call __ParInfo ; Get param count
Add SP,2 ; Realign stack
Or AX,AX ; Zero params?
JNZ Test1 ; If not, continue
Jmp Done ; Return value = false, go to end
Test1: Mov AX,1 ; Prepare to check parameter #1
Push AX ; Save parameter # on stack
Call __ParInfo ; Call parameter info routine
Add SP,2 ; Realign stack
Test AX,2 ; Is parameter numeric?
JNZ Get1 ; If so, continue
BadParam:Xor AX,AX ; Set return value to false
Jmp Done ; Go to end
Get1: Mov AX,1 ; Prepare to retrieve parameter #1
Push AX ; Save parameter # on stack
Call __ParNI ; Retrieve parameter
Add SP,2 ; Realign stack
Cmp AX,385 ; Test highest inkey()
JG BadParam ; Bad INKEY() value
Cmp AX,-39 ; Test lowest INKEY()
JL BadParam ; Bad INKEY() value
CtrlF1: Mov CL,0 ; Set ASCII value to null
Cmp AX,-10 ; Is Ctrl F1 thru Alt F10?
JG F2 ; If not, check next range
Neg AX ; Get absolute value of AX
Add AL,74 ; Translate INKEY() to scan code
Mov CH,AL ; Move scan code to CH
Jmp StuffIt ; Stuff the keystroke
F2: Or AX,AX ; See if key is F2 thru F10
JNS F1 ; If not, check next range
Neg AX ; Get absolute value of AX
Add AL,59 ; Translate INKEY() to scan code
Mov CH,AL ; Move scan code to CH
Jmp StuffIt ; Stuff the keystroke
F1: Cmp AX,28 ; See if key is F1
JNE CtrlF ; If not, check next key
Mov CH,59 ; Supply scan code for F1
Jmp StuffIt ; Stuff the keystroke
CtrlF: Cmp AX,6 ; See if key is Ctrl F or End
JNE CtrlW ; If not, check next key
Mov CH,79 ; Supply scan code for End
Jmp StuffIt ; Stuff the keystroke
CtrlW: Cmp AX,23 ; See if key is Ctrl W or Ctrl End
JNE CtrlHome ; If not, check next key
Mov CH,117 ; Supply scan code for Ctrl End
Jmp StuffIt ; Stuff the keystroke
CtrlHome:Cmp AX,29 ; See if key is Ctrl Home or Ctrl]
JNE CtrlV ; If not, check next key
Mov CH,119 ; Supply scan code for Ctrl Home
Jmp StuffIt ; Stuff the keystroke
CtrlV: Cmp AX,22 ; See if key is Ins or Ctrl V
JNE ShiftTab ; If not, check next key
Mov CH,82 ; Supply scan code for Ctrl V
Jmp StuffIt ; Stuff the keystroke
ShiftTab:Cmp AX,271 ; See if key is Shift Tab
JNE CtrlPgDn ; If not, check next key
Mov CH,15 ; Supply scan code for Shift Tab
Jmp StuffIt ; Stuff the keystroke
CtrlPgDn:Cmp AX,30 ; See if key is Ctrl PgDn
JNE CtrlPgUp ; If not, check next key
Mov CH,118 ; Supply scan code for Ctrl PgDn
Jmp StuffIt ; Stuff the keystroke
CtrlPgUp:Cmp AX,31 ; See if key is Ctrl PgUp
JNE AltQ ; If not, check next key
Mov CH,132 ; Supply scan code for Ctrl PgUp
Jmp StuffIt ; Stuff the keystroke
AltQ: Cmp AX,272 ; See if key is Alt Q . . .
JL ASCII
Cmp AX,281 ; . . . thru Alt P
JG AltA
Mov CH,AL
Jmp StuffIt
AltA: Cmp AX,286 ; See if key is Alt A . . .
JNL AltL
Jmp BadParam
AltL: Cmp AX,294 ; . . . thru Alt L
JG AltZ
Mov CH,AL
Jmp StuffIt
AltZ: Cmp AX,300 ; See if key is Alt Z . . .
JNL AltM
Jmp BadParam
AltM: Cmp AX,306 ; . . . thru Alt M
JG Alt1
Mov CH,AL
Mov CL,0
Jmp StuffIt
Alt1: Cmp AX,376 ; See if key is Alt 1 . . .
JNL AltNum
Jmp BadParam
AltNum: Mov CH,AL
Mov CL,0
Jmp StuffIt
ASCII: Or AH,AH ; See if key is plain ASCII
JZ Okay
Jmp BadParam
Okay: Mov CX,AX
StuffIt: Push BP ; Save BP
Mov BP,SP ; Set up stack reference
Sub SP,10 ; Allocate local structure
Mov [Word Ptr BP - 10],5 ; Choose keystroke event
Mov [Word Ptr BP - 8],0 ; Init flag word to 0
Mov [Word Ptr BP - 6],CX ; Store keystroke in structure
Mov [Word Ptr BP - 4],0 ; Init mouse row to 0
Mov [Word Ptr BP - 2],0 ; Init mouse col to 0
Push SS ; Put structure segment on stack
LEA AX,[BP - 10] ; Load structure offset
Push AX ; Put structure offset on stack
Mov AX,3 ; Post event subfunction code
Push AX ; Place onto stack
Call __evLow ; Call internal event handler
Dec AX ; Convert error code . . .
Neg AX ; . . . to a logical value
Mov SP,BP ; Restore stack alignment
Pop BP ; Restore BP
Done: Push AX ; Save return value on stack
Call __RetL ; Return it to Clipper app
Add SP,2 ; Realign stack
Ret
Endp FT_PutKey
Ends _NanFor
End
*/
/* This is the New one Rewriten in C*/
#include "hbapi.h"
#include "hbapigt.h"
HB_FUNC( FT_PUTKEY )
{
BOOL lSuccess = FALSE;
if( ISNUM( 1 ) )
{
int iKey = hb_parni(1);
if( iKey >= -39 && iKey <= 385 )
{
hb_inkeyPut( iKey );
lSuccess = TRUE;
}
}
hb_retl( lSuccess );
}

2
harbour/contrib/libnf/sleep.prg
View File

@@ -105,4 +105,4 @@ FUNCTION FT_SLEEP( nSeconds, nInitial )
DO WHILE ( SECONDS() < nSeconds )
ENDDO
RETURN NIL
RETURN NIL

2
harbour/contrib/libnf/sqzn.prg
View File

@@ -131,4 +131,4 @@ function ft_unsqzn(cCompressed,nSize,nDecimals)
tmp := strtran(tmp," ","0")
cValue := substr(tmp,1,nSize-nDecimals)+"."+substr(tmp,nSize-nDecimals+1)
return val(cValue) * multi
return val(cValue) * multi

9
harbour/contrib/libnf/stod.c
View File

@@ -53,12 +53,5 @@
HB_FUNC(FT_STOD)
{
#if defined(HB_OS_DOS) || defined(HB_OS_WIN_32)
{
hb_retds( hb_parc(1) ) ;
return;
}
#endif
hb_retds( hb_parclen( 1 ) >= 8 ? hb_parc( 1 ) : NULL );
}

2
harbour/contrib/libnf/sysmem.prg
View File

@@ -69,5 +69,5 @@ FUNCTION FT_SYSMEM()
aRegs[ AX ] := 0
FT_INT86( MEMSIZE, aRegs )
RETURN ( aRegs[ AX ] )
RETURN ( aRegs[ AX ] )

2
harbour/contrib/libnf/tbwhile.prg
View File

@@ -493,4 +493,4 @@ STATIC FUNCTION TbWhileBot(cKey)
SEEK LEFT(cKey, LEN(cKey) -1) + CHR( ASC( RIGHT(cKey,1) ) +1)
SET(_SET_SOFTSEEK, cSoftSave)
SKIP -1
RETURN NIL
RETURN NIL

2
harbour/contrib/libnf/vertmenu.prg
View File

@@ -176,5 +176,3 @@ Set( _SET_WRAP, lOldwrap )
Set( _SET_COLOR, cOldcolor )
RETURN NIL
* end of file: vertmenu.prg

2
harbour/contrib/libnf/xbox.prg
View File

@@ -220,4 +220,4 @@ FUNCTION FT_XBOX(cJustType,; // "L" = left, otherwise centered
STATIC FUNCTION _FTSAY(nSayRow,nSayCol,cSayStr)
@ nSayRow,nSayCol SAY cSayStr
RETURN NIL
RETURN NIL

6
harbour/source/pp/ppcore.c
View File

@@ -4422,6 +4422,12 @@ static PHB_PP_TOKEN hb_pp_calcValue( PHB_PP_TOKEN pToken, int iPrecedense,
pToken = pToken->pNext;
}
}
else if( HB_PP_TOKEN_TYPE( pToken->type ) == HB_PP_TOKEN_LOGICAL )
{
*plValue = HB_PP_ISTRUE( pToken->value[ 1 ] ) ? 1 : 0;
* pfError = FALSE;
pToken = pToken->pNext;
}
else
* pfError = TRUE;