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

*** empty log message ***

Browse Source
This commit is contained in:
Viktor Szakats
1999-08-03 20:45:38 +00:00
parent 475be0bf98
commit 23ab7135ff
16 changed files with 267 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
harbour/ChangeLog
View File

@@ -1,3 +1,33 @@
19990803-22:30 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/gtapi.c
include/gtapi.h
+ hb_gtGetBlink() added.
(still dummy though)
* source/rtl/console.c
+ SETBLINK() added.
* source/rtl/filesys.c
source/rtl/Makefile
tests/working/curdirt.prg
tests/working/Makefile
+ CURDIR() plus test program CURDIRT added.
(Please update other makefiles accordingly)
Note that hb_fsCurDir() is not fully implemented yet,
so the test will not work like Clipper.
* source/rtl/setcolor.c
+ COLORSELECT() added.
* source/rtl/adir.prg
source/rtl/Makefile
tests/working/adirtest.prg
tests/working/Makefile
+ ADIR() plus test program ADIRTEST added.
(Please update other makefiles accordingly)
* funclist.txt
* Updated statuses
+ Added some functions (_fs*())
* doc/codestyl.txt
+ "NOTE:" Added
* tests/working/descend.prg - Byref test added.
19990803-19:00 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/achoice.prg
source/rtl/Makefile

1
harbour/doc/codestyl.txt
View File

