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

See ChangeLog entry 19990811-11:35 EDT David G. Holm <dholm@jsd-llc.com>

Browse Source
This commit is contained in:
David G. Holm
1999-08-11 15:56:57 +00:00
parent dbd5f3b7a3
commit 4f6c83bb64
8 changed files with 369 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
harbour/ChangeLog
View File

@@ -1,3 +1,26 @@
19990811-11:35 EDT David G. Holm <dholm@jsd-llc.com>
* doc/gmake.txt
+ Added a new section under 'NOTES' discussing how to build only
parts of Harbour, with examples for Harbour only and tests only
and how to build a single test file using the DOS build.bat file.
* source/rtl/console.c
! Corrected #ifdef blocks for unistd.h and io.h.
! Added code to remove newline in Unix compatible ACCEPT() code,
per Georg Lehner <jorge_lehner@gmx.net>.
* source/rtl/setkey.prg
* New version from April White <awhite@user.rose.com>.
* source/rtl/gt/gtdos.c
+ Added DJGPP compatible GTAPI handling, but not sure how to deal
with dispbegin()/dispend(). Need to add cursor handling.
* source/rtl/gt/gtos2.c
! Changed DWORD to ULONG.
* tests/working/Makefile
! Added new setkey test program (as BAD, because no GETACTIVE()).
+ tests/working/setkey.prg
+ New test program from April White <awhite@user.rose.com>.
Note: Needs a working get system and needs SetKeyCheck()
integrated into the appropriate Harbour input functions.
19990810-00:55 EDT Paul Tucker <ptucker@sympatico.ca>
* source/rtl/gtapi.c source/rtl/gt/gtwin/c source/rtl/gt/gt_tpl.c
* minor formatting changes

14
harbour/doc/gmake.txt
View File

@@ -207,4 +207,16 @@ Harbour source code.
The -r option isn't strictly necessary, but it does signficantly reduce
the number of rules that make has to evaluate otherwise, which may give
a big performance boost on a slow system.
a performance boost on a slow system.
To rebuild only a part of Harbour, go to the appropriate source directory
and then run 'make -r'. For example, to rebuild all of Harbour, but not
the test programs, change to the 'source' directory. To rebuild only the
test programs, change to the 'test' directory.
If you are using a DOS-based operating system, then you can build any
program in tests/working by using the build batch file. For example,
'build scroll' will rebuild the scroll.prg module. This can also be used
for modules that aren't in the Makefile.

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

@@ -54,14 +54,14 @@
#include "set.h"
#include "inkey.h"
#if defined(__GNUC__) && ! defined(__DJGPP__)
#if defined(__GNUC__)
#include <unistd.h>
#if defined(__DJGPP__) || defined(__CYGWIN__) || defined(HARBOUR_GCC_OS2)
#include <io.h>
#endif
#else
#include <io.h>
#endif
#if defined(__CYGWIN__)
#include <io.h>
#endif
#include <fcntl.h>
#include "gtapi.h" /* HARBOUR_USE_GTAPI is checked inside gtapi.h, so that
we can always get the border styles */
@@ -1076,8 +1076,13 @@ HARBOUR HB___ACCEPT( void ) /* Internal Clipper function used in ACCEPT command
}
#ifdef OS_UNIX_COMPATIBLE
/* Read the data using fgets(), because hb_inkeyPoll() doesn't support
Unix compatible operating systems yet. */
fgets( szResult, ACCEPT_BUFFER_LEN, stdin );
Unix compatible operating systems yet. */
szResult[0] = `\0`; /* start with something defined */
if (fgets( szResult, ACCEPT_BUFFER_LEN, stdin ))
{
strtok(szResult, "\n"); /* strip off the trailing newline
if it exists */
}
#else
len = 0;
input = 0;

114
harbour/source/rtl/gt/gtdos.c
View File

