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

2012-10-14 15:09 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/gtwvg/class.prg
    * changed GET to Get():New()
    % minor optimization to GET handling
    ; Check me I'm unsure how to test this part

  * contrib/hbnf/pegs.prg
    * changed GETs to Get():New()
    ! replaced GetList memvar with a LOCAL
    ; TOFIX?: It seems to offer wrong move suggestions in some cases

  + contrib/hbnf/tests/pegs.prg
    + added test app for FT_PEGS()

  * contrib/hbnf/tests/menu1.prg
    ! fixed to use RETURN (not QUIT) at the end of Main()

  * tests/setkeys.prg
    ! unicode keyboard handling fixes
    * use ?/?? instead of [Q]QOUT()

  * utils/hbmk2/hbmk2.prg
    % minor GetList related optimization in shell prompt

  * contrib/gtwvg/tests/demowvg.prg
    + SET CENTURY ON
This commit is contained in:
Viktor Szakats
2012-10-14 13:17:34 +00:00
parent 9c4bfed351
commit 3b076c9ff8
8 changed files with 91 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
harbour/ChangeLog
View File

@@ -16,6 +16,33 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-10-14 15:09 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/gtwvg/class.prg
* changed GET to Get():New()
% minor optimization to GET handling
; Check me I'm unsure how to test this part
* contrib/hbnf/pegs.prg
* changed GETs to Get():New()
! replaced GetList memvar with a LOCAL
; TOFIX?: It seems to offer wrong move suggestions in some cases
+ contrib/hbnf/tests/pegs.prg
+ added test app for FT_PEGS()
* contrib/hbnf/tests/menu1.prg
! fixed to use RETURN (not QUIT) at the end of Main()
* tests/setkeys.prg
! unicode keyboard handling fixes
* use ?/?? instead of [Q]QOUT()
* utils/hbmk2/hbmk2.prg
% minor GetList related optimization in shell prompt
* contrib/gtwvg/tests/demowvg.prg
+ SET CENTURY ON
2012-10-13 20:38 UTC+0200 Viktor Szakats (harbour syenar.net)
* src/rtl/setfunc.prg
* src/rtl/tlabel.prg

7
harbour/contrib/gtwvg/class.prg
View File

@@ -2290,20 +2290,17 @@ METHOD WvtGets:New( oParent, nID, nTop, nLeft, nBottom, nRight )
METHOD WvtGets:Create()
LOCAL i, GetList
LOCAL i
LOCAL nCurRow := Row()
LOCAL nCurCol := Col()
FOR i := 1 TO Len( ::aGetList )
GetList := {}
__defaultNIL( @::aGetList[ i,7 ], "N/W*,N/W*,,,N/GR*" )
__defaultNIL( @::aGetList[ i,5 ], {|| .T. } )
__defaultNIL( @::aGetList[ i,6 ], {|| .T. } )
@ ::aGetList[ i,1 ], ::aGetList[ i,2 ] GET ::aGetList[ i,3 ] PICTURE ::aGetList[ i,4 ] COLOR ::aGetList[ i,7 ]
AAdd( ::GetList, GetList[ 1 ] )
AAdd( ::GetList, Get():New( ::aGetList[ i,1 ], ::aGetList[ i,2 ], {| v | iif( PCount() == 0, ::aGetList[ i,3 ], ::aGetList[ i,3 ] := v ) }, "::aGetList[ i, 3 ]", ::aGetList[ i,7 ] ) )
::GetList[ i ]:Display()
::PaintBlock( i )

1
harbour/contrib/gtwvg/tests/demowvg.prg
View File

@@ -106,6 +106,7 @@ PROCEDURE Main()
LOCAL oError := ErrorBlock( {| o | MyError( o ) } )
SET DATE ANSI
SET CENTURY ON
Set( _SET_EVENTMASK, INKEY_ALL + HB_INKEY_GTEVENT )

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