@@ -1,5 +1,6 @@
/* Please note the following comments we may use everywhere
NOTE: Notes
TODO: something should be added here
TOFIX: something needs to be fixed
OBSOLETE: something could be removed from here

23
harbour/funclist.txt
View File

@@ -14,16 +14,16 @@
;
AADD ;R;
ABS ;R;
ACHOICE ;N;
ACHOICE ;R;
ACLONE ;R;
ACOPY ;R;
ADEL ;R;
ADIR ;N;
ADIR ;R;
AEVAL ;R;
AFIELDS ;N;
AFILL ;R;
AINS ;R;
ALERT ;N;
ALERT ;R;
ALIAS ;N;
ALLTRIM ;R;
ALTD ;N;
@@ -44,9 +44,9 @@ CDOW ;R;
CHR ;R;
CMONTH ;R;
COL ;R;
COLORSELECT ;N;
COLORSELECT ;R;
CTOD ;R;
CURDIR ;N;
CURDIR ;R;
DATE ;R;
DAY ;R;
DBAPPEND ;S;
@@ -172,7 +172,7 @@ MPOSTOLC ;N;
NETERR ;N;
NETNAME ;N;
NEXTKEY ;S;
NOSNOW ;N;
NOSNOW ;R;
OS ;S;
OUTERR ;R;
OUTSTD ;R;
@@ -208,7 +208,7 @@ SETBLINK ;N;
SETCANCEL ;N;
SETCOLOR ;S;
SETCURSOR ;N;
SETKEY ;N;
SETKEY ;R;
SETMODE ;N;
SETPOS ;R;
SETPRC ;R;
@@ -496,15 +496,22 @@ _errPutSubSystem ;R;
_errPutTries ;R;
_errRelease ;R;
; FILESYS API
_fsChDir ;R;
_fsChDrv ;R;
_fsClose ;R;
_fsCommit ;R;
_fsCreate ;R;
_fsCurDir ;S;
_fsCurDrv ;R;
_fsDelete ;R;
_fsError ;R;
_fsExtOpen ;R;
_fsExtOpen ;N;
_fsIsDrv ;R;
_fsLock ;R;
_fsMkDir ;R;
_fsOpen ;R;
_fsRead ;R;
_fsRmDir ;R;
_fsRename ;R;
_fsSeek ;R;
_fsWrite ;R;

1
harbour/include/gtapi.h
View File

@@ -56,6 +56,7 @@ extern int hb_gtColorSelect(USHORT uiColorIndex);
extern int hb_gtDispBegin(void);
extern USHORT hb_gtDispCount(void);
extern int hb_gtDispEnd(void);
extern int hb_gtGetBlink(BOOL * bBlink);
extern int hb_gtGetColorStr(char * fpColorString);
extern int hb_gtGetCursor(USHORT * uipCursorShape);
extern int hb_gtGetPos(USHORT * uipRow, USHORT * uipCol);

1
harbour/source/rtl/Makefile
View File

@@ -36,6 +36,7 @@ C_SOURCES=\
PRG_SOURCES=\
achoice.prg \
adir.prg \
alert.prg \
asort.prg \
devoutp.prg \

111
harbour/source/rtl/adir.prg Normal file
View File

@@ -0,0 +1,111 @@
/*
* $Id$
*/
/*
Harbour Project source code
Clipper compatibility function ADIR().
Copyright (C) 1999 Victor Szel <info@szelvesz.hu>
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 of the License, or
(at your option) any later version, with one exception:
The exception is that if you link the Harbour Runtime Library (HRL)
and/or the Harbour Virtual Machine (HVM) 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 HRL
and/or HVM code into it.
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 program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
their web site at http://www.gnu.org/).
*/
#include "directry.ch"
FUNCTION aDir( cFileMask, aName, aSize, aDate, aTime, aAttr )
LOCAL aDir
LOCAL nDirLen
LOCAL nDirPos
LOCAL nNameLen, nSizeLen, nDateLen, nTimeLen, nAttrLen
LOCAL aFileInfo
// ; CA-Clipper would fail on this case.
IF !( ValType( cFileMask ) == "C" )
RETURN 0
ENDIF
// ;
/* TODO: Some portable code should be added here, which would */
/* use the drive + dir from Set( _SET_DEFAULT ) if there */
/* was none specified in cFileMask */
// ;
IF ValType( aAttr ) == "A"
aDir := Directory( cFileMask, "HSD" )
ELSE
aDir := Directory( cFileMask )
ENDIF
IF Valtype( aName ) == 'A'
nNameLen := Len( aName )
ENDIF
IF Valtype( aSize ) == 'A'
nSizeLen := Len( aSize )
ENDIF
IF Valtype( aDate ) == 'A'
nDateLen := Len( aDate )
ENDIF
IF Valtype( aTime ) == 'A'
nTimeLen := Len( aTime )
ENDIF
IF Valtype( aAttr ) == 'A'
nAttrLen := Len( aAttr )
ENDIF
// ;
nDirLen := Len( aDir )
FOR nDirPos := 1 TO nDirLen
aFileInfo := aDir[ nDirPos ]
IF nNameLen != NIL .AND. nNameLen >= nDirPos
aName[ nDirPos ] := aFileInfo[ F_NAME ]
ENDIF
IF nSizeLen != NIL .AND. nSizeLen >= nDirPos
aSize[ nDirPos ] := aFileInfo[ F_SIZE ]
ENDIF
IF nDateLen != NIL .AND. nDateLen >= nDirPos
aDate[ nDirPos ] := aFileInfo[ F_DATE ]
ENDIF
IF nTimeLen != NIL .AND. nTimeLen >= nDirPos
aTime[ nDirPos ] := aFileInfo[ F_TIME ]
ENDIF
IF nAttrLen != NIL .AND. nAttrLen >= nDirPos
aAttr[ nDirPos ] := aFileInfo[ F_ATTR ]
ENDIF
NEXT
RETURN nDirLen

19
harbour/source/rtl/console.c
View File

