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

2007-08-05 11:55 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/contrib/libct/screen2.c
    + added CLEARSLOW()

  + harbour/contrib/libct/getsecrt.prg
    + added GETSECRET()

  + harbour/contrib/libct/getinput.prg
    + added GETINPUT()

  * harbour/contrib/libct/ctmisc.prg
    * moved SAVEGETS() and RESTGETS() to getinfo.prg file

  + harbour/contrib/libct/getinfo.prg
    + added COUNTGETS(), CURRENTGET(), GETFLDROW(), GETFLDCOL(), GETFLDVAR()
      modified code by Philip Chee borrowed from xHarbour
    + added SAVEGETS() and RESTGETS() from ctmisc.prg

  + harbour/contrib/libct/keysave.prg
    + SAVESETKEY(), RESTSETKEY() - code by Philip Chee borrowed from
      xHarbour

  * harbour/contrib/libct/Makefile
  * harbour/contrib/libct/makefile.bc
  * harbour/contrib/libct/makefile.vc
    * updated for new files

  * harbour/contrib/libct/screen3.prg
  * harbour/contrib/libct/showtime.prg
    * set svn:eol-style=native
This commit is contained in:
Przemyslaw Czerpak
2007-08-05 09:55:33 +00:00
parent 2ea0971336
commit 9fe0fff8ed
10 changed files with 559 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
harbour/ChangeLog
View File

@@ -8,6 +8,37 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-08-05 11:55 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/contrib/libct/screen2.c
+ added CLEARSLOW()
+ harbour/contrib/libct/getsecrt.prg
+ added GETSECRET()
+ harbour/contrib/libct/getinput.prg
+ added GETINPUT()
* harbour/contrib/libct/ctmisc.prg
* moved SAVEGETS() and RESTGETS() to getinfo.prg file
+ harbour/contrib/libct/getinfo.prg
+ added COUNTGETS(), CURRENTGET(), GETFLDROW(), GETFLDCOL(), GETFLDVAR()
modified code by Philip Chee borrowed from xHarbour
+ added SAVEGETS() and RESTGETS() from ctmisc.prg
+ harbour/contrib/libct/keysave.prg
+ SAVESETKEY(), RESTSETKEY() - code by Philip Chee borrowed from
xHarbour
* harbour/contrib/libct/Makefile
* harbour/contrib/libct/makefile.bc
* harbour/contrib/libct/makefile.vc
* updated for new files
* harbour/contrib/libct/screen3.prg
* harbour/contrib/libct/showtime.prg
* set svn:eol-style=native
2007-08-03 23:25 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
- harbour/debian/rules.cf
+ harbour/debian/rules

4
harbour/contrib/libct/Makefile
View File

@@ -83,6 +83,10 @@ PRG_SOURCES= \
ct.prg \
ctmisc.prg \
cttime.prg \
getinfo.prg \
getinput.prg \
getsecrt.prg \
keysave.prg \
numconv.prg \
screen3.prg \
showtime.prg \

13
harbour/contrib/libct/ctmisc.prg
View File

@@ -86,19 +86,6 @@ FUNCTION CSETCENT( nCentury )
FUNCTION LTOC( l )
RETURN iif( l, "T", "F" )
FUNCTION RESTGETS( aGetList )
GetList := aGetList
RETURN .T.
FUNCTION SAVEGETS()
LOCAL aGetList := GetList
GetList := {}
RETURN aGetList
FUNCTION DOSPARAM
LOCAL cRet := ""
LOCAL nCount := HB_ARGC(), i

100
harbour/contrib/libct/getinfo.prg Normal file
View File

