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

2012-09-29 18:34 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/hbnf/aavg.prg
  * contrib/hbnf/adessort.prg
  * contrib/hbnf/aemaxlen.prg
  * contrib/hbnf/aeminlen.prg
  * contrib/hbnf/amedian.prg
  * contrib/hbnf/anomatch.prg
  * contrib/hbnf/asum.prg
  * contrib/hbnf/at2.prg
  * contrib/hbnf/blink.prg
  * contrib/hbnf/clrsel.prg
  * contrib/hbnf/datecnfg.prg
  * contrib/hbnf/dosver.prg
  * contrib/hbnf/findith.prg
  * contrib/hbnf/gcd.prg
  * contrib/hbnf/invclr.prg
  * contrib/hbnf/lastday.prg
  * contrib/hbnf/menutonf.prg
  * contrib/hbnf/metaph.prg
  * contrib/hbnf/miltime.prg
  * contrib/hbnf/mouse1.prg
  * contrib/hbnf/nooccur.prg
  * contrib/hbnf/nwlstat.prg
  * contrib/hbnf/pegs.prg
  * contrib/hbnf/pending.prg
  * contrib/hbnf/pickday.prg
  * contrib/hbnf/popadder.prg
  * contrib/hbnf/settime.prg
  * contrib/hbnf/sleep.prg
  * contrib/hbnf/tbwhile.prg
  * contrib/hbnf/week.prg
    * manual formatting (comments mostly)
    + added TOFIXes where savescreen() buffers are manipulated

  * contrib/hbnf/tests/ftgete.prg
  * contrib/hbnf/tests/nftest.prg
  * contrib/hbnf/tests/test.prg
    * formatting

  * contrib/hbpre.hbm
  * contrib/make.hb
    ! fix to prev for disabling hbmk.hbm (it makes cmdline longer though,
      which might be a problem on MS-DOS)
This commit is contained in:
Viktor Szakats
2012-09-29 16:37:12 +00:00
parent a326ac9804
commit 4a969bd49f
36 changed files with 1252 additions and 1201 deletions
Download Patch File Download Diff File Expand all files Collapse all files

44
harbour/ChangeLog
View File

@@ -16,6 +16,50 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-09-29 18:34 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbnf/aavg.prg
* contrib/hbnf/adessort.prg
* contrib/hbnf/aemaxlen.prg
* contrib/hbnf/aeminlen.prg
* contrib/hbnf/amedian.prg
* contrib/hbnf/anomatch.prg
* contrib/hbnf/asum.prg
* contrib/hbnf/at2.prg
* contrib/hbnf/blink.prg
* contrib/hbnf/clrsel.prg
* contrib/hbnf/datecnfg.prg
* contrib/hbnf/dosver.prg
* contrib/hbnf/findith.prg
* contrib/hbnf/gcd.prg
* contrib/hbnf/invclr.prg
* contrib/hbnf/lastday.prg
* contrib/hbnf/menutonf.prg
* contrib/hbnf/metaph.prg
* contrib/hbnf/miltime.prg
* contrib/hbnf/mouse1.prg
* contrib/hbnf/nooccur.prg
* contrib/hbnf/nwlstat.prg
* contrib/hbnf/pegs.prg
* contrib/hbnf/pending.prg
* contrib/hbnf/pickday.prg
* contrib/hbnf/popadder.prg
* contrib/hbnf/settime.prg
* contrib/hbnf/sleep.prg
* contrib/hbnf/tbwhile.prg
* contrib/hbnf/week.prg
* manual formatting (comments mostly)
+ added TOFIXes where savescreen() buffers are manipulated
* contrib/hbnf/tests/ftgete.prg
* contrib/hbnf/tests/nftest.prg
* contrib/hbnf/tests/test.prg
* formatting
* contrib/hbpre.hbm
* contrib/make.hb
! fix to prev for disabling hbmk.hbm (it makes cmdline longer though,
which might be a problem on MS-DOS)
2012-09-29 17:24 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbnf/aading.prg
* contrib/hbnf/clrsel.prg

2
harbour/contrib/hbnf/aavg.prg
View File

@@ -32,7 +32,7 @@ FUNCTION FT_AAVG( aArray, nStartIndex, nEndIndex )
DEFAULT nStartIndex TO 1
DEFAULT nEndIndex TO Len( aArray )
// Make Sure Bounds are in Range
// Make Sure Bounds are in Range
FORCE_BETWEEN( 1, nEndIndex, Len( aArray ) )
FORCE_BETWEEN( 1, nStartIndex, nEndIndex )

2
harbour/contrib/hbnf/adessort.prg
View File

@@ -32,7 +32,7 @@ FUNCTION FT_ADESSORT( aArray, nStartIndex, nEndIndex )
DEFAULT nStartIndex TO 1
DEFAULT nEndIndex TO Len( aArray )
// Make Sure Bounds are in Range
// Make Sure Bounds are in Range
FORCE_BETWEEN( 1, nEndIndex, Len( aArray ) )
FORCE_BETWEEN( 1, nStartIndex, nEndIndex )

2
harbour/contrib/hbnf/aemaxlen.prg
View File

@@ -57,7 +57,7 @@ FUNCTION FT_AEmaxlen( aArray, nDimension, nStart, nCount )
LOCAL i, nLast, cType, nMaxlen := 0
// Set default parameters as necessary.
// Set default parameters as necessary.
IF nDimension == NIL
nDimension := 1
ENDIF

2
harbour/contrib/hbnf/aeminlen.prg
View File