@@ -88,6 +88,7 @@ HARBOUR HB_ROW( void );
HARBOUR HB_SCROLL( void );
HARBOUR HB_SAVESCREEN( void );
HARBOUR HB_SETCURSOR( void );
HARBOUR HB_SETBLINK( void );
HARBOUR HB_SETPOS( void );
HARBOUR HB_SETPRC( void );
HARBOUR HB_SHADOW( void );
@@ -115,6 +116,7 @@ HB_INIT_SYMBOLS_BEGIN( Console__InitSymbols )
{ "SCROLL" , FS_PUBLIC, HB_SCROLL , 0 },
{ "SAVESCREEN", FS_PUBLIC, HB_SAVESCREEN, 0 },
{ "SETCURSOR" , FS_PUBLIC, HB_SETCURSOR , 0 },
{ "SETBLINK" , FS_PUBLIC, HB_SETBLINK , 0 },
{ "SETPOS" , FS_PUBLIC, HB_SETPOS , 0 },
{ "SETPRC" , FS_PUBLIC, HB_SETPRC , 0 },
{ "SHADOW" , FS_PUBLIC, HB_SHADOW , 0 },
@@ -943,7 +945,7 @@ HARBOUR HB_ISCOLOR (void)
HARBOUR HB_NOSNOW (void)
{
#ifdef HARBOUR_USE_GTAPI
if (ISLOG(1))
if ( ISLOG( 1 ) )
{
hb_gtSetSnowFlag(hb_parl(1));
}
@@ -1030,6 +1032,21 @@ HARBOUR HB_SETCURSOR( void )
#endif
}
HARBOUR HB_SETBLINK( void )
{
#ifdef HARBOUR_USE_GTAPI
BOOL bPreviousBlink;
hb_gtGetBlink( &bPreviousBlink );
if ( ISLOG( 1 ) )
hb_gtSetBlink( hb_parl( 1 ) );
hb_retl( bPreviousBlink );
#else
hb_retl( FALSE );
#endif
}
HARBOUR HB___ACCEPT( void ) /* Internal Clipper function used in ACCEPT command */
/* Basically the simplest Clipper function to */
/* receive data. Parameter : cPrompt. Returns : cRet */

13
harbour/source/rtl/filesys.c
View File

@@ -3,6 +3,7 @@
*/
#include <string.h>
#include <ctype.h>
#include "extend.h"
#include "init.h"
#include "filesys.h"
@@ -133,6 +134,7 @@ HARBOUR HB_FREADSTR( void );
HARBOUR HB_FRENAME( void );
HARBOUR HB_FSEEK( void );
HARBOUR HB_FWRITE( void );
HARBOUR HB_CURDIR( void );
HARBOUR HB_I2BIN( void );
HARBOUR HB_L2BIN( void );
HARBOUR HB_W2BIN( void );
@@ -151,6 +153,7 @@ HB_INIT_SYMBOLS_BEGIN( Files__InitSymbols )
{ "FREADSTR", FS_PUBLIC, HB_FREADSTR, 0 },
{ "FSEEK" , FS_PUBLIC, HB_FSEEK , 0 },
{ "FWRITE" , FS_PUBLIC, HB_FWRITE , 0 },
{ "CURDIR" , FS_PUBLIC, HB_CURDIR , 0 },
{ "I2BIN" , FS_PUBLIC, HB_I2BIN , 0 },
{ "L2BIN" , FS_PUBLIC, HB_L2BIN , 0 },
{ "W2BIN" , FS_PUBLIC, HB_W2BIN , 0 }
@@ -511,6 +514,8 @@ BYTEP hb_fsCurDir ( USHORT uiDrive )
return (BYTEP)cwd_buff;
}
/* TODO: Implement nDrive */
USHORT hb_fsChDrv ( BYTEP nDrive )
{
USHORT result;
@@ -781,6 +786,14 @@ HARBOUR HB_FREADSTR( void )
return;
}
/* NOTE: This function should not return the leading and trailing */
/* (back)slashes. */
HARBOUR HB_CURDIR( void )
{
hb_retc( hb_fsCurDir( ( ISCHAR( 1 ) && hb_parclen( 1 ) ) ? (USHORT)( toupper( *hb_parc( 1 ) ) - 'A' + 1 ) : 0 ) );
}
HARBOUR HB_BIN2I( void )
{
PHB_ITEM arg1_it = hb_param( 1, IT_STRING );

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

@@ -60,6 +60,7 @@
/* TODO: functions not implemented yet
int hb_gtPostExt(void);
int hb_gtPreExt(void);
int hb_gtGetBlink(BOOL * bBlink);
int hb_gtSetBlink(BOOL bBlink);
int hb_gtSetMode(USHORT uiRows, USHORT uiCols);
*/
@@ -576,6 +577,13 @@ int hb_gtScrDim(USHORT * uipHeight, USHORT * uipWidth)
return(0);
}
int hb_gtGetBlink(BOOL * bBlink)
{
*bBlink = FALSE;
return ( 0 );
}
int hb_gtSetBlink(BOOL bBlink)
{
HB_SYMBOL_UNUSED( bBlink );

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

@@ -58,9 +58,11 @@ char *hb_setColor( char *sColor )
}
HARBOUR HB_SETCOLOR( void );
HARBOUR HB_COLORSELECT( void );
HB_INIT_SYMBOLS_BEGIN( SETCOLOR__InitSymbols )
{ "SETCOLOR", FS_PUBLIC, HB_SETCOLOR, 0 }
{ "SETCOLOR" , FS_PUBLIC, HB_SETCOLOR , 0 },
{ "COLORSELECT" , FS_PUBLIC, HB_COLORSELECT, 0 }
HB_INIT_SYMBOLS_END( SETCOLOR__InitSymbols );
#if ! defined(__GNUC__)
#pragma startup SETCOLOR__InitSymbols
@@ -70,3 +72,9 @@ HARBOUR HB_SETCOLOR( void )
{
hb_retc( hb_setColor( hb_pcount() ? hb_parc(1) : NULL ) );
}
HARBOUR HB_COLORSELECT( void )
{
if (ISNUM(1))
hb_gtColorSelect( hb_parni(1) );
}