@@ -0,0 +1,100 @@
/*
* $Id$
*/
/*
* xHarbour Project source code:
* CT3 GET/READ Functions
*
* SAVEGETS(), RESTGETS()
* Copyright 1999-2001 Viktor Szakats <viktor.szakats@syenar.hu>
* www - http://www.harbour-project.org
*
* COUNTGETS(), CURRENTGET(), GETFLDROW(), GETFLDCOL(), GETFLDVAR()
* Copyright 2004 Philip Chee <philip@aleytys.pc.my>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* 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.
*
*/
#include "common.ch"
MEMVAR GetList
FUNCTION SAVEGETS()
LOCAL aGetList := GetList
GetList := {}
RETURN aGetList
FUNCTION RESTGETS( aGetList )
RETURN ( GetList := aGetList ) <> NIL
FUNCTION COUNTGETS()
RETURN LEN( GetList )
FUNCTION CURRENTGET()
LOCAL oActive := GetActive()
RETURN ASCAN( GetList, {|oGet| oGet == oActive } )
FUNCTION GETFLDROW( nField )
LOCAL oGet
IF !ISNUMBER( nField )
oGet := GetActive()
ELSEIF nField >= 1 .AND. nField <= LEN( GetList )
oGet := GetList[ nField ]
ENDIF
RETURN IIF( oGet != NIL, oGet:Row, -1 )
FUNCTION GETFLDCOL( nField )
LOCAL oGet
IF !ISNUMBER( nField )
oGet := GetActive()
ELSEIF nField >= 1 .AND. nField <= LEN( GetList )
oGet := GetList[ nField ]
ENDIF
RETURN IIF( oGet != NIL, oGet:Col, -1 )
FUNCTION GETFLDVAR( nField )
LOCAL oGet
IF !ISNUMBER( nField )
oGet := GetActive()
ELSEIF nField >= 1 .AND. nField <= LEN( GetList )
oGet := GetList[ nField ]
ENDIF
RETURN IIF( oGet != NIL, oGet:Name, -1 )

90
harbour/contrib/libct/getinput.prg Normal file
View File

@@ -0,0 +1,90 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 GET function:
*
* GETINPUT()
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* 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.
*
*/
#include "common.ch"
FUNCTION GETINPUT( xVar, nRow, nCol, lSay, xPrompt )
LOCAL nCursorRow := ROW()
LOCAL nCursorCol := COL()
LOCAL GetList := {}
IF !ISNUMBER( nRow )
nRow := ROW()
ENDIF
IF !ISNUMBER( nCol )
nCol := COL()
ENDIF
IF !ISLOGICAL( lSay )
lSay := .F.
ENDIF
SETPOS( nRow, nCol )
IF xPrompt <> Nil
DEVOUT( xPrompt )
nRow := ROW()
nCol := COL() + 1
ENDIF
@ nRow, nCol GET xVar
READ
IF lSay
SETPOS( nRow, nCol )
DEVOUT( xVar )
ENDIF
SETPOS( nCursorRow, nCursorCol )
RETURN xVar

153
harbour/contrib/libct/getsecrt.prg Normal file
View File