@@ -35,7 +35,6 @@
hb_DispBox( <top>, <left>, <bottom>, <right>, hb_UTF8ToStrBox( "┌─┐│┘─└│ " ) )
#translate DOUBLEBOX( <top>, <left>, <bottom>, <right> ) => ;
hb_DispBox( <top>, <left>, <bottom>, <right>, hb_UTF8ToStrBox( "╔═╗║╝═╚║ " ) )
MEMVAR GetList
/*
here's the board array -- structure of which is:
@@ -46,26 +45,26 @@ MEMVAR GetList
*/
THREAD STATIC t_board_ := {;
{ { 0, 29, 2, 34 }, { 2, 4 }, { 3, 9 }, .T. } , ;
{ { 0, 37, 2, 42 }, { 5 }, { 10 }, .T. } , ;
{ { 0, 45, 2, 50 }, { 2, 6 }, { 1, 11 }, .T. } , ;
{ { 3, 29, 5, 34 }, { 5, 9 }, { 6, 16 }, .T. } , ;
{ { 3, 37, 5, 42 }, { 10 }, { 17 }, .T. } , ;
{ { 3, 45, 5, 50 }, { 5, 11 }, { 4, 18 }, .T. } , ;
{ { 6, 13, 8, 18 }, { 8, 14 }, { 9, 21 }, .T. } , ;
{ { 6, 21, 8, 26 }, { 9, 15 }, { 10, 22 }, .T. } , ;
{ { 6, 29, 8, 34 }, { 4, 8, 10, 16 }, { 1, 7, 11, 23 }, .T. } , ;
{ { 6, 37, 8, 42 }, { 5, 9, 11, 17 }, { 2, 8, 12, 24 }, .T. } , ;
{ { 6, 45, 8, 50 }, { 6, 10, 12, 18 }, { 3, 9, 13, 25 }, .T. } , ;
{ { 6, 53, 8, 58 }, { 11, 19 }, { 10, 26 }, .T. } , ;
{ { 6, 61, 8, 66 }, { 12, 20 }, { 11, 27 }, .T. } , ;
{ { 9, 13, 11, 18 }, { 15 }, { 16 }, .T. } , ;
{ { 9, 21, 11, 26 }, { 16 }, { 17 }, .T. } , ;
{ { 9, 29, 11, 34 }, { 9, 15, 17, 23 }, { 4, 14, 18, 28 }, .T. } , ;
{ { 9, 37, 11, 42 }, { 10, 16, 18, 24 }, { 5, 15, 19, 29 }, .F. } , ;
{ { 9, 45, 11, 50 }, { 11, 17, 19, 25 }, { 6, 16, 20, 30 }, .T. } , ;
{ { 9, 53, 11, 58 }, { 18 }, { 17 }, .T. } , ;
{ { 9, 61, 11, 66 }, { 19 }, { 18 }, .T. } , ;
{ { 0, 29, 2, 34 }, { 2, 4 }, { 3, 9 }, .T. } , ;
{ { 0, 37, 2, 42 }, { 5 }, { 10 }, .T. } , ;
{ { 0, 45, 2, 50 }, { 2, 6 }, { 1, 11 }, .T. } , ;
{ { 3, 29, 5, 34 }, { 5, 9 }, { 6, 16 }, .T. } , ;
{ { 3, 37, 5, 42 }, { 10 }, { 17 }, .T. } , ;
{ { 3, 45, 5, 50 }, { 5, 11 }, { 4, 18 }, .T. } , ;
{ { 6, 13, 8, 18 }, { 8, 14 }, { 9, 21 }, .T. } , ;
{ { 6, 21, 8, 26 }, { 9, 15 }, { 10, 22 }, .T. } , ;
{ { 6, 29, 8, 34 }, { 4, 8, 10, 16 }, { 1, 7, 11, 23 }, .T. } , ;
{ { 6, 37, 8, 42 }, { 5, 9, 11, 17 }, { 2, 8, 12, 24 }, .T. } , ;
{ { 6, 45, 8, 50 }, { 6, 10, 12, 18 }, { 3, 9, 13, 25 }, .T. } , ;
{ { 6, 53, 8, 58 }, { 11, 19 }, { 10, 26 }, .T. } , ;
{ { 6, 61, 8, 66 }, { 12, 20 }, { 11, 27 }, .T. } , ;
{ { 9, 13, 11, 18 }, { 15 }, { 16 }, .T. } , ;
{ { 9, 21, 11, 26 }, { 16 }, { 17 }, .T. } , ;
{ { 9, 29, 11, 34 }, { 9, 15, 17, 23 }, { 4, 14, 18, 28 }, .T. } , ;
{ { 9, 37, 11, 42 }, { 10, 16, 18, 24 }, { 5, 15, 19, 29 }, .F. } , ;
{ { 9, 45, 11, 50 }, { 11, 17, 19, 25 }, { 6, 16, 20, 30 }, .T. } , ;
{ { 9, 53, 11, 58 }, { 18 }, { 17 }, .T. } , ;
{ { 9, 61, 11, 66 }, { 19 }, { 18 }, .T. } , ;
{ { 12, 13, 14, 18 }, { 14, 22 }, { 7, 23 }, .T. } , ;
{ { 12, 21, 14, 26 }, { 15, 23 }, { 8, 24 }, .T. } , ;
{ { 12, 29, 14, 34 }, { 16, 22, 24, 28 }, { 9, 21, 25, 31 }, .T. } , ;
@@ -85,10 +84,12 @@ FUNCTION FT_PEGS()
LOCAL XX, MOVE, MPOS, POSSIBLE_, BUFFER, TOPROW, OLDSCORE, MOVE2
LOCAL SCANBLOCK, OLDCOLOR := SetColor( "w/n" )
LOCAL oldscrn := SaveScreen( 0, 0, MaxRow(), MaxCol() )
/*
the following code block is used in conjunction with ASCAN()
to validate entry when there is more than one possible move
*/
LOCAL GetList
/*
the following code block is used in conjunction with ASCAN()
to validate entry when there is more than one possible move
*/
scanblock := {| a | a[ 2 ] == move2 }
CLS
@@ -98,9 +99,13 @@ FUNCTION FT_PEGS()
AEval( t_board_, {| a, x | HB_SYMBOL_UNUSED( a ), drawbox( x ) } )
DO WHILE LastKey() != K_ESC .AND. moremoves()
move := 1
SetColor( "w/n" )
@ 23, 44 GET move PICTURE "##" RANGE 1, 33
GetList := { Get():New( 23, 44, {| v | iif( PCount() == 0, move, move := v ) }, "move", "##" ) }
ATail( GetList ):postBlock := {| oGet | RangeCheck( oGet, , 1, 33 ) }
ATail( GetList ):display()
READ
IF move > 0
DO CASE
CASE ! t_board_[ move ][ 4 ]
@@ -109,7 +114,7 @@ FUNCTION FT_PEGS()
possible_ := {}
FOR xx := 1 TO Len( t_board_[ move ][ 2 ] )
IF t_board_[ t_board_[ move ][ 2, xx ] ][ 4 ] .AND. ;
! t_board_[ t_board_[ move ][ 3, xx ] ][ 4 ]
! t_board_[ t_board_[ move ][ 3, xx ] ][ 4 ]
AAdd( possible_, { t_board_[ move ][ 2, xx ], t_board_[ move ][ 3, xx ] } )
ENDIF
NEXT
@@ -134,9 +139,12 @@ FUNCTION FT_PEGS()
SetPos( toprow, 65 )
AEval( possible_, {| a | hb_DispOutAt( Row() + 1, 65, Transform( a[ 2 ], "##" ) ) } )
oldscore := Set( _SET_SCOREBOARD, .F. )
@ 23, 44 GET move2 PICTURE "##" ;
VALID AScan( possible_, scanblock ) > 0
GetList := { Get():New( 23, 44, {| v | iif( PCount() == 0, move2, move2 := v ) }, "move2", "##" ) }
ATail( GetList ):postBlock := {|| AScan( possible_, scanblock ) > 0 }
ATail( GetList ):display()
READ
RestScreen( toprow, 55, 22, 74, buffer )
Set( _SET_SCOREBOARD, oldscore )
mpos := AScan( possible_, {| a | move2 == a[ 2 ] } )
@@ -196,9 +204,9 @@ STATIC FUNCTION moremoves()
FOR xx := 1 TO 33
FOR yy := 1 TO Len( t_board_[ xx ][ 2 ] )
IF t_board_[ xx ][ 4 ] .AND. ; // if current location is filled
t_board_[ t_board_[ xx ][ 2, yy ] ][ 4 ] .AND. ; // adjacent must be filled
! t_board_[ t_board_[ xx ][ 3, yy ] ][ 4 ] // target must be empty
IF t_board_[ xx ][ 4 ] .AND. ; // if current location is filled
t_board_[ t_board_[ xx ][ 2, yy ] ][ 4 ] .AND. ; // adjacent must be filled
! t_board_[ t_board_[ xx ][ 3, yy ] ][ 4 ] // target must be empty
canmove := .T.
EXIT
ENDIF

3
harbour/contrib/hbnf/tests/menu1.prg
View File

@@ -119,7 +119,8 @@ PROCEDURE Main( cCmdLine )
ENDIF
RESTORE SCREEN FROM sDosScrn
SetPos( nDosRow, nDosCol )
QUIT
RETURN
FUNCTION fubar()

11
harbour/contrib/hbnf/tests/pegs.prg Normal file
View File

@@ -0,0 +1,11 @@
/*
* $Id$
*/
#require "hbnf"
PROCEDURE Main()
FT_PEGS()
RETURN

26
harbour/tests/setkeys.prg
View File

@@ -48,10 +48,7 @@
* 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.
V 1.0 April White Initial version
V 1.1 April White Add a Help() function to test default F1
*/
*/
#include "inkey.ch"
@@ -76,17 +73,8 @@ PROCEDURE Main()
@ 11, 10 GET bravo
@ 12, 10 GET charlie
#ifndef K_F10
#define K_F10 -9
#define K_F9 -8
#define K_F8 -7
#define K_ESC 27
#endif
SetKey( K_F10, {|| Alert( Transform( GetActive():varGet(), NIL ) ) }, ;
{|| !Empty( GetActive():VarGet() ) } ) /* :buffer */
{|| ! Empty( GetActive():VarGet() ) } ) /* :buffer */
SetKey( K_F9 , {|| k := hb_SetKeySave( NIL ), ;
SetKey( K_F9, {|| hb_SetKeySave( k ) } ) } )
SetKey( K_F8 , {|| SubMain() }, {|| F8Active } )
@@ -105,15 +93,15 @@ STATIC PROCEDURE SubMain()
bF8Action := hb_SetKeyGet( K_F8, @bF8Active )
SetKey( K_F8, NIL )
hb_SetKeyArray( { 49, 50, 52, 53 }, {| x | QOut( Chr( x ) ) } )
hb_SetKeyArray( { 49, 50, 52, 53 }, {| x | QOut( hb_keyChar( x ) ) } )
DO WHILE ( n := Inkey( 0 ) ) != K_ESC
IF hb_SetKeyCheck( n, ProcName(), ProcLine(), ReadVar() )
QQOut( " hit hot" )
?? " hit hot"
ELSE
QOut( Chr( n ) )
QQOut( " hit cold" )
? hb_keyChar( n )
?? " hit cold"
ENDIF
end
ENDDO
hb_SetKeyArray( { 49, 50, 52, 53 }, NIL )
SetKey( K_F8, bF8Action, bF8Active )

