diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 0ed7bfb82a..f64637440c 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -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 diff --git a/harbour/contrib/gtwvg/class.prg b/harbour/contrib/gtwvg/class.prg index ff3c446888..d23706ce07 100644 --- a/harbour/contrib/gtwvg/class.prg +++ b/harbour/contrib/gtwvg/class.prg @@ -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 ) diff --git a/harbour/contrib/gtwvg/tests/demowvg.prg b/harbour/contrib/gtwvg/tests/demowvg.prg index 9653a86f53..6d2da4d5cc 100644 --- a/harbour/contrib/gtwvg/tests/demowvg.prg +++ b/harbour/contrib/gtwvg/tests/demowvg.prg @@ -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 ) diff --git a/harbour/contrib/hbnf/pegs.prg b/harbour/contrib/hbnf/pegs.prg index 72dc6ee2f4..84a351edd2 100644 --- a/harbour/contrib/hbnf/pegs.prg +++ b/harbour/contrib/hbnf/pegs.prg @@ -35,7 +35,6 @@ hb_DispBox( , , , , hb_UTF8ToStrBox( "┌─┐│┘─└│ " ) ) #translate DOUBLEBOX( , , , ) => ; hb_DispBox( , , , , 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 diff --git a/harbour/contrib/hbnf/tests/menu1.prg b/harbour/contrib/hbnf/tests/menu1.prg index f5b70b2431..f776fb0f93 100644 --- a/harbour/contrib/hbnf/tests/menu1.prg +++ b/harbour/contrib/hbnf/tests/menu1.prg @@ -119,7 +119,8 @@ PROCEDURE Main( cCmdLine ) ENDIF RESTORE SCREEN FROM sDosScrn SetPos( nDosRow, nDosCol ) - QUIT + + RETURN FUNCTION fubar() diff --git a/harbour/contrib/hbnf/tests/pegs.prg b/harbour/contrib/hbnf/tests/pegs.prg new file mode 100644 index 0000000000..83216c51f0 --- /dev/null +++ b/harbour/contrib/hbnf/tests/pegs.prg @@ -0,0 +1,11 @@ +/* + * $Id$ + */ + +#require "hbnf" + +PROCEDURE Main() + + FT_PEGS() + + RETURN diff --git a/harbour/tests/setkeys.prg b/harbour/tests/setkeys.prg index e0cd2307af..3d9a244e8d 100644 --- a/harbour/tests/setkeys.prg +++ b/harbour/tests/setkeys.prg @@ -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 ) diff --git a/harbour/utils/hbmk2/hbmk2.prg b/harbour/utils/hbmk2/hbmk2.prg index 2ffc93e0b6..704e04567c 100644 --- a/harbour/utils/hbmk2/hbmk2.prg +++ b/harbour/utils/hbmk2/hbmk2.prg @@ -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 )