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

2012-09-26 17:54 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/hbnf/bitclr.prg
  * contrib/hbnf/bitset.prg
  * contrib/hbnf/byt2hex.prg
  * contrib/hbnf/byteand.prg
  * contrib/hbnf/byteneg.prg
  * contrib/hbnf/bytenot.prg
  * contrib/hbnf/byteor.prg
  * contrib/hbnf/bytexor.prg
  * contrib/hbnf/floptst.prg
  * contrib/hbnf/isbit.prg
  * contrib/hbnf/pchr.prg
  * contrib/hbnf/popadder.prg
  * contrib/hbnf/scancode.prg
    ! cleaned some CHR() and ASC() calls for unicode
    ! FT_Adder(): fixed typo causing </> key not to be recognized
This commit is contained in:
Viktor Szakats
2012-09-26 15:57:48 +00:00
parent 31819df700
commit 93c9545c89
14 changed files with 85 additions and 74 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
harbour/ChangeLog
View File

@@ -16,6 +16,23 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-09-26 17:54 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbnf/bitclr.prg
* contrib/hbnf/bitset.prg
* contrib/hbnf/byt2hex.prg
* contrib/hbnf/byteand.prg
* contrib/hbnf/byteneg.prg
* contrib/hbnf/bytenot.prg
* contrib/hbnf/byteor.prg
* contrib/hbnf/bytexor.prg
* contrib/hbnf/floptst.prg
* contrib/hbnf/isbit.prg
* contrib/hbnf/pchr.prg
* contrib/hbnf/popadder.prg
* contrib/hbnf/scancode.prg
! cleaned some CHR() and ASC() calls for unicode
! FT_Adder(): fixed typo causing </> key not to be recognized
2012-09-26 17:11 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbnf/aredit.prg
* contrib/hbnf/calendar.prg

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

@@ -33,7 +33,7 @@ FUNCTION FT_BITCLR( cInbyte, nBitpos )
cByte := NIL
ELSE
cByte := iif( ! FT_ISBIT( cInByte, nBitpos ), cInByte, ;
Chr( Asc( cInByte ) - ( 2 ^ nBitpos ) ) )
hb_BChar( hb_BCode( cInByte ) - ( 2 ^ nBitpos ) ) )
ENDIF
ELSE
cByte := NIL

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

@@ -33,7 +33,7 @@ FUNCTION FT_BITSET( cInByte, nBitpos )
cByte := NIL
ELSE
cByte := iif( FT_ISBIT( cInByte, nBitpos ), cInByte, ;
Chr( Asc( cInByte ) + ( 2 ^ nBitpos ) ) )
hb_BChar( hb_BCode( cInByte ) + ( 2 ^ nBitpos ) ) )
ENDIF
ELSE
cByte := NIL

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

@@ -30,8 +30,8 @@ FUNCTION FT_BYT2HEX( cByte )
LOCAL xHexString
IF HB_ISSTRING( cByte )
xHexString := SubStr( cHexTable, Int( Asc( cByte ) / 16 ) + 1, 1 ) + ;
SubStr( cHexTable, Int( Asc( cByte ) % 16 ) + 1, 1 ) + ;
xHexString := SubStr( cHexTable, Int( hb_BCode( cByte ) / 16 ) + 1, 1 ) + ;
SubStr( cHexTable, Int( hb_BCode( cByte ) % 16 ) + 1, 1 ) + ;
"h"
ELSE
xHexString := NIL

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

@@ -29,7 +29,7 @@ FUNCTION FT_BYTEAND( cByte1, cByte2 )
LOCAL nCounter, cNewByte
IF HB_ISSTRING( cByte1 ) .AND. HB_ISSTRING( cByte2 )
cNewByte := Chr( 0 )
cNewByte := hb_BChar( 0 )
FOR nCounter := 0 TO 7 // test each bit position
IF FT_ISBIT( cByte1, nCounter ) .AND. FT_ISBIT( cByte2, nCounter )
cNewByte := FT_BITSET( cNewByte, nCounter )

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

@@ -25,4 +25,4 @@
*/
FUNCTION FT_BYTENEG( cByte )
RETURN iif( HB_ISSTRING( cByte ), Chr( ( 256 - Asc( cByte ) ) % 256 ), NIL )
RETURN iif( HB_ISSTRING( cByte ), hb_BChar( ( 256 - hb_BCode( cByte ) ) % 256 ), NIL )

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

