From 05aaa87103421eca2c063320838e3f6c3a73fea1 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 5 Aug 1999 03:01:15 +0000 Subject: [PATCH] *** empty log message *** --- harbour/ChangeLog | 6 + harbour/source/rtl/achoice.prg | 847 +++++++++++++++------------------ harbour/source/rtl/console.c | 24 +- harbour/tests/working/Makefile | 21 + 4 files changed, 420 insertions(+), 478 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 3d7a020dfc..16817d50b7 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,9 @@ +19990805-04:47 GMT+1 Victor Szel + * source/rtl/console.c - Small var naming change. + * source/rtl/achoice.prg + ! Fixed: SET DEVICE is no longer redirecting it's output. + % Optimialized color handling. (Thanks to Paul Tucker) + 19990804-14:30 EDT Paul Tucker * source/rtl/filesys.c * added a cast (reported by Matteo) diff --git a/harbour/source/rtl/achoice.prg b/harbour/source/rtl/achoice.prg index ab83b0c962..3f4a43b5f3 100644 --- a/harbour/source/rtl/achoice.prg +++ b/harbour/source/rtl/achoice.prg @@ -95,534 +95,449 @@ * $END$ */ -*+-------------------------------------------------------------------- -*+ -*+ Function achoice() -*+ -*+-------------------------------------------------------------------- -*+ - function achoice( nTop, nLft, nBtm, nRyt, acItems, xSelect, xUserFunc, nPos, nHiLytRow ) -local nNumCols := 0 // Number of columns in the window -local nNumRows := 0 // Number of rows in the window -local acCopy := {} // A padded copy of the items -local alSelect := {} // Select permission -local nNewPos := 0 // The next item to be selected -local lFinished := .F. // Is processing finished? -local nKey := 0 // The keystroke to be processed -local nMode := AC_IDLE // The current operating mode -local nAtTop := 1 // The number of the item at the top -local nAtBtm := 1 // The number of the item at the bottom -local nItems := 0 // The number of items -local nGap := 0 // The number of lines between top and current lines - // Block used to search for items -local bScan := { | cX | if( left( cX, 1 ) == upper( chr( nKey ) ), .T., .F. ) } -local lUserFunc // Is a user function to be used? -local nUserFunc := 0 // Return value from user function -local cLoClr := __COLORINDEX( setcolor(), CLR_STANDARD ) -local cHiClr := __COLORINDEX( setcolor(), CLR_ENHANCED ) -local cUnClr := __COLORINDEX( setcolor(), CLR_UNSELECTED ) -local nSaveCsr := setcursor( SC_NONE ) -local nFrstItem := 0 -local nLastItem := 0 -local nCntr + local nNumCols := 0 // Number of columns in the window + local nNumRows := 0 // Number of rows in the window + local acCopy := {} // A padded copy of the items + local alSelect := {} // Select permission + local nNewPos := 0 // The next item to be selected + local lFinished := .F. // Is processing finished? + local nKey := 0 // The keystroke to be processed + local nMode := AC_IDLE // The current operating mode + local nAtTop := 1 // The number of the item at the top + local nAtBtm := 1 // The number of the item at the bottom + local nItems := 0 // The number of items + local nGap := 0 // The number of lines between top and current lines + // Block used to search for items + local bScan := { | cX | if( left( cX, 1 ) == upper( chr( nKey ) ), .T., .F. ) } + local lUserFunc // Is a user function to be used? + local nUserFunc := 0 // Return value from user function + local nSaveCsr := setcursor( SC_NONE ) + local nFrstItem := 0 + local nLastItem := 0 + local nCntr -lUserFunc := !empty( xUserFunc ) .AND. ValType( xUserFunc ) $ "CB" + ColorSelect( CLR_STANDARD ) -IF empty( cHiClr ) - cHiClr := After( "/", cLoClr ) + "/" + Before( "/", cLoClr ) -endif + lUserFunc := !empty( xUserFunc ) .AND. ValType( xUserFunc ) $ "CB" -IF empty( cUnClr ) - cUnClr := cLoClr -endif + DEFAULT nTop to 0 // The topmost row of the window + DEFAULT nLft to 0 // The leftmost column of the window + DEFAULT nBtm to maxrow() + 1 // The bottommost row of the windows + DEFAULT nRyt to maxcol() + 1 // The rightmost column of the window + DEFAULT acItems to {} // The items from which to choose + DEFAULT xSelect to .T. // Array or logical, what is selectable + DEFAULT nPos to 1 // The number of the selected item + DEFAULT nHiLytRow to 0 // The row to be highlighted -DEFAULT nTop to 0 // The topmost row of the window -DEFAULT nLft to 0 // The leftmost column of the window -DEFAULT nBtm to maxrow() + 1 // The bottommost row of the windows -DEFAULT nRyt to maxcol() + 1 // The rightmost column of the window -DEFAULT acItems to {} // The items from which to choose -DEFAULT xSelect to .T. // Array or logical, what is selectable -DEFAULT nPos to 1 // The number of the selected item -DEFAULT nHiLytRow to 0 // The row to be highlighted + nNumCols := nRyt - nLft + 1 + nNumRows := nBtm - nTop + 1 + aeval( acItems, { | x, n | if( valtype( x ) == "C", aadd( acCopy, padr( x, nNumCols ) ), .F. ) } ) + nItems := len( acCopy ) -nNumCols := nRyt - nLft + 1 -nNumRows := nBtm - nTop + 1 -aeval( acItems, { | x, n | if( valtype( x ) == "C", aadd( acCopy, padr( x, nNumCols ) ), .F. ) } ) -nItems := len( acCopy ) - -alSelect := array( nItems ) -IF valtype( xSelect ) == "A" - afill( alSelect, .T. ) - for nCntr := 1 to len( xSelect ) - IF nCntr <= nItems - IF valtype( xSelect[ nCntr ] ) == "C" - IF empty( xSelect[ nCntr ] ) - lFinished := .T. - nPos := 0 - else + alSelect := array( nItems ) + IF valtype( xSelect ) == "A" + afill( alSelect, .T. ) + for nCntr := 1 to len( xSelect ) + IF nCntr <= nItems + IF valtype( xSelect[ nCntr ] ) == "C" + IF empty( xSelect[ nCntr ] ) + lFinished := .T. + nPos := 0 + else /* TODO: When macro evaluation will work, this should be commented out: alSelect[ nCntr ] := &( xSelect[ nCntr ] ) */ + endif + else + alSelect[ nCntr ] := xSelect[ nCntr ] endif else - alSelect[ nCntr ] := xSelect[ nCntr ] + nCntr := len( xSelect ) + 1 endif - else - nCntr := len( xSelect ) + 1 - endif - next -else - afill( alSelect, xSelect ) -endif - -IF !lFinished - - nFrstItem := ascan( alSelect, .T. ) // First valid item - - IF nFrstItem == 0 - nLastItem := 0 - nPos := 0 - nMode := AC_NOITEM + next else - nMode := AC_IDLE - nLastItem := nItems // Last valid item - do while ( !alSelect[ nLastItem ] ) - nLastItem -- - enddo + afill( alSelect, xSelect ) endif - // Ensure hilighted item can be selected - nPos := Between( nFrstItem, nPos, nLastItem ) + IF !lFinished - // Force hilighted row to be valid - nHiLytRow := Between( 0, nHiLytRow, nNumRows - 1 ) + nFrstItem := ascan( alSelect, .T. ) // First valid item - // Force the topmost item to be a valid index of the array - nAtTop := Between( 1, max( 1, nPos - nHiLytRow ), nItems ) - - // Ensure as much of the selection area as possible is covered - if ( nAtTop + nNumRows - 1 ) > nItems - nAtTop := max( 1, nItems - nNumrows + 1 ) - endif - - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - -endif - -do while ( !lFinished ) - - IF nMode != AC_GOTO .and. nMode != AC_NOITEM - nKey := Inkey( 0 ) - nMode := AC_IDLE - endif - - do case - case ( ( nKey == K_ESC ) .or. ( nMode == AC_NOITEM ) ) .and. ( !lUserFunc ) - nMode := AC_ABORT - nPos := 0 - lFinished := .T. - - case nKey == K_UP - IF nPos == nFrstItem - nMode := AC_HITTOP - IF nAtTop > max( 1, nPos - nNumRows + 1 ) - nAtTop := max( 1, nPos - nNumRows + 1 ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - endif + IF nFrstItem == 0 + nLastItem := 0 + nPos := 0 + nMode := AC_NOITEM else - nNewPos := nPos - 1 - do while !alSelect[ nNewPos ] - nNewPos -- + nMode := AC_IDLE + nLastItem := nItems // Last valid item + do while ( !alSelect[ nLastItem ] ) + nLastItem -- enddo - IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr ) - nPos := nNewPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr ) - else - dispbegin() - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr ) - scroll( nTop, nLft, nBtm, nRyt, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) ) - nAtTop := nNewPos - nPos := max( nPos, nAtTop + nNumRows - 1 ) - do while nPos > nNewPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr ) - nPos -- - enddo - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr ) - dispend() - endif endif - case nKey == K_DOWN - * Find the next selectable item to display - IF nPos == nLastItem - nMode := AC_HITBOTTOM - IF nAtTop < min( nPos, nItems - nNumRows + 1 ) - nAtTop := min( nPos, nItems - nNumRows + 1 ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - endif - else + // Ensure hilighted item can be selected + nPos := Between( nFrstItem, nPos, nLastItem ) - nNewPos := nPos + 1 + // Force hilighted row to be valid + nHiLytRow := Between( 0, nHiLytRow, nNumRows - 1 ) - do while !alSelect[ nNewPos ] - nNewPos ++ - enddo - - IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr ) - nPos := nNewPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr ) - else - dispbegin() - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr ) - scroll( nTop, nLft, nBtm, nRyt, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) ) - nAtTop := nNewPos - nNumRows + 1 - nPos := max( nPos, nAtTop ) - do while nPos < nNewPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr ) - nPos ++ - enddo - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr ) - dispend() - endif + // Force the topmost item to be a valid index of the array + nAtTop := Between( 1, max( 1, nPos - nHiLytRow ), nItems ) + // Ensure as much of the selection area as possible is covered + if ( nAtTop + nNumRows - 1 ) > nItems + nAtTop := max( 1, nItems - nNumrows + 1 ) endif - case ( ( nKey == K_HOME ) .or. ( nKey == K_CTRL_PGUP ) ) .and. ( !lUserFunc ) - IF nPos == nFrstItem - IF nAtTop == max( 1, nPos - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + + endif + + do while ( !lFinished ) + + IF nMode != AC_GOTO .and. nMode != AC_NOITEM + nKey := Inkey( 0 ) + nMode := AC_IDLE + endif + + do case + case ( ( nKey == K_ESC ) .or. ( nMode == AC_NOITEM ) ) .and. ( !lUserFunc ) + nMode := AC_ABORT + nPos := 0 + lFinished := .T. + + case nKey == K_UP + IF nPos == nFrstItem nMode := AC_HITTOP + IF nAtTop > max( 1, nPos - nNumRows + 1 ) + nAtTop := max( 1, nPos - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif else - nAtTop := max( 1, nPos - nNumRows + 1 ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - endif - else - nPos := nFrstItem - nAtTop := nPos - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - endif - - case ( ( nKey == K_END ) .or. ( nKey == K_CTRL_PGDN ) ) .and. ( !lUserFunc ) - IF nPos == nLastItem - IF nAtTop == min( nLastItem, nItems - nNumRows + 1 ) - nMode := AC_HITBOTTOM - else - nAtTop := min( nLastItem, nItems - nNumRows + 1 ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - endif - else - IF InRange( nAtTop, nLastItem, nAtTop + nNumRows - 1 ) - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr ) - nPos := nLastItem - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr ) - else - nPos := nLastItem - nAtTop := max( 1, nPos - nNumRows + 1 ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - endif - endif - - case nKey == K_CTRL_HOME - IF nPos == nFrstItem - IF nAtTop == max( 1, nPos - nNumRows + 1 ) - nMode := AC_HITTOP - else - nAtTop := max( 1, nPos - nNumRows + 1 ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - endif - else - nNewPos := nAtTop - do while !alSelect[ nNewPos ] - nNewPos ++ - enddo - IF nNewPos != nPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr ) - nPos := nNewPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr ) - endif - endif - - case nKey == K_CTRL_END - IF nPos == nLastItem - IF nAtTop == min( nPos, nItems - nNumRows + 1 ) - nMode := AC_HITBOTTOM - else - nAtTop := min( nPos, nItems - nNumRows + 1 ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - endif - else - nNewPos := nAtTop + nNumRows - 1 - do while !alSelect[ nNewPos ] - nNewPos -- - enddo - IF nNewPos != nPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr ) - nPos := nNewPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr ) - endif - endif - - case nKey == K_PGUP - IF nPos == nFrstItem - nMode := AC_HITTOP - IF nAtTop > max( 1, nPos - nNumRows + 1 ) - nAtTop := max( 1, nPos - nNumRows + 1 ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - endif - else - IF InRange( nAtTop, nFrstItem, nAtTop + nNumRows - 1 ) - * On same page as nFrstItem - nPos := nFrstItem - nAtTop := max( nPos - nNumRows + 1, 1 ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - else - if ( nPos - nNumRows + 1 ) < nFrstItem - nPos := nFrstItem - nAtTop := nFrstItem + nNewPos := nPos - 1 + do while !alSelect[ nNewPos ] + nNewPos -- + enddo + IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + nPos := nNewPos + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) else - nPos := max( nFrstItem, nPos - nNumRows + 1 ) - nAtTop := max( 1, nAtTop - nNumRows + 1 ) - do while ( nPos > nFrstItem ) .and. ( !alSelect[ nPos ] ) + dispbegin() + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + scroll( nTop, nLft, nBtm, nRyt, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) ) + nAtTop := nNewPos + nPos := max( nPos, nAtTop + nNumRows - 1 ) + do while nPos > nNewPos + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) nPos -- + enddo + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) + dispend() + endif + endif + + case nKey == K_DOWN + * Find the next selectable item to display + IF nPos == nLastItem + nMode := AC_HITBOTTOM + IF nAtTop < min( nPos, nItems - nNumRows + 1 ) + nAtTop := min( nPos, nItems - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif + else + + nNewPos := nPos + 1 + + do while !alSelect[ nNewPos ] + nNewPos ++ + enddo + + IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + nPos := nNewPos + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) + else + dispbegin() + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + scroll( nTop, nLft, nBtm, nRyt, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) ) + nAtTop := nNewPos - nNumRows + 1 + nPos := max( nPos, nAtTop ) + do while nPos < nNewPos + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + nPos ++ + enddo + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) + dispend() + endif + + endif + + case ( ( nKey == K_HOME ) .or. ( nKey == K_CTRL_PGUP ) ) .and. ( !lUserFunc ) + IF nPos == nFrstItem + IF nAtTop == max( 1, nPos - nNumRows + 1 ) + nMode := AC_HITTOP + else + nAtTop := max( 1, nPos - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif + else + nPos := nFrstItem + nAtTop := nPos + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif + + case ( ( nKey == K_END ) .or. ( nKey == K_CTRL_PGDN ) ) .and. ( !lUserFunc ) + IF nPos == nLastItem + IF nAtTop == min( nLastItem, nItems - nNumRows + 1 ) + nMode := AC_HITBOTTOM + else + nAtTop := min( nLastItem, nItems - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif + else + IF InRange( nAtTop, nLastItem, nAtTop + nNumRows - 1 ) + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + nPos := nLastItem + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) + else + nPos := nLastItem + nAtTop := max( 1, nPos - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif + endif + + case nKey == K_CTRL_HOME + IF nPos == nFrstItem + IF nAtTop == max( 1, nPos - nNumRows + 1 ) + nMode := AC_HITTOP + else + nAtTop := max( 1, nPos - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif + else + nNewPos := nAtTop + do while !alSelect[ nNewPos ] + nNewPos ++ + enddo + IF nNewPos != nPos + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + nPos := nNewPos + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) + endif + endif + + case nKey == K_CTRL_END + IF nPos == nLastItem + IF nAtTop == min( nPos, nItems - nNumRows + 1 ) + nMode := AC_HITBOTTOM + else + nAtTop := min( nPos, nItems - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif + else + nNewPos := nAtTop + nNumRows - 1 + do while !alSelect[ nNewPos ] + nNewPos -- + enddo + IF nNewPos != nPos + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + nPos := nNewPos + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) + endif + endif + + case nKey == K_PGUP + IF nPos == nFrstItem + nMode := AC_HITTOP + IF nAtTop > max( 1, nPos - nNumRows + 1 ) + nAtTop := max( 1, nPos - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif + else + IF InRange( nAtTop, nFrstItem, nAtTop + nNumRows - 1 ) + * On same page as nFrstItem + nPos := nFrstItem + nAtTop := max( nPos - nNumRows + 1, 1 ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + else + if ( nPos - nNumRows + 1 ) < nFrstItem + nPos := nFrstItem + nAtTop := nFrstItem + else + nPos := max( nFrstItem, nPos - nNumRows + 1 ) + nAtTop := max( 1, nAtTop - nNumRows + 1 ) + do while ( nPos > nFrstItem ) .and. ( !alSelect[ nPos ] ) + nPos -- + nAtTop -- + enddo + nAtTop := max( 1, nAtTop ) + endif + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif + endif + + case nKey == K_PGDN + IF nPos == nLastItem + nMode := AC_HITBOTTOM + IF nAtTop < min( nPos, nItems - nNumRows + 1 ) + nAtTop := min( nPos, nItems - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif + else + IF InRange( nAtTop, nLastItem, nAtTop + nNumRows - 1 ) + * On the same page as nLastItem + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + nPos := nLastItem + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) + else + nGap := nPos - nAtTop + nPos := min( nLastItem, nPos + nNumRows - 1 ) + if ( nPos + nNumRows - 1 ) > nLastItem + * On the last page + nAtTop := nLastItem - nNumRows + 1 + nPos := min( nLastItem, nAtTop + nGap ) + else + * Not on the last page + nAtTop := nPos - nGap + endif + * Make sure that the item is selectable + do while ( nPos < nLastItem ) .and. ( !alSelect[ nPos ] ) + nPos ++ + nAtTop ++ + enddo + * Don't leave blank space on the page + do while ( nAtTop + nNumRows - 1 ) > nItems nAtTop -- enddo - nAtTop := max( 1, nAtTop ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) endif - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) endif - endif - case nKey == K_PGDN - IF nPos == nLastItem - nMode := AC_HITBOTTOM - IF nAtTop < min( nPos, nItems - nNumRows + 1 ) - nAtTop := min( nPos, nItems - nNumRows + 1 ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - endif - else - IF InRange( nAtTop, nLastItem, nAtTop + nNumRows - 1 ) - * On the same page as nLastItem - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr ) - nPos := nLastItem - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr ) - else - nGap := nPos - nAtTop - nPos := min( nLastItem, nPos + nNumRows - 1 ) - if ( nPos + nNumRows - 1 ) > nLastItem - * On the last page - nAtTop := nLastItem - nNumRows + 1 - nPos := min( nLastItem, nAtTop + nGap ) - else - * Not on the last page - nAtTop := nPos - nGap - endif - * Make sure that the item is selectable - do while ( nPos < nLastItem ) .and. ( !alSelect[ nPos ] ) - nPos ++ - nAtTop ++ - enddo - * Don't leave blank space on the page - do while ( nAtTop + nNumRows - 1 ) > nItems - nAtTop -- - enddo - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) - endif - endif + case ( nKey == K_ENTER ) .and. ( !lUserFunc ) + nMode := AC_SELECT + lFinished := .T. - case ( nKey == K_ENTER ) .and. ( !lUserFunc ) - nMode := AC_SELECT - lFinished := .T. + case ( nKey == K_RIGHT ) .and. ( !lUserFunc ) + nPos := 0 + lFinished := .T. - case ( nKey == K_RIGHT ) .and. ( !lUserFunc ) - nPos := 0 - lFinished := .T. + case ( nKey == K_LEFT ) .and. ( !lUserFunc ) + nPos := 0 + lFinished := .T. - case ( nKey == K_LEFT ) .and. ( !lUserFunc ) - nPos := 0 - lFinished := .T. - - case InRange( 32, nKey, 255 ) .and. ( ( !lUserFunc ) .or. ( nMode == AC_GOTO ) ) - * Find next selectable item - nNewPos := ascan( acCopy, bScan, nPos + 1 ) - do while InRange( nPos, nNewPos, nLastItem ) .and. ( !alSelect[ nNewPos ] ) - nNewPos := ascan( acCopy, bScan, nNewPos + 1 ) - enddo - - IF nNewPos == 0 - * Loop back to beginning item, if there is one - nNewPos := ascan( acCopy, bScan ) - do while InRange( 1, nNewPos, nLastItem ) .and. ( !alSelect[ nNewPos ] ) + case InRange( 32, nKey, 255 ) .and. ( ( !lUserFunc ) .or. ( nMode == AC_GOTO ) ) + * Find next selectable item + nNewPos := ascan( acCopy, bScan, nPos + 1 ) + do while InRange( nPos, nNewPos, nLastItem ) .and. ( !alSelect[ nNewPos ] ) nNewPos := ascan( acCopy, bScan, nNewPos + 1 ) enddo - endif - IF InRange( nFrstItem, nNewPos, nLastItem ) .and. alSelect[ nNewPos ] - IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) - * On same page - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F., cLoClr, cHiClr, cUnClr ) - nPos := nNewPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T., cLoClr, cHiClr, cUnClr ) - else - * On different page - nPos := nNewPos - nAtTop := Between( 1, nPos - nNumRows + 1, nItems ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) + IF nNewPos == 0 + * Loop back to beginning item, if there is one + nNewPos := ascan( acCopy, bScan ) + do while InRange( 1, nNewPos, nLastItem ) .and. ( !alSelect[ nNewPos ] ) + nNewPos := ascan( acCopy, bScan, nNewPos + 1 ) + enddo endif - endif - nMode := AC_IDLE + IF InRange( nFrstItem, nNewPos, nLastItem ) .and. alSelect[ nNewPos ] + IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) + * On same page + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + nPos := nNewPos + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) + else + * On different page + nPos := nNewPos + nAtTop := Between( 1, nPos - nNumRows + 1, nItems ) + DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + endif + endif - case ( nMode == AC_GOTO ) - * Garbage collect gotos which aren't valid ASCII characters - nMode := AC_IDLE - - otherwise - IF nKey == 0 // No keystroke nMode := AC_IDLE - else - nMode := AC_EXCEPT + + case ( nMode == AC_GOTO ) + * Garbage collect gotos which aren't valid ASCII characters + nMode := AC_IDLE + + otherwise + IF nKey == 0 // No keystroke + nMode := AC_IDLE + else + nMode := AC_EXCEPT + endif + + endcase + + IF lUserFunc + nUserFunc := do( xUserFunc, nMode, nPos, nPos - nAtTop ) + // DISPVAR nUserFunc + do case + case nUserFunc == AC_ABORT + lFinished := .T. + nPos := 0 + case nUserFunc == AC_SELECT + lFinished := .T. + case nUserFunc == AC_CONT + * Do nothing + case nUserFunc == AC_GOTO + * Do nothing. The next keystroke won't be read and + * this keystroke will be processed as a goto. + nMode := AC_GOTO + endcase endif - endcase + enddo - IF lUserFunc - nUserFunc := do( xUserFunc, nMode, nPos, nPos - nAtTop ) - // DISPVAR nUserFunc - do case - case nUserFunc == AC_ABORT - lFinished := .T. - nPos := 0 - case nUserFunc == AC_SELECT - lFinished := .T. - case nUserFunc == AC_CONT - * Do nothing - case nUserFunc == AC_GOTO - * Do nothing. The next keystroke won't be read and - * this keystroke will be processed as a goto. - nMode := AC_GOTO - endcase - endif + setcursor( nSaveCsr ) -enddo + return nPos -setcursor( nSaveCsr ) +static function DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) -return ( nPos ) + local nCntr + local nRow // Screen row + local nIndex // Array index + local nSaveRow := row() // Position at start of routine + local nSaveCol := col() // Position at start of routine + local nArrLen := len( acCopy ) -*+-------------------------------------------------------------------- -*+ -*+ Static Function DispPage() -*+ -*+ Called from ( achoice.prg ) 15 - function achoice() -*+ -*+-------------------------------------------------------------------- -*+ -static function DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop, cLoClr, cHiClr, cUnClr ) + dispbegin() + for nCntr := 1 to nNumRows + nRow := nTop + nCntr - 1 + nIndex := nCntr + nAtTop - 1 + IF InRange( 1, nIndex, nArrLen ) + DispLine( acCopy[ nIndex ], nRow, nLft, alSelect[ nIndex ], nIndex == nPos ) + else + SetPos( nRow, nCol ) + DispOut( space( len( acCopy[ 1 ] ) ) ) + endif + next + dispend() -local nCntr -local nRow // Screen row -local nIndex // Array index -local nSaveRow := row() // Position at start of routine -local nSaveCol := col() // Position at start of routine -local nArrLen := len( acCopy ) + setpos( nSaveRow, nSaveCol ) -dispbegin() -for nCntr := 1 to nNumRows - nRow := nTop + nCntr - 1 - nIndex := nCntr + nAtTop - 1 - IF InRange( 1, nIndex, nArrLen ) - DispLine( acCopy[ nIndex ], nRow, nLft, alSelect[ nIndex ], nIndex == nPos, cLoClr, cHiClr, cUnClr ) - else - @ nRow, nLft say space( len( acCopy[ 1 ] ) ) color cLoClr - endif -next -dispend() + return NIL -setpos( nSaveRow, nSaveCol ) +static function DispLine( cLine, nRow, nCol, lSelect, lHiLyt ) -return ( NIL ) + ColorSelect( if( lSelect, ; + if( lHiLyt, CLR_ENHANCED, CLR_STANDARD ), CLR_UNSELECTED ) ) -*+-------------------------------------------------------------------- -*+ -*+ Static Function DispLine() -*+ -*+ Called from ( achoice.prg ) 20 - function achoice() -*+ 1 - static function disppage() -*+ -*+-------------------------------------------------------------------- -*+ -static function DispLine( cLine, nRow, nCol, lSelect, lHiLyt, cLoClr, cHiClr, cUnClr ) + SetPos( nRow, nCol ) + DispOut( cLine ) -@ nRow, nCol say cLine color if( lSelect, if( lHiLyt, cHiClr, cLoClr ), cUnClr ) + ColorSelect( CLR_STANDARD ) -return ( NIL ) + return NIL -*+-------------------------------------------------------------------- -*+ -*+ Static Function InRange() -*+ -*+ Called from ( achoice.prg ) 10 - function achoice() -*+ 1 - static function disppage() -*+ -*+-------------------------------------------------------------------- -*+ static function InRange( xLo, xVal, xHi ) + return ( xVal >= xLo ) .and. ; + ( xVal <= xHi ) -return ( ( xVal >= xLo ) .and. ( xVal <= xHi ) ) - -*+-------------------------------------------------------------------- -*+ -*+ Static Function Between() -*+ -*+ Called from ( achoice.prg ) 4 - function achoice() -*+ -*+-------------------------------------------------------------------- -*+ static function Between( xLo, xVal, xHi ) + return min( max( xLo, xVal ), xHi ) -return ( min( max( xLo, xVal ), xHi ) ) - -*+-------------------------------------------------------------------- -*+ -*+ Static Function Before() -*+ -*+ Called from ( achoice.prg ) 3 - function achoice() -*+ -*+-------------------------------------------------------------------- -*+ -static function Before( cDelim, cValue ) - -local cRetVal -local nPos - -IF (nPos := at( cDelim, cValue )) > 0 - cRetVal := left( cValue, nPos - 1 ) -else - cRetVal := cValue -endif - -return ( cRetVal ) - -*+-------------------------------------------------------------------- -*+ -*+ Static Function After() -*+ -*+ Called from ( achoice.prg ) 6 - function achoice() -*+ -*+-------------------------------------------------------------------- -*+ -static function After( cDelim, cValue ) - -local cRetVal -local nPos - -IF (nPos := at( cDelim, cValue )) > 0 - cRetVal := substr( cValue, nPos + 1 ) -else - cRetVal := "" -endif - -return ( cRetVal ) diff --git a/harbour/source/rtl/console.c b/harbour/source/rtl/console.c index f39452a19f..7a8ca59c73 100644 --- a/harbour/source/rtl/console.c +++ b/harbour/source/rtl/console.c @@ -1120,16 +1120,16 @@ HARBOUR HB___COLORINDEX( void ) { if ( ISCHAR( 1 ) && ISNUM( 2 ) ) { - char * szColorSpec = hb_parc( 1 ); - ULONG ulColorSpecPos; - ULONG ulColorSpecLen; + char * szColor = hb_parc( 1 ); + ULONG ulColorPos; + ULONG ulColorLen; USHORT uiColorIndex = hb_parni( 2 ); /* Skip the given number of commas */ - for ( ulColorSpecPos = 0; szColorSpec[ ulColorSpecPos ] && uiColorIndex > 0 ; ulColorSpecPos++ ) + for ( ulColorPos = 0 ; szColor[ ulColorPos ] && uiColorIndex > 0 ; ulColorPos++ ) { - if ( szColorSpec[ ulColorSpecPos ] == ',' ) + if ( szColor[ ulColorPos ] == ',' ) uiColorIndex--; } @@ -1139,23 +1139,23 @@ HARBOUR HB___COLORINDEX( void ) { /* Skip the spaces after the comma */ - while ( szColorSpec[ ulColorSpecPos ] == ' ' ) ulColorSpecPos++; + while ( szColor[ ulColorPos ] == ' ' ) ulColorPos++; /* Search for next comma or end of string */ - ulColorSpecLen = 0; + ulColorLen = 0; - while ( szColorSpec[ ulColorSpecPos + ulColorSpecLen ] && - szColorSpec[ ulColorSpecPos + ulColorSpecLen ] != ',' ) ulColorSpecLen++; + while ( szColor[ ulColorPos + ulColorLen ] && + szColor[ ulColorPos + ulColorLen ] != ',' ) ulColorLen++; /* Skip the trailing spaces */ - while ( ulColorSpecLen && - szColorSpec[ ulColorSpecPos + ulColorSpecLen - 1 ] == ' ' ) ulColorSpecLen--; + while ( ulColorLen && + szColor[ ulColorPos + ulColorLen - 1 ] == ' ' ) ulColorLen--; /* Return the string */ - hb_retclen( szColorSpec + ulColorSpecPos, ulColorSpecLen ); + hb_retclen( szColor + ulColorPos, ulColorLen ); } else hb_retc( "" ); diff --git a/harbour/tests/working/Makefile b/harbour/tests/working/Makefile index 0f7add7227..a3b89d4715 100644 --- a/harbour/tests/working/Makefile +++ b/harbour/tests/working/Makefile @@ -17,6 +17,27 @@ endif ifeq ($(PM),) # PM not defined = build all files PRG_SOURCES=\ ac_test.prg \ + adirtest.prg \ + ainstest.prg \ + and_or.prg \ + array16.prg \ + arrayidx.prg \ + arrays.prg \ + arreval.prg \ + arrindex.prg \ + atest.prg \ + box.prg \ + byref.prg \ + calling.prg \ + cdow.prg \ + clasinit.prg \ + clasname.prg \ + classch.prg \ + classes.prg \ + clsdata.prg \ + cmphello.prg \ + codebl.prg \ + codebloc.prg \ colorind.prg \ comments.prg \ copyfile.prg \