@@ -60,7 +60,7 @@ FUNCTION FT_AEminlen( aArray, nDimension, nStart, nCount )
LOCAL i, nLast, cType, nMinlen := 65519
// Set default parameters as necessary.
// Set default parameters as necessary.
IF nDimension == NIL
nDimension := 1
ENDIF

10
harbour/contrib/hbnf/amedian.prg
View File

@@ -67,20 +67,20 @@ FUNCTION FT_AMEDIAN( aArray, nStart, nEnd )
DEFAULT nStart TO 1
DEFAULT nEnd TO Len( aArray )
// Make Sure Bounds are in Range
// Make Sure Bounds are in Range
FORCE_BETWEEN( 1, nEnd, Len( aArray ) )
FORCE_BETWEEN( 1, nStart, nEnd )
// Length of aTemparray
// Length of aTemparray
nTemplen := ( nEnd - nStart ) + 1
// Initialize aTemparray
// Initialize aTemparray
aTemparray := ACopy( aArray, Array( nTemplen ), nStart, nTemplen )
// Sort aTemparray
// Sort aTemparray
aTemparray := ASort( aTemparray )
// Determine middle value(s)
// Determine middle value(s)
IF ( nTemplen % 2 ) == 0
nMiddle1 := aTemparray[ ( nTemplen / 2 ) ]
nMiddle2 := aTemparray[ Int( nTemplen / 2 ) + 1 ]

2
harbour/contrib/hbnf/anomatch.prg
View File

@@ -34,7 +34,7 @@ FUNCTION FT_ANOMATCHES( aArray, bCompareBlock, nStartIndex, nEndIndex )
DEFAULT nStartIndex TO 1
DEFAULT nEndIndex TO Len( aArray )
// Make Sure Bounds are in Range
// Make Sure Bounds are in Range
FORCE_BETWEEN( 1, nEndIndex, Len( aArray ) )
FORCE_BETWEEN( 1, nStartIndex, nEndIndex )

2
harbour/contrib/hbnf/asum.prg
View File

@@ -35,7 +35,7 @@ FUNCTION FT_ASUM( aArray, nStartIndex, nEndIndex )
DEFAULT nStartIndex TO 1
DEFAULT nEndIndex TO Len( aArray )
// Make Sure Bounds are in Range
// Make Sure Bounds are in Range
FORCE_BETWEEN( 1, nEndIndex, Len( aArray ) )
FORCE_BETWEEN( 1, nStartIndex, nEndIndex )

4
harbour/contrib/hbnf/at2.prg
View File

@@ -62,7 +62,7 @@ FUNCTION FT_AT2( cSearch, cTarget, nOccurs, lCaseSens )
LOCAL nCount, nPos, nPos2 := 0
LOCAL cSubstr := cTarget
// Set default parameters as necessary.
// Set default parameters as necessary.
IF lCaseSens == NIL
lCaseSens := .T.
ENDIF
@@ -103,7 +103,7 @@ FUNCTION FT_RAT2( cSearch, cTarget, nOccurs, lCaseSens )
LOCAL nCount, nPos, nPos2 := 0
LOCAL cSubstr := cTarget
// Set default parameters as necessary.
// Set default parameters as necessary.
IF lCaseSens == NIL
lCaseSens := .T.
ENDIF

8
harbour/contrib/hbnf/blink.prg
View File

@@ -35,21 +35,21 @@ PROCEDURE Main()
FUNCTION FT_BLINK( cMsg, nRow, nCol )
// Declare color restore var.
// Declare color restore var.
LOCAL cSavColor
// Return if no msg.
// Return if no msg.
IF cMsg == NIL
RETURN NIL
ENDIF
// Set default row and col to current.
// Set default row and col to current.
nRow := iif( nRow == NIL, Row(), nRow )
nCol := iif( nCol == NIL, Col(), nCol )
cSavColor := SetColor() // Save colors to restore on exit.
// IF blink colors not already set, add blink to current foreground color.
// IF blink colors not already set, add blink to current foreground color.
SetColor( iif( ( "*" $ Left( cSavColor, 4 ) ), cSavColor, "*" + cSavColor ) )
@ nRow, nCol SAY cMsg // Say the dreaded blinking msg.

15
harbour/contrib/hbnf/clrsel.prg
View File

@@ -129,8 +129,7 @@ PROCEDURE Main( cVidMode )
{ "Help", "N/G, W+/N,,, W/N", "W" }, ;
{ "Error Messages", "W+/R*,N/GR*,,,N/R*", "W" }, ;
{ "Database Query", "N/BG, N/GR*,,,N+/BG", "B" }, ;
{ "Pick List", "N/GR*,W+/B,,, BG/GR*", "A" } ;
}
{ "Pick List", "N/GR*,W+/B,,, BG/GR*", "A" } }
aClrs := FT_ClrSel( aClrs, lColour )
@@ -516,12 +515,12 @@ STATIC FUNCTION _ftClrSel( aClrPal, cClr, nElem, aOpt )
//.... check key movement and modify co-ordinates
DO CASE
CASE nKey == K_ESC ; EXIT
CASE nKey == K_ENTER ; cClr := aClrPal[ nR, nC ] ; EXIT
CASE nKey == K_UP ; --nR
CASE nKey == K_DOWN ; ++nR
CASE nKey == K_LEFT ; --nC
CASE nKey == K_RIGHT ; ++nC
CASE nKey == K_ESC ; EXIT
CASE nKey == K_ENTER ; cClr := aClrPal[ nR, nC ] ; EXIT
CASE nKey == K_UP ; --nR
CASE nKey == K_DOWN ; ++nR
CASE nKey == K_LEFT ; --nC
CASE nKey == K_RIGHT ; ++nC
ENDCASE
ENDDO

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