@@ -0,0 +1,153 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 GET function:
*
* GETSECRET()
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* 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.
*
*/
#include "common.ch"
#include "getexit.ch"
FUNCTION GETSECRET( cVar, nRow, nCol, lSay, xPrompt )
LOCAL nCursorRow := ROW()
LOCAL nCursorCol := COL()
LOCAL GetList := {}
LOCAL _cGetSecret := cVar
LOCAL lHide := .T.
IF !ISNUMBER( nRow )
nRow := ROW()
ENDIF
IF !ISNUMBER( nCol )
nCol := COL()
ENDIF
IF !ISLOGICAL( lSay )
lSay := .F.
ENDIF
SETPOS( nRow, nCol )
IF xPrompt <> Nil
DEVOUT( xPrompt )
nRow := ROW()
nCol := COL() + 1
ENDIF
SETPOS( nRow, nCol )
AADD( GetList, _GET_( _CGETSECRET, "_CGETSECRET",,, ) )
ATAIL( GetList ):reader := { |oGet, oGetList| _SECRET( @_cGetSecret, @lHide, ;
oGet, oGetList ) }
ATAIL( GetList ):block := { |xNew| _VALUE( @_cGetSecret, lHide, xNew ) }
READ
IF lSay
SETPOS( nRow, nCol )
DEVOUT( _HIDE( _cGetSecret ) )
ENDIF
SETPOS( nCursorRow, nCursorCol )
RETURN _cGetSecret
STATIC FUNCTION _HIDE( cVar )
RETURN RANGEREPL( ASC( " " ) + 1, 255, cVar, "*" )
STATIC FUNCTION _VALUE( cVar, lHide, xNew )
IF lHide
RETURN _HIDE( cVar )
ELSEIF xNew != NIL
cVar := PADR( xNew, LEN( cVar ) )
ENDIF
RETURN cVar
STATIC PROCEDURE _SECRET( _cGetSecret, lHide, oGet, oGetList )
LOCAL nKey, nLen, bKeyBlock
IF oGetList == NIL
oGetList := __GetListActive()
ENDIF
IF GetPreValidate( oGet )
nLen := LEN( _cGetSecret )
oGet:SetFocus()
DO WHILE oGet:exitState == GE_NOEXIT
IF oGet:typeOut
oGet:exitState := GE_ENTER
ENDIF
DO WHILE oGet:exitState == GE_NOEXIT
nKey := INKEY( 0 )
IF ( bKeyBlock := SETKEY( nKey ) ) != NIL
lHide := .F.
EVAL( bKeyBlock, oGetList:cReadProcName, ;
oGetList:nReadProcLine, oGetList:ReadVar() )
lHide := .T.
LOOP
ELSEIF nKey >= 32 .AND. nKey <= 255
IF SET( _SET_INSERT )
_cGetSecret := STUFF( LEFT( _cGetSecret, nLen - 1), ;
oGet:pos, 0, CHR( nKey ) )
ELSE
_cGetSecret := STUFF( _cGetSecret, oGet:pos, 1, CHR( nKey ) )
ENDIF
nKey := ASC( "*" )
ENDIF
GetApplyKey( oGet, nKey )
ENDDO
IF !GetPostValidate( oGet )
oGet:exitState := GE_NOEXIT
ENDIF
ENDDO
oGet:KillFocus()
ENDIF
RETURN

57
harbour/contrib/libct/keysave.prg Normal file
View File

@@ -0,0 +1,57 @@
/*
* $Id$
*/
/*
* xHarbour Project source code:
* CT3 SETKEY Functions
*
* SAVESETKEY(), RESTSETKEY()
* Copyright 2004 Philip Chee <philip@aleytys.pc.my>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* 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.
*
*/
FUNCTION SAVESETKEY()
RETURN HB_SETKEYSAVE()
FUNCTION RESTSETKEY( aSavedTraps )
HB_SETKEYSAVE( aSavedTraps )
RETURN .T.

32
harbour/contrib/libct/makefile.bc
View File

@@ -165,6 +165,10 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\ct.obj \
$(OBJ_DIR)\ctmisc.obj \
$(OBJ_DIR)\cttime.obj \
$(OBJ_DIR)\getinfo.obj \
$(OBJ_DIR)\getinput.obj \
$(OBJ_DIR)\getsecrt.obj \
$(OBJ_DIR)\keysave.obj \
$(OBJ_DIR)\numconv.obj \
$(OBJ_DIR)\screen3.obj \
$(OBJ_DIR)\showtime.obj \
@@ -491,6 +495,34 @@ $(OBJ_DIR)\cttime.obj : $(OBJ_DIR)\cttime.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\getinfo.c : $(TOOLS_DIR)\getinfo.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\getinfo.obj : $(OBJ_DIR)\getinfo.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\getinput.c : $(TOOLS_DIR)\getinput.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\getinput.obj : $(OBJ_DIR)\getinput.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\getsecrt.c : $(TOOLS_DIR)\getsecrt.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\getsecrt.obj : $(OBJ_DIR)\getsecrt.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\keysave.c : $(TOOLS_DIR)\keysave.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\keysave.obj : $(OBJ_DIR)\keysave.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\numconv.c : $(TOOLS_DIR)\numconv.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@

8
harbour/contrib/libct/makefile.vc
View File