@@ -30,7 +30,7 @@ FUNCTION FT_BYTENOT( cByte )
LOCAL nCounter, cNewByte
IF HB_ISSTRING( cByte )
cNewByte := Chr( 0 )
cNewByte := hb_BChar( 0 )
FOR nCounter := 0 TO 7 // test each bit position
IF ! FT_ISBIT( cByte, nCounter )
cNewByte := FT_BITSET( cNewByte, nCounter )

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

@@ -29,7 +29,7 @@ FUNCTION FT_BYTEOR( cByte1, cByte2 )
LOCAL nCounter, cNewByte
IF HB_ISSTRING( cByte1 ) .AND. HB_ISSTRING( cByte2 )
cNewByte := Chr( 0 )
cNewByte := hb_BChar( 0 )
FOR nCounter := 0 TO 7 // test each bit position
IF FT_ISBIT( cByte1, nCounter ) .OR. FT_ISBIT( cByte2, nCounter )
cNewByte := FT_BITSET( cNewByte, nCounter )

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

@@ -32,7 +32,7 @@ FUNCTION FT_BYTEXOR( cByte1, cByte2 )
LOCAL nCounter, cNewByte
IF HB_ISSTRING( cByte1 ) .AND. HB_ISSTRING( cByte2 )
cNewByte := Chr( 0 )
cNewByte := hb_BChar( 0 )
FOR nCounter := 0 TO 7 // test each bit position
IF FT_ISBIT( cByte1, nCounter ) .OR. FT_ISBIT( cByte2, nCounter )
IF ! ( FT_ISBIT( cByte1, nCounter ) .AND. FT_ISBIT( cByte2, nCounter ) )

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