@@ -170,9 +170,8 @@ PROCEDURE Main()
// DEMO Monthly Calendar function.
// nType : 0 -> FT_MONTH, 1 -> FT_ACCTMONTH
//
FUNCTION FT_CAL( dGivenDate, nType )
STATIC FUNCTION FT_CAL( dGivenDate, nType )
LOCAL nTemp, dTemp, aTemp, cFY_Start, dStart, dEnd

2
harbour/contrib/hbnf/dosver.prg
View File

@@ -41,7 +41,7 @@ PROCEDURE Main()
FUNCTION FT_DOSVER()
/* LOCAL aRegs[ INT86_MAX_REGS ] */
// LOCAL aRegs[ INT86_MAX_REGS ]
LOCAL cResult
/* aRegs[ AX ] := MAKEHI( DOSVER )

4
harbour/contrib/hbnf/findith.prg
View File

@@ -53,7 +53,7 @@ FUNCTION FT_FINDITH( cCheckFor, cCheckIn, nWhichOccurrence, lIgnoreCase )
LOCAL nIthOccurrence
// Is Case Sensitivity Important??
// Is Case Sensitivity Important??
IF ! HB_ISLOGICAL( lIgnoreCase ) .OR. ;
lIgnoreCase
@@ -61,7 +61,7 @@ FUNCTION FT_FINDITH( cCheckFor, cCheckIn, nWhichOccurrence, lIgnoreCase )
MAKE_UPPER( cCheckIn )
ENDIF // IS_NOT_LOGICAL(lIgnoreCase) or
// lIgnoreCase
// lIgnoreCase
RETURN iif( nWhichOccurrence == 1, ;
At( cCheckFor, cCheckIn ), ;

2
harbour/contrib/hbnf/gcd.prg
View File

@@ -39,7 +39,7 @@ FUNCTION FT_GCD( nNumber1, nNumber2 )
LOCAL nHold2 // Temporarily Hold the Minimum Number
LOCAL nResult // GCD
// Either Number Zero??
// Either Number Zero??
IF nNumber1 == 0 .OR. nNumber2 == 0
nResult := 0 // Yes, Can't Have a GCD
ELSE // No, Calculate the GCD

6
harbour/contrib/hbnf/invclr.prg
View File

@@ -34,14 +34,14 @@ FUNCTION FT_INVCLR( cDsrdColor )
LOCAL cModifiers // Any Color Modifiers (+*)
DEFAULT cDsrdColor TO SetColor()
// Remove Anything Past 1st Color
// Remove Anything Past 1st Color
cDsrdColor := Left( cDsrdColor, At( ",", cDsrdColor + "," ) - 1 )
// Get Any Modifiers
// Get Any Modifiers
cModifiers := iif( "*" $ cDsrdColor, "*", NULL ) + ;
iif( "+" $ cDsrdColor, "+", NULL )
// Separate the Fore/Background Colors
// Separate the Fore/Background Colors
cForeground := AllTrim( Left( cDsrdColor, At( "/", cDsrdColor ) - 1 ) )
cBackground := AllTrim( SubStr( cDsrdColor, At( "/", cDsrdColor ) + 1 ) )

8
harbour/contrib/hbnf/lastday.prg
View File

@@ -21,11 +21,11 @@
*
*/
/* Librarian's note: The toolkit's original ft_lday() function was
submitted by Jeff Bryant. Mike saw it and optimized it. Thanks
to you both for your great code!
/* Librarian's note: The toolkit's original ft_lday() function was
submitted by Jeff Bryant. Mike saw it and optimized it. Thanks
to you both for your great code!
*/
*/
FUNCTION ft_lday( dDate )

4
harbour/contrib/hbnf/menutonf.prg
View File