@@ -17,19 +17,22 @@
#if defined(__POWERC) || (defined(__TURBOC__) && !defined(__BORLANDC__)) || \
(defined(__ZTC__) && !defined(__SC__))
#define FAR far
#define FAR far
#elif (defined(__MSDOS__) || defined(MSDOS) || defined(DOS)) && !defined(__DJGPP__)
#define FAR _far
#else
#if defined(__MSDOS__) || defined(MSDOS) || defined(DOS)
#define FAR _far
#else
#define FAR
#endif
#define FAR
#endif
#ifdef __DJGPP__
#include <conio.h>
#include <sys/farptr.h>
#else
#ifndef MK_FP
#define MK_FP(seg,off) \
((void FAR *)(((unsigned long)(seg) << 16)|(unsigned)(off)))
#endif
#endif
static void hb_gt_xGetXY(char cRow, char cCol, char *attr, char *ch);
static void hb_gt_xPutch(char cRow, char cCol, char attr, char ch);
@@ -39,16 +42,22 @@ static void hb_gt_SetCursorSize(char start, char end);
static void hb_gt_GetCursorSize(char *start, char *end);
#if defined(__WATCOMC__) && defined(__386__)
#define FAR
#define FAR
#endif
#ifndef __DJGPP__
static char FAR *scrnPtr;
static char FAR *scrnStealth;
static char FAR *hb_gt_ScreenAddress(void);
#endif
static char FAR *scrnPtr;
static char FAR *scrnStealth;
static char FAR *hb_gt_ScreenAddress(void);
void hb_gt_Init(void)
{
#ifdef __DJGPP__
gppconio_init();
#else
scrnStealth = (char *)-1;
scrnPtr = hb_gt_ScreenAddress();
#endif
}
void hb_gt_Done(void)
@@ -60,12 +69,12 @@ int hb_gt_IsColor(void)
return hb_gt_GetScreenMode() != 7;
}
#ifndef __DJGPP__
static char FAR *hb_gt_ScreenAddress()
{
char FAR *ptr;
#if defined(__WATCOMC__) && defined(__386__)
#if defined(__WATCOMC__) && defined(__386__)
if (hb_gt_IsColor())
{
ptr = (char *)(0xB800 << 4);
@@ -74,7 +83,7 @@ static char FAR *hb_gt_ScreenAddress()
{
ptr = (char *)(0xB000 << 4);
}
#else
#else
if (hb_gt_IsColor())
{
ptr = (char FAR *)MK_FP(0xB800, 0x0000);
@@ -83,20 +92,25 @@ static char FAR *hb_gt_ScreenAddress()
{
ptr = (char FAR *)MK_FP(0xB000, 0x0000);
}
#endif
#endif
return ptr;
}
#endif
#ifndef __DJGPP__
char FAR *hb_gt_ScreenPtr(char cRow, char cCol)
{
return scrnPtr + (cRow * hb_gt_GetScreenWidth() * 2) + (cCol * 2);
}
#endif
static char hb_gt_GetScreenMode(void)
{
#if defined(__WATCOMC__) && defined(__386__)
return *((char *)0x0449);
#elif defined(__DJGPP__)
return _farpeekb( 0x0040, 0x0049 );
#else
return *((char FAR *)MK_FP(0x0040, 0x0049));
#endif
@@ -106,6 +120,8 @@ char hb_gt_GetScreenWidth(void)
{
#if defined(__WATCOMC__) && defined(__386__)
return *((char *)0x044a);
#elif defined(__DJGPP__)
return _farpeekb( 0x0040, 0x004a );
#else
return *((char FAR *)MK_FP(0x0040, 0x004a));
#endif
@@ -115,6 +131,8 @@ char hb_gt_GetScreenHeight(void)
{
#if defined(__WATCOMC__) && defined(__386__)
return (char)(*((char *)0x0484) + 1);
#elif defined(__DJGPP__)
return _farpeekb( 0x0040, 0x0084 ) + 1;
#else
return (char)(*((char FAR *)MK_FP(0x0040, 0x0084)) + 1);
#endif
@@ -164,7 +182,6 @@ static void hb_gt_SetCursorSize(char start, char end)
static void hb_gt_GetCursorSize(char *start, char *end)
{
char _ch,_cl;
#if defined(__TURBOC__)
_AH = 0x03;
_BH = 0;
@@ -251,35 +268,86 @@ void hb_gt_SetCursorStyle(int style)
static void hb_gt_xGetXY(char cRow, char cCol, char *attr, char *ch)
{
#ifdef __DJGPP__
short ch_attr;
gettext( cCol + 1, cRow + 1, cCol + 1, cRow + 1, &ch_attr );
*ch = ch_attr >> 8;
*attr = ch_attr & 0xFF;
///printf("\r\nhb_gt_xGetXY(): row == %d, col = %d, char = %d, attr = %d", cRow, cCol, *ch, *attr );
#else
char FAR *p;
p = hb_gt_ScreenPtr(cRow, cCol);
*ch = *p;
*attr = *(p + 1);
#endif
}
void hb_gt_xPutch(char cRow, char cCol, char attr, char ch)
{
#ifdef __DJGPP__
long ch_attr = ( ch << 8 ) | attr;
///printf("\r\nhb_gt_xPutch(): row == %d, col = %d, char = %d, attr = %d", cRow, cCol, ch, attr );
puttext( cCol + 1, cRow + 1, cCol + 1, cRow + 1, &ch_attr );
#else
char FAR *p;
p = hb_gt_ScreenPtr(cRow, cCol);
*p = ch;
*(p + 1) = attr;
#endif
}
void hb_gt_Puts(char cRow, char cCol, char attr, char *str, int len)
{
#ifdef __DJGPP__
int i = len;
int bottom, left = cCol, right, top = cRow;
int width = hb_gt_GetScreenWidth();
char * ch_attr, * ptr;
///printf("\r\nhb_gt_Puts(): row == %d, col = %d, attr = %d, len = %d", cRow, cCol, attr, len );
ptr = ch_attr = hb_xgrab( i * 2 );
while( i-- )
{
///printf("+");
*ptr++ = *str++;
///printf("-");
*ptr++ = attr;
}
i = len - 1; /* We want end position, not next cursor position */
right = left;
bottom = top;
if (right + i > width - 1)
{
/* Calculate end row position and the remainder size for the end column adjust */
bottom += (i / width);
i = i % width;
}
right += i;
if (right > width - 1)
{
/* Column movement overflows into next row */
bottom++;
right -= width;
}
///printf("\r\nhb_gt_Puts(): puttext( %d,%d, %d,%d )", left + 1, top + 1, right + 1, bottom + 1 );
puttext( left + 1, top + 1, right + 1, bottom + 1, ch_attr );
hb_xfree( ch_attr );
#else
char FAR *p;
int i;
p = hb_gt_ScreenPtr( cRow, cCol );
for(i=0; i<len; i++)
{
*p++ = *str++;
*p++ = attr;
}
#endif
}
void hb_gt_GetText(char cTop, char cLeft, char cBottom, char cRight, char *dest)
{
#ifdef __DJGPP__
gettext( cLeft + 1, cTop + 1, cRight + 1, cBottom + 1, dest );
#else
char x, y;
for (y = cTop; y <= cBottom; y++ )
@@ -290,10 +358,14 @@ void hb_gt_GetText(char cTop, char cLeft, char cBottom, char cRight, char *dest)
dest += 2;
}
}
#endif
}
void hb_gt_PutText(char cTop, char cLeft, char cBottom, char cRight, char *srce)
{
#ifdef __DJGPP__
puttext( cLeft + 1, cTop + 1, cRight + 1, cBottom + 1, srce );
#else
char x, y;
for (y = cTop; y <= cBottom; y++)
@@ -304,6 +376,7 @@ void hb_gt_PutText(char cTop, char cLeft, char cBottom, char cRight, char *srce)
srce += 2;
}
}
#endif
}
void hb_gt_SetAttribute( char cTop, char cLeft, char cBottom, char cRight, char attribute )
@@ -384,8 +457,10 @@ char hb_gt_Row(void)
void hb_gt_DispBegin(void)
{
#ifndef __DJGPP__
if( hb_gtDispCount() == 1 )
{
long offset;
char FAR *ptr;
ULONG nSize;
@@ -397,10 +472,12 @@ void hb_gt_DispBegin(void)
scrnStealth = ptr;
memcpy( (void *)scrnPtr, (void *)ptr, nSize );
}
#endif
}
void hb_gt_DispEnd(void)
{
#ifndef __DJGPP__
if( hb_gtDispCount() == 0 )
{
char FAR *ptr;
@@ -409,10 +486,11 @@ void hb_gt_DispEnd(void)
nSize = hb_gt_GetScreenWidth() * hb_gt_GetScreenHeight() * 2;
ptr = scrnPtr;
scrnPtr = scrnStealh;
scrnPtr = scrnStealth;
scrnStealth = ptr;
memcpy( (void *)scrnPtr, (void *)ptr, nSize );
}
#endif
}
void hb_gt_SetMode( USHORT uiRows, USHORT uiCols )
@@ -431,6 +509,8 @@ BOOL hb_gt_GetBlink()
{
#if defined(__WATCOMC__) && defined(__386__)
return *((char *)0x0465) & 0x10;
#elif defined(__DJGPP__)
return _farpeekb( 0x0040, 0x0065 ) & 0x10;
#else
return *((char FAR *)MK_FP(0x0040, 0x0065)) &0x10;
#endif

2
harbour/source/rtl/gt/gtos2.c
View File

@@ -269,7 +269,7 @@ void hb_gt_SetMode( USHORT uiRows, USHORT uiCols )
/* return rc */ /* TODO: set a return value for this function */
}
void hb_gt_Replicate(char c, DWORD nLength)
void hb_gt_Replicate(char c, ULONG nLength)
{
/* TODO: this will write character c nlength times to the screen.
Note that it is not used yet

151
harbour/source/rtl/setkey.prg
View File

@@ -30,11 +30,12 @@
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
their web site at http://www.gnu.org/).
V 1.1 A White Fixed wrong parameter aClone() bug in SetKeySave()
Added SetKeyCheck()
Added SetKeyGet()
V 1.0 A White Initial version, submitted to Harbour Projects
*/
/* TODO: Add SetKeyCheck() */
// macro substitutions to access sub-array elements of aSetKeys[]
#define KEY 1
#define BLOCK 2
@@ -82,7 +83,8 @@ static aSetKeys := {} // holds array of hot-key id, code-block, activation
* $COMPLIANCE$
* SETKEY() is mostly CA-Clipper compliant. The only difference is the
* addition of the condition code-block parameter, allowing set-keys to
* be conditionally turned off or on.
* be conditionally turned off or on. This condition-block cannot be
* returned once set - see SetKeyGet()
* $SEEALSO$
* SETKEYSAVE()
* $END$
@@ -90,12 +92,12 @@ static aSetKeys := {} // holds array of hot-key id, code-block, activation
Function SetKey( anKey, bBlock, bCondition )
local nFound, bReturn, aKey
if valType( anKey ) == "A"
if valType( anKey ) = "A"
aEval( anKey, {|x| setKey( x, bBlock, bCondition ) } )
elseif valType( anKey ) == "N" .and. anKey <> 0
if ( nFound := aScan( aSetKeys, {|x| x[ KEY ] == anKey } ) ) == 0
if valType( bBlock ) == "B"
elseif valType( anKey ) = "N" .and. anKey <> 0
if ( nFound := aScan( aSetKeys, {|x| x[ KEY ] = anKey } ) ) = 0
if valType( bBlock ) = "B"
aAdd( aSetKeys, { anKey, bBlock, bCondition } )
endif
@@ -103,16 +105,16 @@ Function SetKey( anKey, bBlock, bCondition )
else
aKey := aSetKeys[ nFound ]
if aKey[ CONDITION ] == NIL .or. eval( aKey[ CONDITION ], anKey )
if aKey[ CONDITION ] = NIL .or. eval( aKey[ CONDITION ], anKey )
bReturn := aKey[ BLOCK ]
endif
if valType( bBlock ) == "B"
if valType( bBlock ) = "B"
aKey[ BLOCK ] := bBlock
aKey[ CONDITION ] := bCondition
elseif pcount() > 1 .and. bBlock == NIL
elseif pcount() > 1 .and. bBlock = NIL
aSize( aDel( aSetKeys, nFound ), len( aSetKeys ) - 1 )
endif
@@ -124,6 +126,56 @@ Function SetKey( anKey, bBlock, bCondition )
return bReturn
/* $DOC$
* $FUNCNAME$
* SetKeyGet
* $CATEGORY$
* ?
* $ONELINER$
* Determine a set-key code block & condition-block
* $SYNTAX$
* SETKEYGET( <nKey> [, <bConditionByRef> ] )
* $ARGUMENTS$
* <anKey> is an numeric key value
* <bConditionByRef> is an optional return-parameter
* $RETURNS$
* Current assigned action-block
* $DESCRIPTION$
* The SetKeyGet() function returns the current code-block assigned to a
* key, and optionally assignes the condition-block to the return-parameter
* $EXAMPLES$
* local bOldF10, bOldF10Cond
* bOldF10 := SetKeyGet( K_F10, @bOldF10Cond )
* ... // some other processing
* SetKey( K_F10, bOldF10, bOldF10Cond )
* $TESTS$
* See test code above
* $STATUS$
* C
* $COMPLIANCE$
* SETKEYGET() is a new function and hence not CA-Clipper compliant.
* $SEEALSO$
* SETKEY(), SETKEYSAVE(), SETKEYCHECK()
* $END$
*/
Function SetKeyGet( nKey, bCondition )
local nFound
if valType( nKey ) = "N" .and. nKey <> 0
if ( nFound := aScan( aSetKeys, {|x| x[ KEY ] = nKey } ) ) = 0
bCondition := NIL
else
bCondition := aSetKeys[ nFound, CONDITION ]
return aSetKeys[ nFound, BLOCK ]
endif
endif
return NIL //bReturn
/* $DOC$
* $FUNCNAME$
* SetKeySave
@@ -162,14 +214,89 @@ return bReturn
Function SetKeySave( OldKeys )
local aReturn := aClone( aSetKeys )
if pcount() != 0 .or. valtype( OldKeys ) == "A"
if OldKeys == NIL
if pcount() != 0 .or. valtype( OldKeys ) = "A"
if OldKeys = NIL
aSetKeys := {}
else
aSetKeys := aClone( OldKeys )
endif
endif
return aReturn
/* $DOC$
* $FUNCNAME$
* SetKeyCheck
* $CATEGORY$
* ?
* $ONELINER$
* Impliments common hot-key activation code
* $SYNTAX$
* SetKeyCheck( <nKey> [, <p1> ][, <p2> ][, <p3> ] )
* $ARGUMENTS$
* <nKey> is a numeric key value to be tested
* code-block, if executed
* <p1>..<p3> are optional parameters that will be passed to the code-block
* $RETURNS$
* True if there is a hot-key associated with <nKey> and it was executed;
* otherwise False
* If there is a hot-key association (before checking any condition):
* - if there is a condition-block, it is passed one parameter - <nKey>
* - when the hot-key code-block is called, it is passed 1 to 4 parameters,
* depending on the parameters passed to SetKeyCheck(). Any parameters
* so passed are directly passed to the code-block, with an additional
* parameter being <nKey>
* $DESCRIPTION$
* SetKeyCheck() is intended as a common interface to the SetKey()
* functionality for such functions as ACHOICE(), DBEDIT(), MEMOEDIT(),
* ACCEPT, INPUT, READ, and WAIT
* $EXAMPLES$
* // within ReadModal()
* if SetKeyCheck( K_ALT_X, GetActive() )
* ... // some other processing
* endif
* // within TBrowse handler
* case SetKeyCheck( nInkey, oTBrowse )
* return
* case nInKey == K_ESC
* ... // some other processing
* $TESTS$
* None definable
* $STATUS$
* C
* $COMPLIANCE$
* SetKeyCheck() is new.
* $SEEALSO$
* SETKEY(), SETKEYSAVE()
* $END$
*/
Function SetKeyCheck( nKey, p1, p2, p3 )
local nFound, aKey, bBlock
if ( nFound := aScan( aSetKeys, {|x| x[ KEY ] = nKey } ) ) > 0
aKey := aSetKeys[ nFound ]
bBLock := aKey[ BLOCK ]
if aKey[ CONDITION ] = NIL .or. eval( aKey[ CONDITION ], nKey )
// is this overkill? if a code-block checks its own pcount(),
// passing nil parameters would skew the count!
do case
case pcount() = 1 ; eval( bBlock, nKey )
case pcount() = 2 ; eval( bBlock, p1, nKey )
case pcount() = 3 ; eval( bBlock, p1, p2, nKey )
otherwise ; eval( bBlock, p1, p2, p3, nKey )
end case
return .t.
endif
endif
return .f.

1
harbour/tests/working/Makefile
View File

@@ -155,6 +155,7 @@ BAD_PRG_SOURCES=\
extend1.prg \
keywords.prg \
linecont.prg \
setkeys.prg \
spawn.prg \
spawn2.prg \
statics1.prg \

84
harbour/tests/working/setkeys.prg Normal file
View File

@@ -0,0 +1,84 @@
/*
* $Id$
Harbour Project source code - http://www.Harbour-Project.org
By: A White - awhite@user.rose.com
This file contains the Harbour function(s) that maintain the list
of set-keys (hot-keys).
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/).
V 1.0 A White Initial version, submitted to Harbour Project
*/
#include "inkey.ch"
Procedure Main()
local GetList := {}
local alpha, bravo, charlie, k
cls
@ 2, 2 say "Press F10 to popup alert box of current get, not active if empty"
@ 3, 2 say "Press F9 to disable all setkeys, except F9 to restore (uses SetKeySave())"
@ 4, 2 say "Press F8 to test setkey w/ array, and SetKeyCheck()"
alpha := "alpha "
bravo := 123
charlie := date()
@ 10, 10 get alpha
@ 11, 10 get bravo
@ 12, 10 get charlie
#ifndef K_F10
#define K_F10 -9
#define K_F9 -8
#define K_F8 -7
#define K_ESC 27
#endif
setKey( K_F10, {|| Alert( transform( getactive():varGet(), NIL ) ) }, {|| !empty( getactive():buffer ) } )
setKey( K_F9 , {|| k := SetKeySave( NIL ), ;
SetKey( K_F9, {|| SetKeySave( k ) } ) } )
SetKey( K_F8 , {|| SubMain() } )
read
? alpha, bravo, charlie
static Procedure SubMain()
local n
SetKey( { 49, 50, 52, 53 }, {|x| qout( chr( x ) ) } )
do while ( n := inkey( 0 ) ) != K_ESC
if SetKeyCheck( n )
qqout( " hit hot" )
else
qout( chr( n ) )
qqout( " hit cold" )
endif
end
SetKey( { 49, 50, 52, 53 }, NIL )