@@ -105,9 +105,9 @@ FUNCTION FT_FLOPTST( ; // error code defined by ERR_*
#define BITS_6AND7 192 // value of byte when bits 6&7 are high
STATIC FUNCTION _GetDisketteNum( ; // returns false if no floppy drive installed or nDrive_i is invalid
nDrive_i ; // drive number to query status
)
// returns false if no floppy drive installed or nDrive_i is invalid
STATIC FUNCTION _GetDisketteNum( nDrive_i ) // drive number to query status
LOCAL aRegs[ INT86_MAX_REGS ]
LOCAL lRetCode
LOCAL nByte
@@ -121,7 +121,7 @@ STATIC FUNCTION _GetDisketteNum( ; // returns false if no floppy drive
// bit 0 indicates floppy drive installed
IF Int( nByte / 2 ) * 2 != nByte // is it odd i.e. is bit 0 set??
// bits 6 & 7 indicate number of floppies installed upto 4.
nDriveCount := Asc( FT_BYTEAND( Chr( nByte ), Chr( BITS_6AND7 ) ) )
nDriveCount := hb_BCode( FT_BYTEAND( hb_BChar( nByte ), hb_BChar( BITS_6AND7 ) ) )
IF nDriveCount >= nDrive_i
lRetCode := .T.
ENDIF

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

@@ -32,7 +32,7 @@ FUNCTION FT_ISBIT( cInbyte, nBitPos )
IF nBitPos > 7 .OR. nBitPos < 0 .OR. nBitPos != Int( nBitPos )
lBitStat := NIL
ELSE
lBitStat := Int( ( ( Asc( cInByte ) * ( 2 ^ ( 7 - nBitPos ) ) ) % 256 ) / 128 ) == 1
lBitStat := Int( ( ( hb_BCode( cInByte ) * ( 2 ^ ( 7 - nBitPos ) ) ) % 256 ) / 128 ) == 1
ENDIF
ELSE
lBitStat := NIL

61
harbour/contrib/hbnf/pchr.prg
View File

@@ -74,63 +74,64 @@ FUNCTION FT_PCHR( c_nums )
DO CASE
CASE LEFTEQUAL( c_upper, "/GRAPHIC" )
c_ret += Chr( 27 ) + Chr( 116 ) + Chr( 1 )
c_ret += hb_BChar( 27 ) + hb_BChar( 116 ) + hb_BChar( 1 )
CASE LEFTEQUAL( c_upper, "/ITALIC" )
c_ret += Chr( 27 ) + Chr( 116 ) + Chr( 0 )
c_ret += hb_BChar( 27 ) + hb_BChar( 116 ) + hb_BChar( 0 )
CASE LEFTEQUAL( c_upper, "/PICTURE" )
c_ret += Chr( 27 ) + Chr( 116 ) + Chr( 1 ) + ;
Chr( 27 ) + Chr( 120 ) + Chr( 1 ) + Chr( 27 ) + Chr( 107 ) + Chr( 1 ) + ;
Chr( 27 ) + Chr( 77 ) + Chr( 27 ) + "U"
c_ret += hb_BChar( 27 ) + hb_BChar( 116 ) + hb_BChar( 1 ) + ;
hb_BChar( 27 ) + hb_BChar( 120 ) + hb_BChar( 1 ) + ;
hb_BChar( 27 ) + hb_BChar( 107 ) + hb_BChar( 1 ) + ;
hb_BChar( 27 ) + hb_BChar( 77 ) + hb_BChar( 27 ) + "U"
CASE LEFTEQUAL( c_upper, "/COND" ) .OR. LEFTEQUAL( c_upper, "/SI" )
c_ret += Chr( 15 )
c_ret += hb_BChar( 15 )
CASE LEFTEQUAL( c_upper, "/ROMAN" )
c_ret += Chr( 27 ) + Chr( 107 ) + Chr( 0 )
c_ret += hb_BChar( 27 ) + hb_BChar( 107 ) + hb_BChar( 0 )
CASE LEFTEQUAL( c_upper, "/SANS" )
c_ret += Chr( 27 ) + Chr( 107 ) + Chr( 1 )
c_ret += hb_BChar( 27 ) + hb_BChar( 107 ) + hb_BChar( 1 )
CASE LEFTEQUAL( c_upper, "/NLQ" )
c_ret += Chr( 27 ) + Chr( 120 ) + Chr( 1 )
c_ret += hb_BChar( 27 ) + hb_BChar( 120 ) + hb_BChar( 1 )
CASE LEFTEQUAL( c_upper, "/DRAFT" )
c_ret += Chr( 27 ) + Chr( 120 ) + Chr( 0 )
c_ret += hb_BChar( 27 ) + hb_BChar( 120 ) + hb_BChar( 0 )
CASE LEFTEQUAL( c_upper, "/ELITE" )
c_ret += Chr( 27 ) + Chr( 77 )
c_ret += hb_BChar( 27 ) + hb_BChar( 77 )
CASE LEFTEQUAL( c_upper, "/PICA" )
c_ret += Chr( 27 ) + Chr( 80 )
c_ret += hb_BChar( 27 ) + hb_BChar( 80 )
CASE LEFTEQUAL( c_upper, "/EMPHOFF" )
c_ret += Chr( 27 ) + Chr( 70 )
c_ret += hb_BChar( 27 ) + hb_BChar( 70 )
CASE LEFTEQUAL( c_upper, "/EMPH" )
c_ret += Chr( 27 ) + Chr( 69 )
c_ret += hb_BChar( 27 ) + hb_BChar( 69 )
CASE LEFTEQUAL( c_upper, "/1/6" )
c_ret += Chr( 27 ) + Chr( 50 )
c_ret += hb_BChar( 27 ) + hb_BChar( 50 )
CASE LEFTEQUAL( c_upper, "/1/8" )
c_ret += Chr( 27 ) + Chr( 48 )
c_ret += hb_BChar( 27 ) + hb_BChar( 48 )
CASE LEFTEQUAL( c_upper, "/SKIPOFF" )
c_ret += Chr( 27 ) + Chr( 79 )
c_ret += hb_BChar( 27 ) + hb_BChar( 79 )
CASE LEFTEQUAL( c_upper, "/SKIP" )
c_ret += Chr( 27 ) + Chr( 78 )
c_ret += hb_BChar( 27 ) + hb_BChar( 78 )
CASE LEFTEQUAL( c_upper, "/FF" ) .OR. LEFTEQUAL( c_upper, "/EJECT" )
c_ret += Chr( 12 )
c_ret += hb_BChar( 12 )
CASE LEFTEQUAL( c_upper, "/INIT" ) .OR. LEFTEQUAL( c_upper, "/RESET" )
c_ret += Chr( 27 ) + Chr( 64 )
c_ret += hb_BChar( 27 ) + hb_BChar( 64 )
CASE LEFTEQUAL( c_upper, "/SPANISH" )
c_ret += Chr( 27 ) + Chr( 82 ) + Chr( 12 )
c_ret += hb_BChar( 27 ) + hb_BChar( 82 ) + hb_BChar( 12 )
CASE LEFTEQUAL( c_upper, "/USA" )
c_ret += Chr( 27 ) + Chr( 82 ) + Chr( 0 )
c_ret += hb_BChar( 27 ) + hb_BChar( 82 ) + hb_BChar( 0 )
CASE LEFTEQUAL( c_upper, "/ONE" )
c_ret += Chr( 27 ) + "U" + Chr( 1 )
c_ret += hb_BChar( 27 ) + "U" + hb_BChar( 1 )
CASE LEFTEQUAL( c_upper, "/TWO" )
c_ret += Chr( 27 ) + "U" + Chr( 0 )
c_ret += hb_BChar( 27 ) + "U" + hb_BChar( 0 )
CASE LEFTEQUAL( c_upper, "/FAST" )
c_ret += Chr( 27 ) + "s" + Chr( 0 )
c_ret += hb_BChar( 27 ) + "s" + hb_BChar( 0 )
CASE LEFTEQUAL( c_upper, "/SLOW" )
c_ret += Chr( 27 ) + "s" + Chr( 1 )
c_ret += hb_BChar( 27 ) + "s" + hb_BChar( 1 )
CASE LEFTEQUAL( c_upper, "/OFF" )
c_ret += Chr( 19 )
c_ret += hb_BChar( 19 )
CASE LEFTEQUAL( c_upper, "/ON" )
c_ret += Chr( 17 )
c_ret += hb_BChar( 17 )
CASE LEFTEQUAL( c_upper, "/BEEP" ) .OR. LEFTEQUAL( c_upper, "/BELL" )
c_ret += Chr( 7 )
c_ret += hb_BChar( 7 )
CASE LEFTEQUAL( c_upper, "/CAN" )
c_ret += Chr( 24 )
c_ret += hb_BChar( 24 )
ENDCASE
ENDIF

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

@@ -55,13 +55,6 @@
#define STD_VARIABLE 6
#define STD_BORDER 7
#define K_DECIM 46
#define K_EQUAL 13
#define K_PLUS 43
#define K_MINUS 45
#define K_MULTIPLY 42
#define K_DIVIDE 47
#define K_ZERO 48
#define B_DOUBLE hb_UTF8ToStr( "╔═╗║╝═╚║ " )
#define B_SINGLE "+-+|+-+| "
@@ -120,7 +113,7 @@ THREAD STATIC aKeys, aWindow, nWinColor, aWinColor, aStdColor
#ifdef FT_TEST
FUNCTION TEST
PROCEDURE Main()
LOCAL nSickHrs := 0
LOCAL nPersHrs := 0
@@ -158,7 +151,7 @@ FUNCTION TEST
SET KEY K_ALT_A // Reset <ALT-A>
RETURN NIL
RETURN
#endif
@@ -233,15 +226,15 @@ FUNCTION FT_Adder()
DO WHILE ! lDone // Input key & test loop
FT_INKEY 0 TO nKey
DO CASE
CASE Upper( Chr( nKey ) ) $ "1234567890."
CASE hb_keyChar( nKey ) $ "1234567890."
_ftProcessNumb( aAdder, nKey )
CASE nKey == K_PLUS // <+> sign
CASE nKey == hb_keyCode( "+" ) // <+> sign
_ftAddSub( aAdder, nKey )
CASE nKey == K_MINUS // <-> sign
CASE nKey == hb_keyCode( "-" ) // <-> sign
_ftAddSub( aAdder, nKey )
CASE nKey == K_MULTIPLY // <*> sign
CASE nKey == hb_keyCode( "*" ) // <*> sign
_ftMultDiv( aAdder, nKey )
CASE nKey == K_DIVIDE // </> sign
CASE nKey == hb_keyCode( "/" ) // </> sign
_ftMultDiv( aAdder, nKey )
CASE nKey == K_RETURN // <RTN> Total or Subtotal
_ftAddTotal( aAdder )
@@ -542,8 +535,8 @@ STATIC FUNCTION _ftProcessNumb( aAdder, nKey )
lClAdder := .F. // Reset the Clear flag
lAddError := .F. // Reset adder error flag
IF nKey == Asc( "." ) // Period (.) decimal point
IF lDecSet // Has decimal already been set
IF nKey == hb_keyCode( "." ) // Period (.) decimal point
IF lDecSet // Has decimal already been set
Tone( 800, 1 )
ELSE
lDecSet := .T.
@@ -551,10 +544,10 @@ STATIC FUNCTION _ftProcessNumb( aAdder, nKey )
ELSE // It must be a number input
lNewNum := .T.
nNum := nKey - 48
IF lDecSet // Decimal set
IF nDecDigit < nMaxDeci // Check how many decimals are allowed
IF lDecSet // Decimal set
IF nDecDigit < nMaxDeci // Check how many decimals are allowed
nDecDigit := ++nDecDigit
nNumTotal := nNumTotal + nNum/ ( 10 ** nDecDigit )
nNumTotal := nNumTotal + nNum / ( 10 ** nDecDigit )
ENDIF
ELSE
nNumTotal := nNumTotal * 10 + nNum
@@ -677,7 +670,7 @@ STATIC FUNCTION _ftAddSub( aAdder, nKey )
nNumTotal := nSavTotal
lNewNum := .T.
ENDIF
IF nKey == K_PLUS // Add
IF nKey == hb_keyCode( "+" ) // Add
nAddMode := 1
IF !lNewNum // They pressed + again to add the same
nNumTotal := nSavSubTot // number without re-entering
@@ -687,7 +680,7 @@ STATIC FUNCTION _ftAddSub( aAdder, nKey )
lNewNum := .F.
nSavSubTot := nNumTotal // Save this number in case they just press + or -
nNumTotal := 0
ELSEIF nKey == K_MINUS // Subtract
ELSEIF nKey == hb_keyCode( "-" ) // Subtract
nAddMode := 2
IF !lNewNum // They pressed + again to add the same
nNumTotal := nSavSubTot // number without re-entering
@@ -726,28 +719,28 @@ STATIC FUNCTION _ftMultDiv( aAdder, nKey )
lDecSet := .F.
nDecDigit := 0
lSubRtn := .F.
// They pressed the + or - key to process the previous total
// They pressed the + or - key to process the previous total
IF _ftRoundIt( nNumTotal, nMaxDeci ) == 0 .AND. _ftRoundIt( nTotal, nMaxDeci ) == 0
nNumTotal := nSavTotal
ENDIF
// Get the first number of the product or division
// Get the first number of the product or division
IF _ftRoundIt( nTotal, nMaxDeci ) == 0
IF nKey == K_MULTIPLY // Setup mode
IF nKey == hb_keyCode( "*" ) // Setup mode
nAddMode := 3
_ftUpdateTrans( aAdder, .F. , nNumTotal )
ELSEIF nKey == K_DIVIDE
ELSEIF nKey == hb_keyCode( "/" )
nAddMode := 4
_ftUpdateTrans( aAdder, .F. , nNumTotal )
ENDIF
nTotal := nNumTotal
nNumTotal := 0
ELSE
IF nKey == K_MULTIPLY // Multiply
IF nKey == hb_keyCode( "*" ) // Multiply
nAddMode := 3
_ftUpdateTrans( aAdder, .F. , nNumTotal )
nTotal := nTotal * nNumTotal
nNumTotal := 0
ELSEIF nKey == K_MULTIPLY // Divide
ELSEIF nKey == hb_keyCode( "/" ) // Divide
nAddMode := 4
_ftUpdateTrans( aAdder, .F. , nNumTotal )
nTotal := _ftDivide( aAdder, nTotal, nNumTotal )
@@ -1416,7 +1409,7 @@ STATIC FUNCTION _ftStuffComma( cStrToStuff, lTrimStuffedStr )
"" $ cStrToStuff .OR. "/" $ cStrToStuff .OR. "=" $ cStrToStuff, ;
Len( cStrToStuff ) - 1, Len( cStrToStuff ) + 1 ) )
IF Asc( cStrToStuff ) == K_SPACE .OR. Asc( cStrToStuff ) == K_ZERO
IF cStrToStuff == " " .OR. cStrToStuff == "0"
cStrToStuff := SubStr( cStrToStuff, 2 )
ENDIF

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

@@ -33,7 +33,7 @@
#ifdef FT_TEST
#define SCANCODE_ESCAPE ( chr( 27 ) + chr( 1 ) )
#define SCANCODE_ESCAPE ( hb_BChar( 27 ) + hb_BChar( 1 ) )
PROCEDURE Main()
@@ -61,4 +61,4 @@ FUNCTION FT_SCANCODE()
aRegs[ AX ] := MAKEHI( 0 )
FT_INT86( KEYB, aRegs )
RETURN Chr( LOWBYTE( aRegs[ AX ] ) ) + Chr( HIGHBYTE( aRegs[ AX ] ) )
RETURN hb_BChar( LOWBYTE( aRegs[ AX ] ) ) + hb_BChar( HIGHBYTE( aRegs[ AX ] ) )