@@ -183,6 +183,10 @@ TOOLS_LIB_OBJS = \
\
$(OBJ_DIR)\ct.obj \
$(OBJ_DIR)\ctmisc.obj \
$(OBJ_DIR)\getinfo.obj \
$(OBJ_DIR)\getinput.obj \
$(OBJ_DIR)\getsecrt.obj \
$(OBJ_DIR)\keysave.obj \
$(OBJ_DIR)\numconv.obj \
$(OBJ_DIR)\screen3.obj \
$(OBJ_DIR)\showtime.obj \
@@ -266,6 +270,10 @@ CLEAN:
-@if exist $(OBJ_DIR)\wordtoch.* del $(OBJ_DIR)\wordtoch.*
-@if exist $(OBJ_DIR)\ct.* del $(OBJ_DIR)\ct.*
-@if exist $(OBJ_DIR)\ctmisc.* del $(OBJ_DIR)\ctmisc.*
-@if exist $(OBJ_DIR)\getinfo.* del $(OBJ_DIR)\getinfo.*
-@if exist $(OBJ_DIR)\getinput.* del $(OBJ_DIR)\getinput.*
-@if exist $(OBJ_DIR)\getsecrt.* del $(OBJ_DIR)\getsecrt.*
-@if exist $(OBJ_DIR)\keysave.* del $(OBJ_DIR)\keysave.*
-@if exist $(OBJ_DIR)\numconv.* del $(OBJ_DIR)\numconv.*
-@if exist $(TOOLS_LIB) del $(TOOLS_LIB)

84
harbour/contrib/libct/screen2.c
View File

@@ -226,6 +226,90 @@ HB_FUNC( SAYMOVEIN )
hb_retc( NULL );
}
HB_FUNC( CLEARSLOW )
{
int iMaxRow = hb_gtMaxRow();
int iMaxCol = hb_gtMaxCol();
int iTop, iLeft, iBottom, iRight;
UCHAR ucChar;
long lDelay;
lDelay = hb_parnl( 1 );
iTop = hb_parni( 2 );
iLeft = hb_parni( 3 );
iBottom = ISNUM( 4 ) ? hb_parni( 4 ) : iMaxRow;
iRight = ISNUM( 5 ) ? hb_parni( 5 ) : iMaxCol;
if( ISNUM( 6 ) )
ucChar = ( UCHAR ) hb_parni( 6 );
else if( ISCHAR( 6 ) )
ucChar = ( UCHAR ) hb_parc( 6 )[0];
else
ucChar = ( UCHAR ) hb_gt_GetClearChar();
if( iTop >= 0 && iLeft >= 0 && iTop <= iBottom && iLeft <= iRight )
{
BYTE pbFrame[2], bColor = ( BYTE ) hb_gt_GetColor();
double dX, dY, dXX, dYY;
pbFrame[0] = ucChar;
pbFrame[1] = '\0';
dX = iRight - iLeft + 1;
dY = iBottom - iTop + 1;
if( dX > dY )
{
dY /= dX;
dX = 1;
}
else
{
dX /= dY;
dY = 1;
}
dXX = dYY = 0;
hb_gtBeginWrite();
while( TRUE )
{
hb_gt_Box( iTop, iLeft, iBottom, iRight, pbFrame, bColor );
if( lDelay )
{
hb_gtEndWrite();
hb_idleSleep( ( double ) lDelay / 1000 );
hb_gtBeginWrite();
}
if( iTop >= iBottom && iLeft >= iRight )
break;
if( iTop < iBottom )
{
dYY += dY;
if( dYY >= 1 )
{
iTop++;
if( iBottom > iTop )
iBottom--;
dYY -= 1;
}
}
if( iLeft < iRight )
{
dXX += dX;
if( dXX >= 1 )
{
iLeft++;
if( iRight > iLeft )
iRight--;
}
}
}
hb_gtEndWrite();
}
}
HB_FUNC( SCREENSTR )
{
SHORT sRow, sCol, sMaxRow, sMaxCol, sC;