diff --git a/harbour/ChangeLog b/harbour/ChangeLog index e282f20d4d..8b099946eb 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,14 @@ +19991020-21:30 GMT+1 Victor Szel + * source/rtl/achoice.prg + % FUNCTION -> PROCEDURE for speed. + % Two small functions converted to macros for speed. + * Formatted. (if() -> iif(), <> -> !=, some variable names standardized, + S87 style comments * -> //, indent errors, etc.) + * source/rtl/asort.prg + % FUNCTION -> PROCEDURE for speed. + * include/rddsys.h + * Small aligning. + 19991020-22:58 GMT+3 Alexander Kresin * source/pp/hbpp.c * Fixed bugs, reported by Antonio Linares, Victor Szel and Guy Roussin @@ -10,7 +21,6 @@ * contrib/odbc/harbour.mdb * These files I got from Felipe Coury - 19991020-20:23 GMT+1 Victor Szel * source/rtl/alert.prg source/rtl/browdb.prg diff --git a/harbour/include/rddapi.h b/harbour/include/rddapi.h index f6c2d56638..2c68d37cd7 100644 --- a/harbour/include/rddapi.h +++ b/harbour/include/rddapi.h @@ -40,7 +40,7 @@ /* RDD virtual machine integration functions */ -extern int hb_rddGetCurrentWorkAreaNumber( void ); +extern int hb_rddGetCurrentWorkAreaNumber( void ); extern ERRCODE hb_rddSelectWorkAreaAlias( char * szAlias ); extern ERRCODE hb_rddSelectWorkAreaNumber( int iArea ); extern ERRCODE hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias ); @@ -48,7 +48,7 @@ extern ERRCODE hb_rddGetFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ); extern ERRCODE hb_rddPutFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ); extern ERRCODE hb_rddFieldGet( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ); extern ERRCODE hb_rddFieldPut( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ); -extern void hb_rddShutDown( void ); +extern void hb_rddShutDown( void ); /* Flags for DBTRANSINFO */ diff --git a/harbour/source/rtl/achoice.prg b/harbour/source/rtl/achoice.prg index 8802e865f1..a733c57fa0 100644 --- a/harbour/source/rtl/achoice.prg +++ b/harbour/source/rtl/achoice.prg @@ -11,12 +11,12 @@ * */ -#include "inkey.ch" -#include "setcurs.ch" -#include "set.ch" #include "achoice.ch" -#include "common.ch" #include "color.ch" +#include "common.ch" +#include "inkey.ch" +#include "set.ch" +#include "setcurs.ch" /* $DOC$ * $FUNCNAME$ @@ -94,464 +94,481 @@ * $END$ */ -function achoice( nTop, nLft, nBtm, nRyt, acItems, xSelect, xUserFunc, nPos, nHiLytRow ) +#define INRANGE( xLo, xVal, xHi ) ( xVal >= xLo .AND. xVal <= xHi ) +#define BETWEEN( xLo, xVal, xHi ) Min( Max( xLo, xVal ), xHi ) - local nNumCols // Number of columns in the window - local nNumRows // 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 // The number of items - local nGap := 0 // The number of lines between top and current lines +FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPos, nHiLiteRow ) + + LOCAL nNumCols // Number of columns in the window + LOCAL nNumRows // 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 // The number of items + LOCAL nGap := 0 // The number of lines between top and current lines // Block used to search for items - 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 - local bAction - local cKey + 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 + LOCAL bAction + LOCAL cKey ColorSelect( CLR_STANDARD ) - lUserFunc := !empty( xUserFunc ) .AND. ValType( xUserFunc ) $ "CB" + lUserFunc := !Empty( xUserFunc ) .AND. ValType( xUserFunc ) $ "CB" - 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 nLeft TO 0 // The leftmost column of the window + DEFAULT nBottom TO MaxRow() + 1 // The bottommost row of the windows + DEFAULT nRight TO MaxCol() + 1 // The rightmost column of the window - nNumCols := nRyt - nLft + 1 - nNumRows := nBtm - nTop + 1 - aeval( acItems, { | x | if( ISCHARACTER( x ), aadd( acCopy, padr( x, nNumCols ) ), .F. ) } ) - nItems := len( acCopy ) + 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 nHiLiteRow TO 0 // The row to be highlighted - alSelect := array( nItems ) + nNumCols := nRight - nLeft + 1 + nNumRows := nBottom - nTop + 1 + AEval( acItems, {| x | iif( ISCHARACTER( x ), AAdd( acCopy, PadR( x, nNumCols ) ), .F. ) } ) + nItems := Len( acCopy ) + + alSelect := Array( nItems ) IF ISARRAY( xSelect ) - afill( alSelect, .T. ) - for nCntr := 1 to len( xSelect ) + AFill( alSelect, .T. ) + FOR nCntr := 1 TO Len( xSelect ) IF nCntr <= nItems IF ISCHARACTER( xSelect[ nCntr ] ) - IF empty( xSelect[ nCntr ] ) + IF Empty( xSelect[ nCntr ] ) lFinished := .T. nPos := 0 - else + ELSE /* TODO: When macro evaluation will work, this should be commented out: alSelect[ nCntr ] := &( xSelect[ nCntr ] ) */ - endif - else + ENDIF + ELSE alSelect[ nCntr ] := xSelect[ nCntr ] - endif - else - nCntr := len( xSelect ) + 1 - endif - next - else - afill( alSelect, xSelect ) - endif + ENDIF + ELSE + nCntr := Len( xSelect ) + 1 + ENDIF + NEXT + ELSE + AFill( alSelect, xSelect ) + ENDIF IF !lFinished - nFrstItem := ascan( alSelect, .T. ) // First valid item + nFrstItem := AScan( alSelect, .T. ) // First valid item IF nFrstItem == 0 nLastItem := 0 nPos := 0 nMode := AC_NOITEM - else + ELSE nMode := AC_IDLE nLastItem := nItems // Last valid item - do while ( !alSelect[ nLastItem ] ) - nLastItem -- - enddo - endif + DO WHILE !alSelect[ nLastItem ] + nLastItem-- + ENDDO + ENDIF // Ensure hilighted item can be selected - nPos := Between( nFrstItem, nPos, nLastItem ) + nPos := BETWEEN( nFrstItem, nPos, nLastItem ) // Force hilighted row to be valid - nHiLytRow := Between( 0, nHiLytRow, nNumRows - 1 ) + nHiLiteRow := BETWEEN( 0, nHiLiteRow, nNumRows - 1 ) // Force the topmost item to be a valid index of the array - nAtTop := Between( 1, max( 1, nPos - nHiLytRow ), nItems ) + nAtTop := BETWEEN( 1, Max( 1, nPos - nHiLiteRow ), nItems ) // Ensure as much of the selection area as possible is covered - if ( nAtTop + nNumRows - 1 ) > nItems - nAtTop := max( 1, nItems - nNumrows + 1 ) - endif + IF ( nAtTop + nNumRows - 1 ) > nItems + nAtTop := Max( 1, nItems - nNumrows + 1 ) + ENDIF - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) + DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) - endif + ENDIF - do while ( !lFinished ) + DO WHILE !lFinished - IF nMode != AC_GOTO .and. nMode != AC_NOITEM + IF nMode != AC_GOTO .AND. nMode != AC_NOITEM nKey := Inkey( 0 ) nMode := AC_IDLE - endif + ENDIF - do case + DO CASE + CASE ( bAction := SetKey( nKey ) ) != NIL - case ( bAction := setkey( nKey ) ) <> NIL - - eval( bAction, procname( 1 ), procline( 1 ), "" ) - if empty( nextkey() ) - keyboard chr( 255 ) - inkey() + Eval( bAction, ProcName( 1 ), ProcLine( 1 ), "" ) + IF Empty( NextKey() ) + KEYBOARD Chr( 255 ) + Inkey() nKey := 0 - endif + ENDIF + + CASE ( nKey == K_ESC .OR. nMode == AC_NOITEM ) .AND. !lUserFunc - case ( ( nKey == K_ESC ) .or. ( nMode == AC_NOITEM ) ) .and. ( !lUserFunc ) nMode := AC_ABORT nPos := 0 lFinished := .T. - case nKey == K_UP + 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 + IF nAtTop > Max( 1, nPos - nNumRows + 1 ) + nAtTop := Max( 1, nPos - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + ELSE nNewPos := nPos - 1 - do while !alSelect[ nNewPos ] + DO WHILE !alSelect[ nNewPos ] nNewPos -- - enddo - IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + ENDDO + IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, 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 ) ) ) + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. ) + ELSE + DispBegin() + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. ) + Scroll( nTop, nLeft, nBottom, nRight, ( 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 := Max( nPos, nAtTop + nNumRows - 1 ) + DO WHILE nPos > nNewPos + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. ) nPos -- - enddo - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) - dispend() - endif - endif + ENDDO + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. ) + DispEnd() + ENDIF + ENDIF - case nKey == K_DOWN - * Find the next selectable item to display + 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 + IF nAtTop < Min( nPos, nItems - nNumRows + 1 ) + nAtTop := Min( nPos, nItems - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + ELSE nNewPos := nPos + 1 - do while !alSelect[ nNewPos ] + DO WHILE !alSelect[ nNewPos ] nNewPos ++ - enddo + ENDDO - IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, 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 ) ) ) + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. ) + ELSE + DispBegin() + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. ) + Scroll( nTop, nLeft, nBottom, nRight, ( 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 := Max( nPos, nAtTop ) + DO WHILE nPos < nNewPos + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. ) nPos ++ - enddo - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) - dispend() - endif + ENDDO + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. ) + DispEnd() + ENDIF - endif + ENDIF + + CASE nKey == K_CTRL_PGUP .OR. ( nKey == K_HOME .AND. !lUserFunc ) - case nKey == K_CTRL_PGUP .or. ( nKey == K_HOME .and. !lUserFunc ) IF nPos == nFrstItem - IF nAtTop == max( 1, nPos - nNumRows + 1 ) + 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 + ELSE + nAtTop := Max( 1, nPos - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + ELSE nPos := nFrstItem nAtTop := nPos - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) - endif + DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + + CASE nKey == K_CTRL_PGDN .OR. ( nKey == K_END .AND. !lUserFunc ) - case nKey == K_CTRL_PGDN .or. ( nKey == K_END .and. !lUserFunc ) IF nPos == nLastItem - IF nAtTop == min( nLastItem, nItems - nNumRows + 1 ) + 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. ) + ELSE + nAtTop := Min( nLastItem, nItems - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + ELSE + IF INRANGE( nAtTop, nLastItem, nAtTop + nNumRows - 1 ) + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. ) nPos := nLastItem - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) - else + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. ) + ELSE nPos := nLastItem - nAtTop := max( 1, nPos - nNumRows + 1 ) - DispPage( acCopy, alSelect, nTop, nLft, nNumRows, nPos, nAtTop ) - endif - endif + nAtTop := Max( 1, nPos - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + ENDIF + + CASE nKey == K_CTRL_HOME - case nKey == K_CTRL_HOME IF nPos == nFrstItem - IF nAtTop == max( 1, nPos - nNumRows + 1 ) + 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 + ELSE + nAtTop := Max( 1, nPos - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + ELSE nNewPos := nAtTop - do while !alSelect[ nNewPos ] - nNewPos ++ - enddo + DO WHILE !alSelect[ nNewPos ] + nNewPos++ + ENDDO IF nNewPos != nPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. ) nPos := nNewPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) - endif - endif + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. ) + ENDIF + ENDIF + + CASE nKey == K_CTRL_END - case nKey == K_CTRL_END IF nPos == nLastItem - IF nAtTop == min( nPos, nItems - nNumRows + 1 ) + 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 + ELSE + nAtTop := Min( nPos, nItems - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + ELSE nNewPos := nAtTop + nNumRows - 1 - do while !alSelect[ nNewPos ] - nNewPos -- - enddo + DO WHILE !alSelect[ nNewPos ] + nNewPos-- + ENDDO IF nNewPos != nPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. ) nPos := nNewPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) - endif - endif + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. ) + ENDIF + ENDIF + + CASE nKey == K_PGUP - 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 + IF nAtTop > Max( 1, nPos - nNumRows + 1 ) + nAtTop := Max( 1, nPos - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLeft, 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 + nAtTop := Max( nPos - nNumRows + 1, 1 ) + DispPage( acCopy, alSelect, nTop, nLeft, 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 + 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, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + ENDIF + + CASE nKey == K_PGDN - 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. ) + IF nAtTop < Min( nPos, nItems - nNumRows + 1 ) + nAtTop := Min( nPos, nItems - nNumRows + 1 ) + DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + ELSE + IF INRANGE( nAtTop, nLastItem, nAtTop + nNumRows - 1 ) + // On the same page as nLastItem + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. ) nPos := nLastItem - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) - else + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .T. ) + ELSE nGap := nPos - nAtTop - nPos := min( nLastItem, nPos + nNumRows - 1 ) - if ( nPos + nNumRows - 1 ) > nLastItem - * On the last page + 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 + 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 ) - endif - endif + 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, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + ENDIF + + CASE nKey == K_ENTER .AND. !lUserFunc - case ( nKey == K_ENTER ) .and. ( !lUserFunc ) nMode := AC_SELECT lFinished := .T. - case ( nKey == K_RIGHT ) .and. ( !lUserFunc ) + CASE nKey == K_RIGHT .AND. !lUserFunc + nPos := 0 lFinished := .T. - case ( nKey == K_LEFT ) .and. ( !lUserFunc ) + CASE nKey == K_LEFT .AND. !lUserFunc + nPos := 0 lFinished := .T. - case InRange( 32, nKey, 255 ) .and. ( ( !lUserFunc ) .or. ( nMode == AC_GOTO ) ) + CASE INRANGE( 32, nKey, 255 ) .AND. ( !lUserFunc .OR. nMode == AC_GOTO ) - cKey := upper( chr( nKey ) ) + cKey := Upper( Chr( nKey ) ) - * Find next selectable item + // Find next selectable item FOR nNewPos := nPos + 1 TO nItems - IF alSelect[ nNewPos ] .AND. left( acCopy[ nNewPos ], 1 ) == cKey - EXIT - ENDIF + IF alSelect[ nNewPos ] .AND. Left( acCopy[ nNewPos ], 1 ) == cKey + EXIT + ENDIF NEXT IF nNewPos == nItems + 1 - FOR nNewPos := 1 TO nPos - 1 - IF alSelect[ nNewPos ] .AND. left( acCopy[ nNewPos ], 1 ) == cKey - EXIT - ENDIF - NEXT + FOR nNewPos := 1 TO nPos - 1 + IF alSelect[ nNewPos ] .AND. Left( acCopy[ nNewPos ], 1 ) == cKey + EXIT + ENDIF + NEXT ENDIF IF nNewPos != nPos - IF InRange( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) - * On same page - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .F. ) + IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 ) + // On same page + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, alSelect[ nPos ], .F. ) nPos := nNewPos - DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLft, alSelect[ nPos ], .T. ) - else - * On different page + DispLine( acCopy[ nPos ], nTop + ( nPos - nAtTop ), nLeft, 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 + nAtTop := BETWEEN( 1, nPos - nNumRows + 1, nItems ) + DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) + ENDIF + ENDIF nMode := AC_IDLE - case ( nMode == AC_GOTO ) - * Garbage collect gotos which aren't valid ASCII characters + CASE nMode == AC_GOTO + + // Garbage collect gotos which aren't valid ASCII characters nMode := AC_IDLE - otherwise + OTHERWISE + IF nKey == 0 // No keystroke nMode := AC_IDLE - else + ELSE nMode := AC_EXCEPT - endif + ENDIF - endcase + ENDCASE IF lUserFunc - nUserFunc := do( xUserFunc, nMode, nPos, nPos - nAtTop ) + + nUserFunc := Do( xUserFunc, nMode, nPos, nPos - nAtTop ) // DISPVAR nUserFunc - do case - case nUserFunc == AC_ABORT + + DO CASE + CASE nUserFunc == AC_ABORT lFinished := .T. nPos := 0 - case nUserFunc == AC_SELECT + 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. + 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 + 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 PROCEDURE DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop ) + + 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 ) + + DispBegin() + + FOR nCntr := 1 TO nNumRows - 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 + + IF INRANGE( 1, nIndex, nArrLen ) + DispLine( acCopy[ nIndex ], nRow, nLeft, alSelect[ nIndex ], nIndex == nPos ) + ELSE ColorSelect( CLR_STANDARD ) - SetPos( nRow, nLft ) - DispOut( space( len( acCopy[ 1 ] ) ) ) - endif - next - dispend() + SetPos( nRow, nLeft ) + DispOut( Space( Len( acCopy[ 1 ] ) ) ) + ENDIF + NEXT - setpos( nSaveRow, nSaveCol ) + DispEnd() - return NIL + SetPos( nSaveRow, nSaveCol ) -static function DispLine( cLine, nRow, nCol, lSelect, lHiLyt ) + RETURN - ColorSelect( if( lSelect, ; - if( lHiLyt, CLR_ENHANCED, CLR_STANDARD ), CLR_UNSELECTED ) ) +STATIC PROCEDURE DispLine( cLine, nRow, nCol, lSelect, lHiLite ) + + ColorSelect( iif( lSelect, ; + iif( lHiLite, CLR_ENHANCED, CLR_STANDARD ), CLR_UNSELECTED ) ) SetPos( nRow, nCol ) DispOut( cLine ) ColorSelect( CLR_STANDARD ) - return NIL - -static function InRange( xLo, xVal, xHi ) - return ( xVal >= xLo ) .and. ; - ( xVal <= xHi ) - -static function Between( xLo, xVal, xHi ) - return min( max( xLo, xVal ), xHi ) + RETURN diff --git a/harbour/source/rtl/asort.prg b/harbour/source/rtl/asort.prg index f4fb129fcc..fe46fc4159 100644 --- a/harbour/source/rtl/asort.prg +++ b/harbour/source/rtl/asort.prg @@ -90,7 +90,7 @@ FUNCTION ASort( aArray, nStart, nCount, bBlock ) * For instructions : * http://monty.cnri.reston.va.us/grail/demo/quicksort/quicksort.htm */ -STATIC FUNCTION QuickSort( aArray, nLeft, nRight, bBlock ) +STATIC PROCEDURE QuickSort( aArray, nLeft, nRight, bBlock ) LOCAL nUp := nLeft LOCAL nDown := nRight @@ -131,5 +131,5 @@ STATIC FUNCTION QuickSort( aArray, nLeft, nRight, bBlock ) QuickSort( aArray, nUp , nRight, bBlock ) ENDIF - RETURN NIL + RETURN