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

2008-10-11 04:56 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* 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.
This commit is contained in:
Przemyslaw Czerpak
2008-10-11 02:56:22 +00:00
parent 9113680b5a
commit 618df79c9b
14 changed files with 200 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
harbour/ChangeLog
View File

@@ -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

2
harbour/include/hbapigt.h
View File

@@ -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 );

4
harbour/source/rtl/achoice.prg
View File

@@ -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

34
harbour/source/rtl/gtapi.c
View File

@@ -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;

10
harbour/source/rtl/gtfunc.c
View File

@@ -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();
}

29
harbour/source/rtl/listbox.prg
View File

@@ -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++

13
harbour/source/rtl/memoedit.prg
View File

@@ -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 )

2
harbour/source/rtl/profiler.prg
View File

@@ -149,7 +149,7 @@ PROCEDURE Main()
STATIC PROCEDURE DrawScreen( cTitle )
Scroll()
CLEAR SCREEN
@ 0, 0 SAY PadR( cTitle, MaxCol() + 1 ) COLOR "N/W"

76
harbour/source/rtl/scroll.c
View File

@@ -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 */
}

9
harbour/source/rtl/tbrowse.prg
View File

@@ -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 ]

17
harbour/source/rtl/teditor.prg
View File

@@ -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 )

2
harbour/source/rtl/tgetlist.prg
View File

@@ -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

2
harbour/source/rtl/tlabel.prg
View File

@@ -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 ""

10
harbour/source/rtl/tmenusys.prg
View File

@@ -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