From 618df79c9b7ae6b7718dd14dd068cdde3a7274d2 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Sat, 11 Oct 2008 02:56:22 +0000 Subject: [PATCH] 2008-10-11 04:56 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbapigt.h * harbour/source/rtl/gtapi.c + added C functions hb_gtLock() and hb_gtUnlock() They block current GT for other threads * harbour/source/rtl/gtfunc.c + added PRG functions hb_gtLock() and hb_gtUnlock() They block current GT for other threads - be careful using them and always unlock locked GT * harbour/source/rtl/scroll.c + added HB_SCROLL() function - it works like SCROLL() but supports 2 additional parameters: color and erase char. It's stateless and atomic in GT access * harbour/source/rtl/tbrowse.prg * use HB_SCROLL() instead of SCROLL(). Now whole TBROWSE class does not depend on other thread screen output and does not set any GT variables except of cursor positioning to active cell when it's enabled * harbour/source/rtl/memoedit.prg * harbour/source/rtl/tgetlist.prg * harbour/source/rtl/tlabel.prg * harbour/source/rtl/listbox.prg * harbour/source/rtl/tmenusys.prg * harbour/source/rtl/achoice.prg * harbour/source/rtl/profiler.prg * harbour/source/rtl/teditor.prg * use atomic stateless functions when possible - this code should be checked and updated by some who know it. --- harbour/ChangeLog | 33 ++++++++++++++ harbour/include/hbapigt.h | 2 + harbour/source/rtl/achoice.prg | 4 +- harbour/source/rtl/gtapi.c | 34 +++++++++++++++ harbour/source/rtl/gtfunc.c | 10 +++++ harbour/source/rtl/listbox.prg | 29 ++++++++----- harbour/source/rtl/memoedit.prg | 13 +++--- harbour/source/rtl/profiler.prg | 2 +- harbour/source/rtl/scroll.c | 76 +++++++++++++++++++++++++++++++++ harbour/source/rtl/tbrowse.prg | 9 ++-- harbour/source/rtl/teditor.prg | 17 +++----- harbour/source/rtl/tgetlist.prg | 2 +- harbour/source/rtl/tlabel.prg | 2 +- harbour/source/rtl/tmenusys.prg | 10 ++--- 14 files changed, 200 insertions(+), 43 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index a1e8b6f105..dd6e2904e3 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,39 @@ 2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org) */ +2008-10-11 04:56 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbapigt.h + * harbour/source/rtl/gtapi.c + + added C functions hb_gtLock() and hb_gtUnlock() + They block current GT for other threads + + * harbour/source/rtl/gtfunc.c + + added PRG functions hb_gtLock() and hb_gtUnlock() + They block current GT for other threads - be careful using them + and always unlock locked GT + + * harbour/source/rtl/scroll.c + + added HB_SCROLL() function - it works like SCROLL() but supports + 2 additional parameters: color and erase char. It's stateless and + atomic in GT access + + * harbour/source/rtl/tbrowse.prg + * use HB_SCROLL() instead of SCROLL(). Now whole TBROWSE class + does not depend on other thread screen output and does not + set any GT variables except of cursor positioning to active + cell when it's enabled + + * harbour/source/rtl/memoedit.prg + * harbour/source/rtl/tgetlist.prg + * harbour/source/rtl/tlabel.prg + * harbour/source/rtl/listbox.prg + * harbour/source/rtl/tmenusys.prg + * harbour/source/rtl/achoice.prg + * harbour/source/rtl/profiler.prg + * harbour/source/rtl/teditor.prg + * use atomic stateless functions when possible - this code should + be checked and updated by some who know it. + 2008-10-11 03:24 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/rtl/scrollbr.prg * harbour/source/rtl/getsys.prg diff --git a/harbour/include/hbapigt.h b/harbour/include/hbapigt.h index 75db998938..a277dad02f 100644 --- a/harbour/include/hbapigt.h +++ b/harbour/include/hbapigt.h @@ -142,6 +142,8 @@ typedef struct extern HB_EXPORT ERRCODE hb_gtInit( HB_FHANDLE hFilenoStdin, HB_FHANDLE hFilenoStdout, HB_FHANDLE hFilenoStderr ); extern HB_EXPORT ERRCODE hb_gtExit( void ); +extern HB_EXPORT ERRCODE hb_gtLock( void ); +extern HB_EXPORT ERRCODE hb_gtUnlock( void ); extern HB_EXPORT ERRCODE hb_gtBox( SHORT uiTop, SHORT uiLeft, SHORT uiBottom, SHORT uiRight, BYTE * pbyFrame ); extern HB_EXPORT ERRCODE hb_gtBoxD( SHORT uiTop, SHORT uiLeft, SHORT uiBottom, SHORT uiRight ); extern HB_EXPORT ERRCODE hb_gtBoxS( SHORT uiTop, SHORT uiLeft, SHORT uiBottom, SHORT uiRight ); diff --git a/harbour/source/rtl/achoice.prg b/harbour/source/rtl/achoice.prg index b8561a3f7f..ddc9473724 100644 --- a/harbour/source/rtl/achoice.prg +++ b/harbour/source/rtl/achoice.prg @@ -197,7 +197,7 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo ELSE DispBegin() DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols ) - Scroll( nTop, nLeft, nBottom, nRight, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) ) + hb_scroll( nTop, nLeft, nBottom, nRight, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) ) nAtTop := nNewPos nPos := Max( nPos, nAtTop + nNumRows - 1 ) DO WHILE nPos > nNewPos @@ -237,7 +237,7 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo ELSE DispBegin() DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols ) - Scroll( nTop, nLeft, nBottom, nRight, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) ) + hb_scroll( nTop, nLeft, nBottom, nRight, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) ) nAtTop := nNewPos - nNumRows + 1 nPos := Max( nPos, nAtTop ) DO WHILE nPos < nNewPos diff --git a/harbour/source/rtl/gtapi.c b/harbour/source/rtl/gtapi.c index 0022a9adff..44f7d15ab6 100644 --- a/harbour/source/rtl/gtapi.c +++ b/harbour/source/rtl/gtapi.c @@ -139,6 +139,40 @@ HB_EXPORT ERRCODE hb_gtExit( void ) return SUCCESS; } +HB_EXPORT ERRCODE hb_gtLock( void ) +{ + ERRCODE errCode = FAILURE; + PHB_GT pGT; + + HB_TRACE(HB_TR_DEBUG, ("hb_gtLock()")); + + pGT = hb_gt_Base(); + if( pGT ) + { + if( HB_GTSELF_LOCK( pGT ) ) + errCode = SUCCESS; + hb_gt_BaseFree( pGT ); + } + return errCode; +} + +HB_EXPORT ERRCODE hb_gtUnlock( void ) +{ + ERRCODE errCode = FAILURE; + PHB_GT pGT; + + HB_TRACE(HB_TR_DEBUG, ("hb_gtUnlock()")); + + pGT = hb_gt_Base(); + if( pGT ) + { + HB_GTSELF_UNLOCK( pGT ); + errCode = SUCCESS; + hb_gt_BaseFree( pGT ); + } + return errCode; +} + HB_EXPORT int hb_gtReadKey( int iEventMask ) { int iKey = 0; diff --git a/harbour/source/rtl/gtfunc.c b/harbour/source/rtl/gtfunc.c index 78cc14a50f..a38243d0a9 100644 --- a/harbour/source/rtl/gtfunc.c +++ b/harbour/source/rtl/gtfunc.c @@ -145,3 +145,13 @@ HB_FUNC( HB_GFXTEXT ) hb_parni( 5 ) /* nSize */, hb_parni( 6 ) /* nWidth */ ); } + +HB_FUNC( HB_GTLOCK ) +{ + hb_retl( hb_gtLock() ); +} + +HB_FUNC( HB_GTUNLOCK ) +{ + hb_gtUnlock(); +} diff --git a/harbour/source/rtl/listbox.prg b/harbour/source/rtl/listbox.prg index f9954513cf..82de754605 100644 --- a/harbour/source/rtl/listbox.prg +++ b/harbour/source/rtl/listbox.prg @@ -236,6 +236,7 @@ METHOD display() CLASS LISTBOX LOCAL cColor4 LOCAL cColor3 LOCAL cColorAny + LOCAL cColorScrl LOCAL nTop := ::nTop LOCAL nLeft := ::nLeft LOCAL nSize := ::nRight - nLeft + 1 @@ -273,20 +274,26 @@ METHOD display() CLASS LISTBOX IF ::lIsOpen IF !Empty( cHotBox ) - nOldRow := Row() - nOldCol := Col() - cOldColor := SetColor() - - SetColor( hb_ColorIndex( ::cColorSpec, 4 ) ) - Scroll( nTop, nLeft, ::nBottom, ::nRight ) - DispBox( nTop, nLeft, ::nBottom, ::nRight, cHotBox ) + cColorScrl := hb_ColorIndex( ::cColorSpec, 4 ) + hb_scroll( nTop, nLeft, ::nBottom, ::nRight,,, cColorScrl ) + hb_dispBox( nTop, nLeft, ::nBottom, ::nRight, cHotBox, cColorScrl ) IF ::oVScroll != NIL - ::oVScroll:display() - ENDIF - SetColor( cOldColor ) - SetPos( nOldRow, nOldCol ) + /* Is it necessary to save, set and restore color and cursor + * position for ::oVScroll:display() or we can remove it? + */ + nOldRow := Row() + nOldCol := Col() + cOldColor := SetColor() + SetColor( cColorScrl ) + + ::oVScroll:display() + + SetColor( cOldColor ) + SetPos( nOldRow, nOldCol ) + + ENDIF nTop++ nLeft++ diff --git a/harbour/source/rtl/memoedit.prg b/harbour/source/rtl/memoedit.prg index ed5f781253..0e8b8459ed 100644 --- a/harbour/source/rtl/memoedit.prg +++ b/harbour/source/rtl/memoedit.prg @@ -153,16 +153,17 @@ METHOD KeyboardHook( nKey ) CLASS HBMemoEditor IF nKey == K_ESC IF ::lDirty .AND. Set( _SET_SCOREBOARD ) cBackScr := SaveScreen( ::nTop, ::nRight - 18, ::nTop, ::nRight ) - + nRow := Row() nCol := Col() - @ ::nTop, ::nRight - 18 SAY "Abort Edit? (Y/N)" - + hb_dispOutAt( ::nTop, ::nRight - 18, "Abort Edit? (Y/N)" ) + SetPos( ::nTop, ::nRight - 1 ) + nYesNoKey := Inkey( 0 ) - + RestScreen( ::nTop, ::nRight - 18, ::nTop, ::nRight, cBackScr ) SetPos( nRow, nCol ) - + IF Upper( Chr( nYesNoKey ) ) == "Y" ::lSaved := .F. ::lExitEdit := .T. @@ -238,7 +239,7 @@ METHOD xDo( nStatus ) CLASS HBMemoEditor LOCAL nOldRow := ::Row() LOCAL nOldCol := ::Col() LOCAL nOldCur := SetCursor() - + LOCAL xResult := Do( ::xUserFunction, nStatus, ::nRow, ::nCol - 1 ) IF ! ISNUMBER( xResult ) diff --git a/harbour/source/rtl/profiler.prg b/harbour/source/rtl/profiler.prg index 5bd33938ec..94712a9141 100644 --- a/harbour/source/rtl/profiler.prg +++ b/harbour/source/rtl/profiler.prg @@ -149,7 +149,7 @@ PROCEDURE Main() STATIC PROCEDURE DrawScreen( cTitle ) - Scroll() + CLEAR SCREEN @ 0, 0 SAY PadR( cTitle, MaxCol() + 1 ) COLOR "N/W" diff --git a/harbour/source/rtl/scroll.c b/harbour/source/rtl/scroll.c index e9b5dad899..2b41fea859 100644 --- a/harbour/source/rtl/scroll.c +++ b/harbour/source/rtl/scroll.c @@ -108,3 +108,79 @@ HB_FUNC( SCROLL ) ( SHORT ) hb_parni( 5 ), /* Defaults to zero on bad type */ ( SHORT ) hb_parni( 6 ) ); /* Defaults to zero on bad type */ } + +HB_FUNC( HB_SCROLL ) +{ + int iMaxRow = hb_gtMaxRow(); + int iMaxCol = hb_gtMaxCol(); + + int iTop; + int iLeft; + int iBottom; + int iRight; + int iColor; + int iChar; + + /* Enforce limits of (0,0) to (MAXROW(),MAXCOL()) */ + + iTop = hb_parni( 1 ); /* Defaults to zero on bad type */ + if( iTop < 0 ) + iTop = 0; + else if( iTop > iMaxRow ) + iTop = iMaxRow; + + iLeft = hb_parni( 2 ); /* Defaults to zero on bad type */ + if( iLeft < 0 ) + iLeft = 0; + else if( iLeft > iMaxCol ) + iLeft = iMaxCol; + + if( ISNUM( 3 ) ) + { + iBottom = hb_parni( 3 ); + if( iBottom < 0 ) + iBottom = 0; + else if( iBottom > iMaxRow ) + iBottom = iMaxRow; + } + else + iBottom = iMaxRow; + + if( ISNUM( 4 ) ) + { + iRight = hb_parni( 4 ); + if( iRight < 0 ) + iRight = 0; + else if( iRight > iMaxCol ) + iRight = iMaxCol; + } + else + iRight = iMaxCol; + + if( ISNUM( 7 ) ) + iColor = hb_parni( 7 ); + else if( ISCHAR( 7 ) ) + { + iColor = hb_gtColorToN( hb_parc( 7 ) ); + if( iColor == -1 ) + iColor = hb_gtColorToN( "W/N" ); + } + else + iColor = hb_gtGetClearColor(); + + if( ISNUM( 8 ) ) + iChar = hb_parni( 8 ); + else if( ISCHAR( 8 ) ) + iChar = ( UCHAR ) hb_parc( 8 )[0]; + else + iChar = hb_gtGetClearChar(); + + hb_gtScrollEx( iTop, + iLeft, + iBottom, + iRight, + ( BYTE ) iColor, + ( BYTE ) iChar, + hb_parni( 5 ), /* Defaults to zero on bad type */ + hb_parni( 6 ) ); /* Defaults to zero on bad type */ +} diff --git a/harbour/source/rtl/tbrowse.prg b/harbour/source/rtl/tbrowse.prg index 89bc6c4a84..0305fc2ba8 100644 --- a/harbour/source/rtl/tbrowse.prg +++ b/harbour/source/rtl/tbrowse.prg @@ -572,7 +572,6 @@ METHOD scrollBuffer( nRows ) CLASS TBROWSE LOCAL nRowCount := ::rowCount LOCAL aValues, aColors - LOCAL cOldColor /* Store last scroll value to chose refresh order. [druzus] */ ::nLastScroll := nRows @@ -580,11 +579,9 @@ METHOD scrollBuffer( nRows ) CLASS TBROWSE IF nRows >= nRowCount .OR. nRows <= -nRowCount AFill( ::aCellStatus, .F. ) ELSE - cOldColor := SetColor( ::colorValue( _TBC_CLR_STANDARD ) ) - Scroll( ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ), ::n_Left, ; - ::n_Bottom - ::nFootHeight - iif( ::lFootSep, 1, 0 ), ::n_Right, ; - nRows ) - SetColor( cOldColor ) + hb_scroll( ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ), ::n_Left, ; + ::n_Bottom - ::nFootHeight - iif( ::lFootSep, 1, 0 ), ::n_Right, ; + nRows,, ::colorValue( _TBC_CLR_STANDARD ) ) IF nRows > 0 DO WHILE --nRows >= 0 aValues := ::aCellValues[ 1 ] diff --git a/harbour/source/rtl/teditor.prg b/harbour/source/rtl/teditor.prg index 598bb13f2f..d95188323a 100644 --- a/harbour/source/rtl/teditor.prg +++ b/harbour/source/rtl/teditor.prg @@ -405,7 +405,6 @@ METHOD display() CLASS HBEditor LOCAL i LOCAL nOCol := ::Col() LOCAL nORow := ::Row() - LOCAL cOldColor DispBegin() @@ -415,9 +414,7 @@ METHOD display() CLASS HBEditor // Clear rest of editor window (needed when deleting lines of text) IF ::naTextLen < ::nNumRows - cOldColor := SetColor( ::cColorSpec ) - Scroll( ::nTop + ::naTextLen, ::nLeft, ::nBottom, ::nRight ) - SetColor( cOldColor ) + hb_scroll( ::nTop + ::naTextLen, ::nLeft, ::nBottom, ::nRight,,, ::cColorSpec ) ENDIF ::SetPos( nORow, nOCol ) @@ -470,7 +467,7 @@ METHOD MoveCursor( nKey ) CLASS HBEditor ENDIF IF ::Row() == ::nBottom IF ::nRow < ::naTextLen - Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight, 1 ) + hb_scroll( ::nTop, ::nLeft, ::nBottom, ::nRight, 1 ) ::nFirstRow++ ::nRow++ ::RefreshLine() @@ -513,7 +510,7 @@ METHOD MoveCursor( nKey ) CLASS HBEditor ENDIF IF ::Row() == ::nTop IF ::nRow > 1 - Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight, -1 ) + hb_scroll( ::nTop, ::nLeft, ::nBottom, ::nRight, -1 ) ::nFirstRow-- ::nRow-- ::RefreshLine() @@ -548,7 +545,7 @@ METHOD MoveCursor( nKey ) CLASS HBEditor CASE nKey == K_RIGHT IF ::Col() == ::nRight IF ::nCol <= iif( ::lWordWrap, ::nWordWrapCol, ::LineLen( ::nRow ) ) - Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight,, 1 ) + hb_scroll( ::nTop, ::nLeft, ::nBottom, ::nRight,, 1 ) ::nFirstCol++ ::nCol++ ::RefreshColumn() @@ -570,7 +567,7 @@ METHOD MoveCursor( nKey ) CLASS HBEditor CASE nKey == K_LEFT IF ::Col() == ::nLeft IF ::nCol > 1 - Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight,, -1 ) + hb_scroll( ::nTop, ::nLeft, ::nBottom, ::nRight,, -1 ) ::nFirstCol-- ::nCol-- ::RefreshColumn() @@ -1026,14 +1023,14 @@ METHOD New( cString, nTop, nLeft, nBottom, nRight, lEditMode, nLineLength, nTabS IF ::nFirstCol > ::LineLen( ::nRow ) + 1 ::nFirstCol := ::LineLen( ::nRow ) + 1 ENDIF - + IF ( ::nFirstRow + nWndRow ) > ::naTextLen DO WHILE ( ::nFirstRow + ( --nWndRow ) ) > ::naTextLen ENDDO ENDIF // Empty area of screen which will hold editor window - Scroll( nTop, nLeft, nBottom, nRight ) + hb_scroll( nTop, nLeft, nBottom, nRight ) // Set cursor upper left corner //::SetPos( ::nTop, ::nLeft ) diff --git a/harbour/source/rtl/tgetlist.prg b/harbour/source/rtl/tgetlist.prg index 5f96121136..0bb36a995b 100644 --- a/harbour/source/rtl/tgetlist.prg +++ b/harbour/source/rtl/tgetlist.prg @@ -187,7 +187,7 @@ METHOD ReadModal() CLASS HBGetList cMsgColor := GetClrPair( SetColor(), 1 ) ENDIF - Scroll( nMsgRow, nMsgLeft, nMsgRow, nMsgRight ) + hb_scroll( nMsgRow, nMsgLeft, nMsgRow, nMsgRight ) ::cMsgSaveS := SaveScreen( nMsgRow, nMsgLeft, nMsgRow, nMsgRight ) ENDIF diff --git a/harbour/source/rtl/tlabel.prg b/harbour/source/rtl/tlabel.prg index cc8e2b4c8d..57ff3e96e0 100644 --- a/harbour/source/rtl/tlabel.prg +++ b/harbour/source/rtl/tlabel.prg @@ -332,7 +332,7 @@ METHOD SampleLabels() CLASS HBLabelForm nGetKey := Inkey( 0 ) @ Row(), Col() SAY Chr( nGetKey ) IF Row() == MaxRow() - Scroll( 0, 0, MaxRow(), MaxCol(), 1 ) + hb_scroll( 0, 0, MaxRow(), MaxCol(), 1 ) @ MaxRow(), 0 SAY "" ELSE @ Row() + 1, 0 SAY "" diff --git a/harbour/source/rtl/tmenusys.prg b/harbour/source/rtl/tmenusys.prg index 00e384d78e..adc88781b6 100644 --- a/harbour/source/rtl/tmenusys.prg +++ b/harbour/source/rtl/tmenusys.prg @@ -126,9 +126,9 @@ METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) CLA LOCAL bKeyBlock LOCAL lSubMenu - ::nOldRow := Row() - ::nOldCol := Col() - ::nOldCursor := SetCursor( SC_NONE ) + ::nOldRow := Row() + ::nOldCol := Col() + ::nOldCursor := SetCursor( SC_NONE ) ::nMsgRow := nMsgRow ::nMsgLeft := nMsgLeft @@ -143,7 +143,7 @@ METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) CLA ::cMsgColor := GetClrPair( SetColor(), 1 ) ENDIF - Scroll( ::nMsgRow, ::nMsgLeft, ::nMsgRow, ::nMsgRight ) + hb_scroll( ::nMsgRow, ::nMsgLeft, ::nMsgRow, ::nMsgRight ) ::cMsgSaveS := SaveScreen( ::nMsgRow, ::nMsgLeft, ::nMsgRow, ::nMsgRight ) @@ -327,7 +327,7 @@ METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) CLA IF ::oMenu:ClassName() == "POPUPMENU" ::oMenu:close() ENDIF - + nReturn := -1 // Bail out if at the top menu item EXIT