diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 810db2f6fc..85b61a65ef 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,37 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +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 diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index 032d3e4430..be8a8df2eb 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -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 \ diff --git a/harbour/contrib/libct/ctmisc.prg b/harbour/contrib/libct/ctmisc.prg index 39ff1fbd17..275b475411 100644 --- a/harbour/contrib/libct/ctmisc.prg +++ b/harbour/contrib/libct/ctmisc.prg @@ -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 diff --git a/harbour/contrib/libct/getinfo.prg b/harbour/contrib/libct/getinfo.prg new file mode 100644 index 0000000000..821e0eca12 --- /dev/null +++ b/harbour/contrib/libct/getinfo.prg @@ -0,0 +1,100 @@ +/* + * $Id$ + */ +/* + * xHarbour Project source code: + * CT3 GET/READ Functions + * + * SAVEGETS(), RESTGETS() + * Copyright 1999-2001 Viktor Szakats + * www - http://www.harbour-project.org + * + * COUNTGETS(), CURRENTGET(), GETFLDROW(), GETFLDCOL(), GETFLDVAR() + * Copyright 2004 Philip Chee + * + * 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 ) diff --git a/harbour/contrib/libct/getinput.prg b/harbour/contrib/libct/getinput.prg new file mode 100644 index 0000000000..38f70c46c2 --- /dev/null +++ b/harbour/contrib/libct/getinput.prg @@ -0,0 +1,90 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 GET function: + * + * GETINPUT() + * + * Copyright 2007 Przemyslaw Czerpak + * + * 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 diff --git a/harbour/contrib/libct/getsecrt.prg b/harbour/contrib/libct/getsecrt.prg new file mode 100644 index 0000000000..0ae8ce547b --- /dev/null +++ b/harbour/contrib/libct/getsecrt.prg @@ -0,0 +1,153 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 GET function: + * + * GETSECRET() + * + * Copyright 2007 Przemyslaw Czerpak + * + * 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 diff --git a/harbour/contrib/libct/keysave.prg b/harbour/contrib/libct/keysave.prg new file mode 100644 index 0000000000..112f8b0fac --- /dev/null +++ b/harbour/contrib/libct/keysave.prg @@ -0,0 +1,57 @@ +/* + * $Id$ + */ +/* + * xHarbour Project source code: + * CT3 SETKEY Functions + * + * SAVESETKEY(), RESTSETKEY() + * Copyright 2004 Philip Chee + * + * 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. diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index 561d157e58..1b790b8497 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -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$@ diff --git a/harbour/contrib/libct/makefile.vc b/harbour/contrib/libct/makefile.vc index e3022837c4..9183d7e2f1 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -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) diff --git a/harbour/contrib/libct/screen2.c b/harbour/contrib/libct/screen2.c index 5cb4e0578f..1603d87686 100644 --- a/harbour/contrib/libct/screen2.c +++ b/harbour/contrib/libct/screen2.c @@ -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;