4
harbour/utils/hbmk2/hbmk2.prg
View File

@@ -12877,7 +12877,6 @@ STATIC PROCEDURE __hbshell_prompt( aParams, aCommand )
hb_Scroll()
Set( _SET_SCOREBOARD, .F. )
GetList := {}
__hbshell_HistoryLoad()
@@ -12923,7 +12922,7 @@ STATIC PROCEDURE __hbshell_prompt( aParams, aCommand )
hb_DispOutAt( nMaxRow, 0, cPrompt := cDomain + "." )
AAdd( GetList, Get():New( nMaxRow, Len( cPrompt ), {| v | iif( PCount() == 0, cLine, cLine := v ) }, "cLine", "@KS" + hb_ntos( nMaxCol - Len( cPrompt ) + 1 ) ) )
GetList := { Get():New( nMaxRow, Len( cPrompt ), {| v | iif( PCount() == 0, cLine, cLine := v ) }, "cLine", "@KS" + hb_ntos( nMaxCol - Len( cPrompt ) + 1 ) ) }
ATail( GetList ):display()
SetCursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) )
@@ -12942,7 +12941,6 @@ STATIC PROCEDURE __hbshell_prompt( aParams, aCommand )
{|| lResize := .T., hb_KeyPut( K_ENTER ) } )
ReadModal( GetList )
GetList := {}
SetKey( K_DOWN, bKeyDown )
SetKey( K_UP, bKeyUp )