@@ -46,7 +46,7 @@
( <exp> \ > 0 .AND. <exp> \ <= nCount )
#xtranslate isBetween( <val>, <lower>, <upper> ) => ;
( < val > \ >= < lower > .AND. < val > \ <= < upper > )
( <val> \ >= <lower> .AND. <val> \ <= <upper> )
#define nTriggerInkey hb_keyCode( Upper( SubStr( cPrompt, nTrigger, 1 ) ) )
#define cTrigger SubStr( cPrompt, nTrigger, 1 )
@@ -230,7 +230,7 @@ FUNCTION FT_MenuTo( bGetSet, cReadVar, lCold )
DispBegin()
IF t_aMessage[ nCurrent ] != NIL
cScreen := SaveScreen( t_aMsgRow[ nCurrent ], t_aMsgCol[ nCurrent ], ;
cScreen := SaveScreen( t_aMsgRow[ nCurrent ], t_aMsgCol[ nCurrent ], ;
t_aMsgRow[ nCurrent ], t_aMsgCol[ nCurrent ] + ;
Len( t_aMessage[ nCurrent ] ) - 1 )

51
harbour/contrib/hbnf/metaph.prg
View File

@@ -191,26 +191,25 @@ STATIC FUNCTION _ftCol( nElem ) // Determine which column to start print
//------------------------------------------------
#endif
// End of Test program
//------------------------------------------------
FUNCTION FT_METAPH( cName, nSize )
// Calculates the metaphone of a character string
// Calculates the metaphone of a character string
LOCAL cMeta
cName := iif( cName == NIL, "", cName ) // catch-all
nSize := iif( nSize == NIL, 4, nSize ) // default size: 4-bytes
// Remove non-alpha characters and make upper case.
// The string is padded with 1 space at the beginning & end.
// Spaces, if present inside the string, are not removed until all
// the prefix/suffix checking has been completed.
// Remove non-alpha characters and make upper case.
// The string is padded with 1 space at the beginning & end.
// Spaces, if present inside the string, are not removed until all
// the prefix/suffix checking has been completed.
cMeta := " " + _ftMakeAlpha( Upper( AllTrim( cName ) ) ) + " "
// prefixes which need special consideration
// prefixes which need special consideration
IF " KN" $ cMeta ; cMeta := StrTran( cMeta, " KN" , " N" ) ; ENDIF
IF " GN" $ cMeta ; cMeta := StrTran( cMeta, " GN" , " N" ) ; ENDIF
IF " PN" $ cMeta ; cMeta := StrTran( cMeta, " PN" , " N" ) ; ENDIF
@@ -225,16 +224,16 @@ FUNCTION FT_METAPH( cName, nSize )
IF " MAC" $ cMeta ; cMeta := StrTran( cMeta, " MAC", " MK" ) ; ENDIF
IF " GI" $ cMeta ; cMeta := StrTran( cMeta, " GI", " K" ) ; ENDIF
// Suffixes which need special consideration
// Suffixes which need special consideration
IF "MB " $ cMeta ; cMeta := StrTran( cMeta, "MB " , "M " ) ; ENDIF
IF "NG " $ cMeta ; cMeta := StrTran( cMeta, "NG " , "N " ) ; ENDIF
// Remove inner spaces (1st and last byte are spaces)
// Remove inner spaces (1st and last byte are spaces)
IF " " $ SubStr( cMeta, 2, Len( cMeta ) - 2 )
cMeta := " " + StrTran( cMeta, " " , "" ) + " "
ENDIF
// Double consonants sound much the same as singles
// Double consonants sound much the same as singles
IF "BB" $ cMeta ; cMeta := StrTran( cMeta, "BB" , "B" ) ; ENDIF
IF "CC" $ cMeta ; cMeta := StrTran( cMeta, "CC" , "CH" ) ; ENDIF
IF "DD" $ cMeta ; cMeta := StrTran( cMeta, "DD" , "T" ) ; ENDIF
@@ -251,7 +250,7 @@ FUNCTION FT_METAPH( cName, nSize )
IF "XX" $ cMeta ; cMeta := StrTran( cMeta, "XX" , "KS" ) ; ENDIF
IF "ZZ" $ cMeta ; cMeta := StrTran( cMeta, "ZZ" , "S" ) ; ENDIF
// J sounds
// J sounds
IF "DGE" $ cMeta ; cMeta := StrTran( cMeta, "DGE" , "J" ) ; ENDIF
IF "DGY" $ cMeta ; cMeta := StrTran( cMeta, "DGY" , "J" ) ; ENDIF
IF "DGI" $ cMeta ; cMeta := StrTran( cMeta, "DGI" , "J" ) ; ENDIF
@@ -259,14 +258,14 @@ FUNCTION FT_METAPH( cName, nSize )
IF "GE" $ cMeta ; cMeta := StrTran( cMeta, "GE" , "J" ) ; ENDIF
IF "GY" $ cMeta ; cMeta := StrTran( cMeta, "GY" , "J" ) ; ENDIF
// X sounds (KS)
// X sounds (KS)
IF "X" $ cMeta ; cMeta := StrTran( cMeta, "X" , "KS" ) ; ENDIF
// special consideration for SCH
// special consideration for SCH
IF "ISCH" $ cMeta; cMeta := StrTran( cMeta, "ISCH", "IX" ) ; ENDIF
IF "SCH" $ cMeta ; cMeta := StrTran( cMeta, "SCH" , "SK" ) ; ENDIF
// sh sounds (X)
// sh sounds (X)
IF "CIA" $ cMeta ; cMeta := StrTran( cMeta, "CIA" , "X" ) ; ENDIF
IF "SIO" $ cMeta ; cMeta := StrTran( cMeta, "SIO" , "X" ) ; ENDIF
IF "C" $ cMeta ; cMeta := StrTran( cMeta, "SIA" , "X" ) ; ENDIF
@@ -276,7 +275,7 @@ FUNCTION FT_METAPH( cName, nSize )
IF "TCH" $ cMeta ; cMeta := StrTran( cMeta, "TCH" , "X" ) ; ENDIF
IF "CH" $ cMeta ; cMeta := StrTran( cMeta, "CH" , "X" ) ; ENDIF
// hissing sounds (S)
// hissing sounds (S)
IF "SCI" $ cMeta ; cMeta := StrTran( cMeta, "SCI" , "S" ) ; ENDIF
IF "SCE" $ cMeta ; cMeta := StrTran( cMeta, "SCE" , "S" ) ; ENDIF
IF "SCY" $ cMeta ; cMeta := StrTran( cMeta, "SCY" , "S" ) ; ENDIF
@@ -285,43 +284,43 @@ FUNCTION FT_METAPH( cName, nSize )
IF "CY" $ cMeta ; cMeta := StrTran( cMeta, "CY" , "S" ) ; ENDIF
IF "Z" $ cMeta ; cMeta := StrTran( cMeta, "Z" , "S" ) ; ENDIF
// th sound (0)
// th sound (0)
IF "TH" $ cMeta ; cMeta := StrTran( cMeta, "TH" , "0" ) ; ENDIF
// Convert all vowels to 'v' from 3rd byte on
// Convert all vowels to 'v' from 3rd byte on
cMeta := Left( cMeta, 2 ) + _ftConvVowel( SubStr( cMeta, 3 ) )
// Make Y's silent if not followed by vowel
// Make Y's silent if not followed by vowel
IF "Y" $ cMeta
cMeta := StrTran( cMeta, "Yv" , "#" ) // Y followed by vowel
cMeta := StrTran( cMeta, "Y" , "" ) // not followed by vowel
cMeta := StrTran( cMeta, "#" , "Yv" ) // restore Y and vowel
ENDIF
// More G sounds, looking at surrounding vowels
// More G sounds, looking at surrounding vowels
IF "GHv" $ cMeta ; cMeta := StrTran( cMeta, "GHv" , "G" ) ; ENDIF
IF "vGHT" $ cMeta; cMeta := StrTran( cMeta, "vGHT", "T" ) ; ENDIF
IF "vGH" $ cMeta ; cMeta := StrTran( cMeta, "vGH" , "W" ) ; ENDIF
IF "GN" $ cMeta ; cMeta := StrTran( cMeta, "GN" , "N" ) ; ENDIF
IF "G" $ cMeta ; cMeta := StrTran( cMeta, "G" , "K" ) ; ENDIF
// H sounds, looking at surrounding vowels
// H sounds, looking at surrounding vowels
IF "vHv" $ cMeta ; cMeta := StrTran( cMeta, "vHv" , "H" ) ; ENDIF
IF "vH" $ cMeta ; cMeta := StrTran( cMeta, "vH" , "" ) ; ENDIF
// F sounds
// F sounds
IF "PH" $ cMeta ; cMeta := StrTran( cMeta, "PH" , "F" ) ; ENDIF
IF "V" $ cMeta ; cMeta := StrTran( cMeta, "V" , "F" ) ; ENDIF
// D sounds a bit like T
// D sounds a bit like T
IF "D" $ cMeta ; cMeta := StrTran( cMeta, "D" , "T" ) ; ENDIF
// K sounds
// K sounds
IF "CK" $ cMeta ; cMeta := StrTran( cMeta, "CK" , "K" ) ; ENDIF
IF "Q" $ cMeta ; cMeta := StrTran( cMeta, "Q" , "K" ) ; ENDIF
IF "C" $ cMeta ; cMeta := StrTran( cMeta, "C" , "K" ) ; ENDIF
// Remove vowels
// Remove vowels
cMeta := StrTran( cMeta, "v", "" )
RETURN PadR( AllTrim( cMeta ), nSize )
@@ -330,7 +329,7 @@ FUNCTION FT_METAPH( cName, nSize )
STATIC FUNCTION _ftMakeAlpha( cStr )
// Strips non-alpha characters from a string, leaving spaces
// Strips non-alpha characters from a string, leaving spaces
LOCAL x, cAlpha := ""
@@ -346,7 +345,7 @@ STATIC FUNCTION _ftMakeAlpha( cStr )
STATIC FUNCTION _ftConvVowel( cStr )
// Converts all vowels to letter 'v'
// Converts all vowels to letter 'v'
LOCAL x, cConverted := ""

6
harbour/contrib/hbnf/miltime.prg
View File

@@ -27,7 +27,7 @@
PROCEDURE Main()
cls
CLS
? "am-pm"
? ft_civ2mil( " 5:40 pm" )
? ft_civ2mil( "05:40 pm" )
@@ -37,7 +37,7 @@ PROCEDURE Main()
? ft_civ2mil( " 5:40 AM" )
?
Inkey( 0 )
cls
CLS
? "noon-midnight"
? ft_civ2mil( "12:00 m" )
? ft_civ2mil( "12:00 M" )
@@ -47,7 +47,7 @@ PROCEDURE Main()
? ft_civ2mil( "12:00 n" )
?
Inkey( 0 )
cls
CLS
? "errors in noon-midnight"
? ft_civ2mil( "12:01 n" )
? ft_civ2mil( "22:00 n" )

8
harbour/contrib/hbnf/mouse1.prg
View File

@@ -185,7 +185,7 @@ PROCEDURE Main( nRow, nCol )
RestScreen( 0, 0, MaxRow(), MaxCol(), cSavScr )
DevPos( MaxRow(), 0 )
// Reset sensitivity
// Reset sensitivity
FT_MSETSENS( nHoriz, nVert, nDouble )
@@ -340,7 +340,7 @@ FUNCTION FT_MSETSENS( nHoriz, nVert, nDouble )
// Fill the registers
_mset_sensitive( nHoriz, nVert, nDouble )
RETURN nil
RETURN NIL
FUNCTION FT_MGETSENS( nHoriz, nVert, nDouble )
/*
@@ -434,11 +434,11 @@ FUNCTION FT_MRESET()
/*
aReg[ AX ] := 0 // set mouse function call 0
FT_INT86( 51, aReg ) // execute mouse interrupt
*/
*/
t_lCrsState := .F. // Cursor is off after reset
lStatus := _m_reset()
// Reset maximum x and y limits
// Reset maximum x and y limits
FT_MYLIMIT( 0, 8 * MaxRow() )
FT_MXLIMIT( 0, 8 * MaxCol() )

4
harbour/contrib/hbnf/nooccur.prg
View File

@@ -27,14 +27,14 @@
FUNCTION FT_NOOCCUR( cCheckFor, cCheckIn, lIgnoreCase )
// Is Case Important??
// Is Case Important??
IF ! HB_ISLOGICAL( lIgnoreCase ) .OR. lIgnoreCase
MAKE_UPPER( cCheckFor ) // No, Force Everything to Uppercase
MAKE_UPPER( cCheckIn )
ENDIF
// lIgnoreCase
// lIgnoreCase
RETURN iif( Len( cCheckFor ) == 0 .OR. Len( cCheckIn ) == 0, ;
0, ;

4
harbour/contrib/hbnf/nwlstat.prg
View File

@@ -41,12 +41,12 @@ PROCEDURE Main()
FUNCTION FT_NWLSTAT()
/* LOCAL aRegs[ INT86_MAX_REGS ] */
// LOCAL aRegs[ INT86_MAX_REGS ]
LOCAL nStation
/*
aRegs[ AX ] := MAKEHI( STATNUM )
FT_INT86( DOS, aRegs )
*/
*/
nStation := _ft_nwkstat() /* LOWBYTE( aRegs[ AX ] ) */
IF nStation < 0
nStation += 256

14
harbour/contrib/hbnf/pegs.prg
View File

@@ -31,11 +31,11 @@
#include "inkey.ch"
#include "setcurs.ch"
#translate SINGLEBOX(<top>, <left>, <bottom>, <right>) => ;
@ < top > , < left > , < bottom > , < right > BOX hb_UTF8ToStr( "┌─┐│┘─└│ " )
#translate DOUBLEBOX(<top>, <left>, <bottom>, <right>) => ;
@ < top > , < left > , < bottom > , < right > BOX hb_UTF8ToStr( "╔═╗║╝═╚║ " )
MEMVAR getlist
#translate SINGLEBOX( <top>, <left>, <bottom>, <right> ) => ;
@ <top>, <left>, <bottom>, <right> BOX hb_UTF8ToStr( "┌─┐│┘─└│ " )
#translate DOUBLEBOX( <top>, <left>, <bottom>, <right> ) => ;
@ <top>, <left>, <bottom>, <right> BOX hb_UTF8ToStr( "╔═╗║╝═╚║ " )
MEMVAR GetList
/*
here's the board array -- structure of which is:
@@ -91,7 +91,7 @@ FUNCTION FT_PEGS()
*/
scanblock := {| a | a[ 2 ] == move2 }
cls
CLS
SetColor( "w/r" )
SINGLEBOX( 22, 31, 24, 48 )
@ 23, 33 SAY "Your move:"
@@ -183,7 +183,7 @@ STATIC FUNCTION err_msg( msg )
SetCursor( SC_NORMAL )
RestScreen( 23, 33, 23, 47, buffer )
RETURN nil
RETURN NIL
//--------------------------------------------------------------------*

6
harbour/contrib/hbnf/pending.prg
View File

@@ -26,9 +26,9 @@ PROCEDURE Main()
@ 0, 0 CLEAR
FT_PENDING( "Message one", 20, 0, 3, "W+/G" ) // Displays "Message one."
// sets row to 20, col to 0.
// wait to 3 and color to
// bright white over green.
// sets row to 20, col to 0.
// wait to 3 and color to
// bright white over green.
FT_PENDING( "Message two" ) // Displays "Message two", after 5 sec.
FT_PENDING( "Message three" ) // Displays "Message three", after 5 sec.

6
harbour/contrib/hbnf/pickday.prg
View File

@@ -36,10 +36,10 @@ PROCEDURE Main()
FUNCTION FT_PICKDAY()
LOCAL DAYS := { "SUNDAY", "MONDAY", "TUESDAY", "WEDNESDAY", "THURSDAY", ;
LOCAL days := { "SUNDAY", "MONDAY", "TUESDAY", "WEDNESDAY", "THURSDAY", ;
"FRIDAY", "SATURDAY" }
LOCAL SEL := 0
LOCAL OLDSCRN := SaveScreen( 8, 35, 16, 45 ), oldcolor := SetColor( "+w/r" )
LOCAL sel := 0
LOCAL oldscrn := SaveScreen( 8, 35, 16, 45 ), oldcolor := SetColor( "+w/r" )
@ 8, 35, 16, 45 BOX hb_UTF8ToStr( "┌─┐│┘─└│ " )
/* do not allow user to Esc out, which would cause array access error */

20
harbour/contrib/hbnf/popadder.prg
View File

@@ -261,8 +261,10 @@ FUNCTION FT_Adder()
IF lTape
RestScreen( 4 + nTopOS, 6 + nTapeSpace, 22 + nTopOS, 35 + nTapeSpace, cTapeScr )
ENDIF
IF Left( SaveScreen( 6 + nTopOS, 26 + nAddSpace, 6 + nTopOS, 27 + nAddSpace ), 1 ) ;
// TOFIX: manipulating savescreen buffers
IF Left( SaveScreen( 6 + nTopOS, 26 + nAddSpace, 6 + nTopOS, 27 + nAddSpace ), 1 ) ;
!= " "
// TOFIX: manipulating savescreen buffers
IF Left( SaveScreen( 6 + nTopOS, 19 + nAddSpace, 6 + nTopOS, 20 + nAddSpace ), 1 ) ;
== "S"
cMoveTotSubTot := "S"
@@ -272,10 +274,11 @@ FUNCTION FT_Adder()
ELSE
cMoveTotSubTot := " "
ENDIF
// TOFIX: manipulating savescreen buffers
cTotal := _ftCharOdd( SaveScreen( 4 + nTopOS, 8 + nAddSpace, 4 + ;
nTopOS, 25 + nAddSpace ) )
_ftPopWin() // Remove Adder
lShowRight := !lShowRight
lShowRight := ! lShowRight
nAddSpace := iif( lShowRight, 40, 0 ) + nLeftOS
nTapeSpace := iif( lShowRight, 0, 40 ) + nLeftOS
_ftAddScreen( aAdder )
@@ -287,7 +290,7 @@ FUNCTION FT_Adder()
@ 4 + nTopOS, 8 + nAddSpace SAY cTotal
IF !Empty( cMoveTotSubTot )
_ftSetWinColor( W_CURR, W_SCREEN )
@ 6 + nTopOS, 18 + nAddSpace SAY iif( cMoveTotSubTot == "T", " <TOTAL>", ;
@ 6 + nTopOS, 18 + nAddSpace SAY iif( cMoveTotSubTot == "T", " <TOTAL>", ;
"<SUBTOTAL>" )
_ftSetWinColor( W_CURR, W_PROMPT )
ENDIF
@@ -296,7 +299,7 @@ FUNCTION FT_Adder()
SetColor( "GR+/W" )
@ 21 + nTopOS, 8 + nTapeSpace SAY hb_UTF8ToStr( " ↑↓-SCROLL <ESC>-QUIT " )
SetColor( "N/W,W+/N" )
AChoice( 5 + nTopOS, 7 + nTapeSpace, 20 + nTopOS, 32 + nTapeSpace, aTrans, .T. , ;
AChoice( 5 + nTopOS, 7 + nTapeSpace, 20 + nTopOS, 32 + nTapeSpace, aTrans, .T. , ;
"_ftAdderTapeUDF", nTotTran, 20 )
SetColor( "R+/W" )
@ 21 + nTopOS, 8 + nTapeSpace TO 21 + nTopOS, 30 + nTapeSpace
@@ -792,7 +795,7 @@ STATIC FUNCTION _ftAddHelp
" <ESC> - Quit" + hb_eol() + ;
" <F10> - return a <TOTAL> to the active get"
_ftPushMessage( cMess, .T. , "ADDER HELP", "press any key to continue...", ;
_ftPushMessage( cMess, .T. , "ADDER HELP", "press any key to continue...", ;
"QUIET" )
RETURN NIL
@@ -1010,7 +1013,7 @@ STATIC FUNCTION _ftDisplayTape( aAdder, nKey )
IF nTotTran > 15
nTopTape := nTotTran - 15
ENDIF
FOR nDispTape := nTotTran TO nTopTape STEP - 1
FOR nDispTape := nTotTran TO nTopTape STEP -1
@ 20 + nDispTape - nTotTran + nTopOS, 7 + nTapeSpace SAY aTrans[ nDispTape ]
NEXT
ENDIF
@@ -1223,7 +1226,7 @@ STATIC FUNCTION _ftQuest( cMessage, xVarVal, cPict, bValid, lNoESC, nWinColor, n
nLeft := Int( ( MaxCol() - nWide ) / 2 ) - 4
nRight := nLeft + nWide + 4
_ftPushWin( nTop, nLeft, nBottom, nRight, "QUESTION ?", iif( HB_ISSTRING( xVarVal ) ;
_ftPushWin( nTop, nLeft, nBottom, nRight, "QUESTION ?", iif( HB_ISSTRING( xVarVal ) ;
.AND. nVarLen > nWide, hb_UTF8ToStr( "← scroll →" ), NIL ), nWinColor )
DISPMESSAGE cMessage, nTop + 1, nLeft + 2, nBottom - 1, nRight - 2
@@ -1361,7 +1364,7 @@ STATIC FUNCTION _ftError( cMessage, xDontReset )
cErrorScr := SaveScreen( nTop, nLeft, nBot + 1, nRight + 2 )
_ftShadow( nBot + 1, nLeft + 2, nBot + 1, nRight + 2, 8 )
_ftShadow( nTop + 1, nRight + 1, nBot , nRight + 2, 8 )
_ftShadow( nTop + 1, nRight + 1, nBot, nRight + 2, 8 )
@ nTop, nLeft, nBot, nRight BOX B_SINGLE
@ nTop, nLeft + Int( nWide / 2 ) - 1 SAY " ERROR "
@ nBot - 1, nLeft + Int( nWide - 28 ) / 2 + 3 SAY "Press any key to continue..."
@@ -1621,6 +1624,7 @@ STATIC FUNCTION _ftSetWinColor( nWin, nStd, nEnh, nBord, nBack, nUnsel )
STATIC FUNCTION _ftShadow( nTop, nLeft, nBottom, nRight )
// TOFIX: manipulating savescreen buffers
LOCAL theShadow := SaveScreen( nTop, nLeft, nBottom, nRight )
RestScreen( nTop, nLeft, nBottom, nRight, ;

4
harbour/contrib/hbnf/settime.prg
View File

@@ -55,10 +55,10 @@ FUNCTION FT_SETTIME( cTime )
cTime := iif( cTime == NIL, Time(), cTime )
// -------- High Byte ------ ----- Low Byte -------
// -------- High Byte ------ ----- Low Byte -------
aRegs[ AX ] := SETTIME * ( 2 ^ 8 )
aRegs[ CX ] := HRS( cTime ) * ( 2 ^ 8 ) + MINS( cTime )
aRegs[ CX ] := HRS( cTime ) * ( 2 ^ 8 ) + MINS( cTime )
aRegs[ DX ] := Secs( cTime ) * ( 2 ^ 8 )
RETURN FT_INT86( DOS, aRegs )

1
harbour/contrib/hbnf/sleep.prg
View File

@@ -24,7 +24,6 @@
// Test routine
// Invoke by running SLEEP 1.0 to sleep 1.0 seconds
//
PROCEDURE Main( nSleep )

24
harbour/contrib/hbnf/tbwhile.prg
View File

@@ -70,7 +70,7 @@
* tbnames.dbf/.ntx ARE AUTOMATICALLY CREATED BY THIS TEST PROGRAM
*/
PROCEDURE TBWHILE()
PROCEDURE Main()
LOCAL aFields := {}, cKey := "O", cOldColor
LOCAL nFreeze := 1, lSaveScrn := .T. , nRecSel
@@ -91,8 +91,8 @@ PROCEDURE TBWHILE()
SET INDEX TO TBNAMES
// Pass Heading as character and Field as Block including Alias
// To eliminate the need to use FIELDWBLOCK() function in FT_BRWSWHL()
// Pass Heading as character and Field as Block including Alias
// To eliminate the need to use FIELDWBLOCK() function in FT_BRWSWHL()
AAdd( aFields, { "Last Name" , {|| TBNames->Last } } )
AAdd( aFields, { "First Name", {|| TBNames->First } } )
@@ -103,17 +103,17 @@ PROCEDURE TBWHILE()
@ 5, 10 SAY "Enter First Letter Of Last Name:" GET cKey PICTURE "!"
READ
// TBNames->Last = cKey is the Conditional Block passed to this function
// you can make it as complicated as you want, but you would then
// have to modify TBWhileSet() to find first and last records
// matching your key.
// TBNames->Last = cKey is the Conditional Block passed to this function
// you can make it as complicated as you want, but you would then
// have to modify TBWhileSet() to find first and last records
// matching your key.
nRecSel := FT_BRWSWHL( aFields, {|| TBNames->Last = cKey }, cKey, nFreeze, ;
lSaveScrn, cColorList, cColorShad, 3, 6, MaxRow() - 2, MaxCol() - 6 )
// Note you can use Compound Condition
// such as cLast =: "Pierce " and cFirst =: "Hawkeye "
// by changing above block to:
// {|| TBNames->Last = cLast .AND. TBNames->First = cFirst }
// and setting cKey := cLast + cFirst
// Note you can use Compound Condition
// such as cLast =: "Pierce " and cFirst =: "Hawkeye "
// by changing above block to:
// {|| TBNames->Last = cLast .AND. TBNames->First = cFirst }
// and setting cKey := cLast + cFirst
?
IF nRecSel == 0

2
harbour/contrib/hbnf/tests/ftgete.prg
View File

@@ -4,7 +4,7 @@
#include "simpleio.ch"
PROCEDURE main()
PROCEDURE Main()
LOCAL a
LOCAL c

2125
harbour/contrib/hbnf/tests/nftest.prg
View File

File diff suppressed because it is too large Load Diff

49
harbour/contrib/hbnf/tests/test.prg
View File

@@ -2,30 +2,31 @@
* $Id$
*/
function main()
local nver,nmar,ntype,nir,ppp
PROCEDURE Main()
nmar:=FT_MVERSION(@nver,@ntype,@nir)
ppp:=nmar+nver
? str(nmar,2,0),'.',str(nver,2,0)
? ppp/100
inkey(0)
? 'is mouse on', ft_mreset()
inkey(0)
? FT_MSHOWCRS()
inkey(0)
? ft_mxlimit(0,8*maxcol())
inkey(0)
? ft_mylimit(0,8*maxrow())
inkey(0)
LOCAL nver, nmar, ntype, nir, ppp
do while lastkey()!=27
? 'mouse row is',ft_mgetx()
? 'mouse col is',ft_mgety()
if lastkey()==27
exit
endif
enddo
FT_MHIDECRS()
return nil
nmar := FT_MVERSION( @nver, @ntype, @nir )
ppp := nmar + nver
? Str( nmar, 2, 0 ), '.', Str( nver, 2, 0 )
? ppp/100
Inkey( 0 )
? 'is mouse on', ft_mreset()
Inkey( 0 )
? FT_MSHOWCRS()
Inkey( 0 )
? ft_mxlimit( 0, 8 * MaxCol() )
Inkey( 0 )
? ft_mylimit( 0, 8 * MaxRow() )
Inkey( 0 )
DO WHILE LastKey() != 27
? 'mouse row is', ft_mgetx()
? 'mouse col is', ft_mgety()
IF LastKey() == 27
EXIT
ENDIF
ENDDO
FT_MHIDECRS()
RETURN

2
harbour/contrib/hbnf/week.prg
View File

@@ -30,7 +30,7 @@ FUNCTION FT_WEEK( dGivenDate, nWeekNum )
LOCAL lIsWeek, nTemp, aRetVal, dTemp
IF ! ( ValType( dGivenDate ) $ "ND" )
IF !( ValType( dGivenDate ) $ "ND" )
dGivenDate := Date()
ELSEIF HB_ISNUMERIC( dGivenDate )
nWeekNum := dGivenDate

1
harbour/contrib/hbpre.hbm
View File

@@ -5,7 +5,6 @@
# These may be overridden by local project options.
-q0
-autohbm-
{HB_BUILD_VERBOSE}-quiet-
{HB_BUILD_VERBOSE}-info

4
harbour/contrib/make.hb
View File

@@ -493,7 +493,7 @@ STATIC FUNCTION call_hbmk2_hbinfo( cProjectPath, hProject )
hProject[ "aDept" ] := {}
hProject[ "lChecked" ] := NIL
IF ( nErrorLevel := call_hbmk2( cProjectPath, " --hbinfo -autohbm-", NIL,, @cStdOut ) ) == 0
IF ( nErrorLevel := call_hbmk2( cProjectPath, " --hbinfo", NIL,, @cStdOut ) ) == 0
hb_jsonDecode( cStdOut, @hInfo )
@@ -549,7 +549,7 @@ STATIC FUNCTION call_hbmk2( cProjectPath, cOptionsPre, cDynSuffix, cStdErr, cStd
hb_setenv( "_HB_CONTRIB_SUBDIR", hb_FNameDir( PathSepToSelf( cProjectPath ) ) )
cCommand := s_cBinDir + "hbmk2" +;
" -quiet -width=0" +;
" -quiet -width=0 -autohbm-" +;
" @" + StrTran( s_cHome + "hbpre", "\", "/" ) +;
cOptionsPre +;
" " + StrTran( cProjectPath, "\", "/" ) +;