2
harbour/tests/working/Makefile
View File

@@ -17,6 +17,7 @@ endif
ifeq ($(PM),) # PM not defined = build all files
PRG_SOURCES=\
ac_test.prg \
adirtest.prg \
ainstest.prg \
and_or.prg \
array16.prg \
@@ -39,6 +40,7 @@ PRG_SOURCES=\
codebloc.prg \
comments.prg \
copyfile.prg \
curdirt.prg \
dates.prg \
dates2.prg \
dates3.prg \

4
harbour/tests/working/ac_test.prg
View File

@@ -1,3 +1,7 @@
/*
* $Id$
*/
*+====================================================================
*+
*+ Source Module => E:\MULTI\AC_TEST.PRG

34
harbour/tests/working/adirtest.prg Normal file
View File

@@ -0,0 +1,34 @@
/*
* $Id$
*/
FUNCTION Main()
TestIt( "*.*" )
TestIt( "\" )
TestIt( "..\" )
TestIt( "..\*.*" )
RETURN NIL
STATIC FUNCTION TestIt( cSpec )
LOCAL a := ADIR( cSpec )
LOCAL a1 := Array(a)
LOCAL a2 := 10
LOCAL a3 := Array(a - 1)
LOCAL a4 := NIL
LOCAL a5 := Array(a + 1)
OutStd( "--------------------------------------------------------" )
OutStd( Chr(13) + Chr(10) )
ADIR( cSpec , a1, a2, a3, a4, a5)
aEval(a1, {|tmp| OutStd( tmp ), OutStd( Chr(13) + Chr(10) ) })
aEval(a3, {|tmp| OutStd( tmp ), OutStd( Chr(13) + Chr(10) ) })
aEval(a5, {|tmp| OutStd( tmp ), OutStd( Chr(13) + Chr(10) ) })
RETURN NIL

13
harbour/tests/working/curdirt.prg Normal file
View File

@@ -0,0 +1,13 @@
/*
* $Id$
*/
FUNCTION Main()
OutStd( CurDir() + Chr(13) + Chr(10) )
OutStd( CurDir("C") + Chr(13) + Chr(10) )
OutStd( CurDir("C:") + Chr(13) + Chr(10) )
OutStd( CurDir("D:") + Chr(13) + Chr(10) )
OutStd( CurDir("A") + Chr(13) + Chr(10) )
RETURN NIL

4
harbour/tests/working/descend.prg
View File

@@ -7,7 +7,11 @@
function main()
LOCAL dDate
LOCAL cString
cString := "HARBOUR POWER & MAGIC"
OutSpec( Descend( cString ) )
OutSpec( Descend( &cString ) )
OutSpec( Descend( "HARBOUR POWER & MAGIC" ) )
OutSpec( Descend( Descend( "HARBOUR POWER & MAGIC" ) ) )
OutSpec( Descend( .f. ) )

6
harbour/tests/working/rtl_test.prg
View File

@@ -1,6 +1,6 @@
//
// $Id$
//
/*
* $Id$
*/
/*
Harbour Project source code