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

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

Browse Source
This commit is contained in:
David G. Holm
1999-07-27 01:51:53 +00:00
parent 8f58f17a92
commit 2ff35f55b3
21 changed files with 1404 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
harbour/ChangeLog
View File

@@ -1,3 +1,64 @@
19990726-21:35 EDT David G. Holm <dholm@jsd-llc.com>
* config/os2/dir.cf
! Corrected FOR statement to work properly when called from CMD.EXE
which means that when using 4OS2, the GNU Make System must be run
using: CMD /C make -r (or CMD /C make -r clean)
* config/os2/install.cf
! Corrected FOR statement to work properly when called from CMD.EXE
which means that when using 4OS2, the GNU Make System must be run
using: CMD /C make -r install
* include/inkey.ch
+ Added INKEY_EXTENDED event mask code
+ Added mouse event codes
+ include/inkey.h
+ New support module for new module source/rtl/inkey.c
* include/set.h
+ Added INKEY_EXTENDED
+ Added version comment for V 1.17 by Bruno Cantero
* Corrected version number in version history for V 1.16
* source/hbpp/Makefile
! Added preproc.c, so that tests/working/testpre.prg will link
* source/rtl/Makefile
* Added inkey.c
* source/rtl/dates.c
+ Added _MSC_VER to list of compilers that use DOS method to get
seconds and fractions in SECONDS() instead of just whole seconds
* source/rtl/files.c
* hb_fopen() now generates runtime error BASE/2021 when filename
parameter is not a string (argument error)
+ source/rtl/inkey.c
+ New module for CLEAR TYPEAHEAD, INKEY(), KEYBOARD, NEXTKEY(),
LASTKEY() and SET TYPEAHEAD support (no mouse support yet)
* source/rtl/math.c
! MIN() and MAX() no longer generate an argument error when called
with different numeric types
! MIN() and MAX() now return the first parameter when both are equal
* source/rtl/set.c
* Modified HB_SET_TYPEAHEAD handling to use INKEY() support function
hb_inkeyReset() to adjust the size of the keyboard typeahead buffer
! Corrected HB_SET_TYPEAHEAD handling to use set_number()
* source/tools/Makefile
+ Added fileread.prg
+ source/tools/fileread.prg
+ New file reader class reads files one line at a time
* source/vm/hvm.c
+ Added call to hb_inkeyPoll() at top of Virtual Machine loop
* tests/working/Makefile
+ Added inkeytst.prg
+ Added readfile.prg
+ tests/working/inkeytst.prg
+ Test program for INKEY(), NEXTKEY(), LASTKEY(), KEYBOARD,
SET TYPEAHEAD, and CLEAR TYPEAHEAD.
* tests/working/mathtest.prg
+ Added MIN() and MAX() tests
+ tests/working/readfile.prg
+ Test program for new file reader class (the test program dumps the
file contents to STDOUT to let you redirect to file so that you can
compare the input and output files)
* tests/working/seconds.prg
* If run with a number as a command line parameter, the loop will be
executed that many times, without pausing between calls to SECONDS()
19990726-22:35 CET Patrick Mast <harbour@PatrickMast.com>
+ Build40.bat and Makefile.b40
Build and makefile for Borland 4.0

16
harbour/config/os2/dir.cf
View File

@@ -6,20 +6,20 @@ ifeq ($(SHLVL),) # An OS/2 command shell
ifeq ($(DIRS),) # Empty directory list
DIR_RULE =\
@echo Done
@echo Done
else
DIR_LIST = $(subst /,\,$(DIRS))
DIR_RULE =\
CMD.EXE /c FOR %%d IN ($(DIR_LIST)) DO $(MK) -C %%d $@
CMD.EXE /c FOR %d IN ($(DIR_LIST)) DO $(MK) -C %d $@
endif
else # bash
DIR_RULE =\
@for d in $(DIRS); do \
if [ -d $$d ]; then \
$(MAKE) -C $$d $@; \
fi \
done
@for d in $(DIRS); do \
if [ -d $$d ]; then \
$(MAKE) -C $$d $@; \
fi \
done
endif # ! Windows
endif # ! Windows

32
harbour/config/os2/install.cf
View File

@@ -7,25 +7,25 @@ ifeq ($(SHLVL),) # An OS/2 command shell
INSTALL_LIST = $(subst /,\,$(INSTALL_OBJS))
OS2_INSTALL_DIR = $(subst /,\,$(INSTALL_DIR))
INSTALL_RULE =\
CMD.EXE /c FOR %%f IN ($(INSTALL_LIST)) DO COPY %%f $(OS2_INSTALL_DIR)
CMD.EXE /c FOR %f IN ($(INSTALL_LIST)) DO COPY %f $(OS2_INSTALL_DIR)
else # bash
INSTALL_RULE =\
@if [ ! -d $(INSTALL_DIR) ]; \
then \
echo "! Can't install, path not found:" $(INSTALL_DIR); \
else \
for i in $(INSTALL_OBJS); \
do \
if [ -r $$i ]; \
then \
echo "! Installing $$i on $(INSTALL_DIR)"; \
$(CP) $$i $(INSTALL_DIR); \
else \
echo "! Can't install $$i, not found"; \
fi \
done \
fi
@if [ ! -d $(INSTALL_DIR) ]; \
then \
echo "! Can't install, path not found:" $(INSTALL_DIR); \
else \
for i in $(INSTALL_OBJS); \
do \
if [ -r $$i ]; \
then \
echo "! Installing $$i on $(INSTALL_DIR)"; \
$(CP) $$i $(INSTALL_DIR); \
else \
echo "! Can't install $$i, not found"; \
fi \
done \
fi
endif

17
harbour/include/inkey.ch
View File

@@ -2,6 +2,8 @@
* $Id$
*/
// Input event masks
#define INKEY_MOVE 1
#define INKEY_LDOWN 2
#define INKEY_LUP 4
@@ -9,3 +11,18 @@
#define INKEY_RUP 16
#define INKEY_KEYBOARD 128
#define INKEY_ALL 159
#define INKEY_EXTENDED 256
// Mouse events
#define K_MOUSEMOVE 1001
#define K_LBUTTONDOWN 1002
#define K_LBUTTONUP 1003
#define K_RBUTTONDOWN 1004
#define K_RBUTTONUP 1005
#define K_LDBLCLK 1006
#define K_RDBLCLK 1007
// Special keyboard keys
#define K_ESC 27

48
harbour/include/inkey.h Normal file
View File

@@ -0,0 +1,48 @@
/* $Id$
Harbour Project source code
This module contains the Harbour declarations for INKEY management.
Copyright 1999 David G. Holm <dholm@jsd-llc.com>
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/).
V 1.1 David G. Holm Committed to CVS.
V 1.0 David G. Holm Initial version.
*/
#ifndef HB_INKEY_H_
#define HB_INKEY_H_
#include <hbdefs.h>
/* Harbour keyboard support functions */
int hb_inkeyGet( void ); /* Extract the next key from the Harbour keyboard buffer */
int hb_inkeyLast( void ); /* Return the value of the last key that was extracted */
int hb_inkeyNext( void ); /* Return the next key without extracting it */
void hb_inkeyPoll( void ); /* Poll the console keyboard to stuff the Harbour buffer */
void hb_inkeyReset( BOOL allocate ); /* Reset the Harbour keyboard buffer */
#endif

9
harbour/include/set.h
View File

@@ -29,6 +29,11 @@
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
their web site at http://www.gnu.org/).
V 1.18 David G. Holm Added INKEY_EXTENDED to allow some
platforms to select between normal
and extended key codes.
V 1.17 Bruno Cantero Added prototypes for hb_rddInitialize
and hb_rddRelease.
V 1.16 David G. Holm Added prototypes for hb_consoleRelease
and hb_consoleInitialize, because set
must be initialized before console and
@@ -94,11 +99,13 @@ typedef enum
INKEY_RDOWN = 8, /* Mouse Right Click Down */
INKEY_RUP = 16, /* Mouse Right Click Up */
INKEY_KEYBOARD = 128, /* Keyboard Events */
INKEY_ALL = 159 /* All Mouse and Keyboard Events */
INKEY_ALL = 159, /* All Mouse and Keyboard Events */
INKEY_EXTENDED = 256 /* Extended Keyboard Events */
} HB_inkey_enum;
typedef enum
{
HB_INVALID_SET = 0,
HB_SET_ALTERNATE = 1,
HB_SET_ALTFILE = 2,
HB_SET_BELL = 3,

1
harbour/source/hbpp/Makefile
View File

@@ -7,6 +7,7 @@ ROOT = ../../
C_SOURCES=\
hbpp.c \
hbppint.c \
preproc.c \
table.c \
LIB=hbpp

1
harbour/source/rtl/Makefile
View File

@@ -19,6 +19,7 @@ C_SOURCES=\
files.c \
gtapi.c \
hardcr.c \
inkey.c \
itemapi.c \
math.c \
memvars.c \

7
harbour/source/rtl/dates.c
View File

@@ -78,22 +78,19 @@ HB_INIT_SYMBOLS_END( Dates__InitSymbols );
#pragma startup Dates__InitSymbols
#endif
/* rest of the functions is pulled automatically in initsymb.c */
/* The other functions are pulled in automatically by initsymb.c */
double hb__seconds( void )
{
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__DJGPP__)
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__DJGPP__) || defined(_MSC_VER)
struct time t;
gettime( &t );
return( ( ( t.ti_hour * 3600 ) + ( t.ti_min * 60 ) + t.ti_sec ) + t.ti_hund / 100.0 );
#else
time_t t;
struct tm *oTime;
time(&t);
oTime = localtime(&t);
return( ( oTime->tm_hour * 3600 ) + ( oTime->tm_min * 60 ) + oTime->tm_sec );
#endif
}

5
harbour/source/rtl/files.c
View File

@@ -6,6 +6,7 @@
#include <init.h>
#include <filesys.h>
#include <string.h>
#include <errorapi.h>
#if defined(__CYGNUS__)
#include <mingw32/share.h>
@@ -531,6 +532,10 @@ HARBOUR HB_FOPEN( void )
file_handle = hb_fsOpen( (BYTEP)hb_parc(1), open_flags );
}
else
{
hb_errorRT_BASE(EG_ARG, 2021, "Argument error", "FOPEN");
}
hb_retni(file_handle);
return;

622
harbour/source/rtl/inkey.c Normal file
View File

@@ -0,0 +1,622 @@
/* $Id$
Harbour Project source code
This module contains the Harbour functions for INKEY management.
Copyright 1999 David G. Holm <dholm@jsd-llc.com>
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/).
V 1.1 David G. Holm Committed to CVS.
V 1.0 David G. Holm Initial version.
*/
#include <time.h>
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__MSC__) || defined(_MSC_VER)
#include <conio.h>
#include <dos.h>
#elif defined(__DJGPP__)
#include <pc.h>
#include <dos.h>
#elif defined(HARBOUR_GCC_OS2)
#include <stdlib.h>
#elif defined(__IBMCPP__)
#include <conio.h>
#endif
#ifdef __WATCOMC__
#include <i86.h>
#if defined(__386__) && !defined(__WINDOWS_386__)
#define INT_86 int386
#define DOS_REGS REGS
#else
#define INT_86 int86
#define DOS_REGS REGS
#endif
#elif defined(__EMX__)
#define INT_86 _int86
#define DOS_REGS REGS
#elif defined(_MSC_VER)
#define INT_86 _int86
#define DOS_REGS _REGS
#else
#define INT_86 int86
#define DOS_REGS REGS
#endif
#include "inkey.h"
#include "hbsetup.h"
#include "errorapi.h"
#include "extend.h"
#include "init.h"
#include "set.h"
HARBOUR HB___KEYBOARD( void );
HARBOUR HB_INKEY( void );
HARBOUR HB_LASTKEY( void );
HARBOUR HB_NEXTKEY( void );
HB_INIT_SYMBOLS_BEGIN( INKEY__InitSymbols )
{ "__KEYBOARD", FS_PUBLIC, HB___KEYBOARD, 0 },
{ "INKEY" , FS_PUBLIC, HB_INKEY , 0 },
{ "LASTKEY" , FS_PUBLIC, HB_LASTKEY , 0 },
{ "NEXTKEY" , FS_PUBLIC, HB_NEXTKEY , 0 },
HB_INIT_SYMBOLS_END( INKEY__InitSymbols );
#if ! defined(__GNUC__)
#pragma startup INKEY__InitSymbols
#endif
static int *s_inkeyBuffer=0; /* Harbour keyboard buffer (empty if head == tail) */
static int s_inkeyHead; /* Harbour keyboard buffer head pointer (next insert) */
static int s_inkeyTail; /* Harbour keyboard buffer tail pointer (next extract) */
static int s_inkeyLast; /* Last key extracted from Harbour keyboard buffer */
static BOOL s_inkeyPoll; /* Flag to override no polling when TYPEAHEAD is 0 */
static int s_inkeyForce; /* Variable to hold keyboard input when TYPEAHEAD is 0 */
static HB_inkey_enum s_eventmask;
void hb_releaseCPU( void )
{
/* TODO: Add code to release time slices on all platforms */
#if defined(_Windows)
#elif defined(HARBOUR_GCC_OS2) || defined(__IBMCPP__)
#elif defined(OS_DOS_COMPATIBLE)
#elif defined(OS_UNIX_COMPATIBLE)
#else
#endif
}
int hb_inkeyGet( void ) /* Extract the next key from the keyboard buffer */
{
int key;
hb_inkeyPoll();
if( hb_set.HB_SET_TYPEAHEAD )
{
/* Proper typeahead support is set */
if( s_inkeyHead == s_inkeyTail ) key = 0; /* Keyboard buffer is empty */
else
{ /* Keyboard buffer is not empty */
s_inkeyLast = s_inkeyBuffer[ s_inkeyTail++ ];
if( s_inkeyTail >= hb_set.HB_SET_TYPEAHEAD )
{ /* Limit keyboard buffer to set size */
s_inkeyTail = 0;
}
key = s_inkeyLast;
}
}
else key = s_inkeyLast = s_inkeyForce; /* Typeahead support is disabled */
s_inkeyForce = 0;
return key;
}
int hb_inkeyLast( void ) /* Return the value of the last key that was extracted */
{
hb_inkeyPoll();
return s_inkeyLast;
}
int hb_inkeyNext( void ) /* Return the next key without extracting it */
{
int key = 0;
hb_inkeyPoll();
if( hb_set.HB_SET_TYPEAHEAD )
{
/* Proper typeahead support is enabled */
if( s_inkeyHead == s_inkeyTail ) key = 0;
else key = s_inkeyBuffer[ s_inkeyTail ];
}
else key = s_inkeyForce; /* Typeahead support is disabled */
return key;
}
void hb_inkeyPoll( void ) /* Poll the console keyboard to stuff the Harbour buffer */
{
/* TODO: Add mouse support */
if( hb_set.HB_SET_TYPEAHEAD || s_inkeyPoll )
{
int ch = 0;
#if defined(OS_DOS_COMPATIBLE) || defined(HARBOUR_GCC_OS2) || defined(__IBMCPP__) || defined(_Windows)
/* The reason for including _Windows here is that kbhit() and getch() appear
to work properly in console mode. For true Windows mode, changes are needed. */
#if defined(HARBOUR_GCC_OS2)
/* Read from the keyboard with no echo, no wait, and no SIGSEV on Ctrl-C */
ch = _read_kbd( 0, 0, 0 );
if( ch == 0 )
{
/* It's a function key lead-in, so read the function key scan code */
ch = _read_kbd( 0, 0, 0 );
if( ch != -1 ) ch += 256; /* If it's really a scan code, offset it */
}
/* _read_kbd() returns -1 for no key, but Harbour expects 0 */
if( ch == -1 ) ch = 0;
#else
if( kbhit() )
{
/* A key code is available in the BIOS keyboard buffer, so read it */
#if defined(__DJGPP__)
if( s_eventmask & INKEY_EXTENDED ) ch = getxkey();
else ch = getkey();
#else
/* A key code is available in the BIOS keyboard buffer */
ch = getch(); /* Get the key code */
if( ch == 0 && kbhit() )
{
/* It was a function key lead-in code, so read the actual
function key and then offset it by 256 */
ch = getch() + 256;
}
else if( ch == 224 && kbhit() )
{
/* It was an extended function key lead-in code, so read
the actual function key and then offset it by 256,
unless extended keyboard events are allowed, in which
case offset it by 512 */
if( s_eventmask & INKEY_EXTENDED ) ch = getch() + 512;
else ch = getch() + 256;
}
#endif
}
#endif
switch( ch )
{
case - 1:
ch = 0;
break;
case 328:
ch = 5;
break;
case 336:
ch = 24;
break;
case 331:
ch = 19;
break;
case 333:
ch = 4;
break;
case 327:
ch = 1;
break;
case 335:
ch = 6;
break;
case 329:
ch = 18;
break;
case 337:
ch = 3;
break;
case 371:
ch = 26;
break;
case 372:
ch = 2;
break;
case 375:
ch = 29;
break;
case 373:
ch = 23;
break;
case 388:
ch = 31;
break;
case 374:
ch = 30;
break;
case 338:
ch = 22;
break;
case 339:
ch = 7;
break;
case 315:
ch = 28;
break;
case 316:
case 317:
case 318:
case 319:
case 320:
case 321:
case 322:
case 323:
case 324:
ch = 315 - ch;
break;
case 340:
case 341:
case 342:
case 343:
case 344:
case 345:
case 346:
case 347:
case 348:
case 349:
case 350:
case 351:
case 352:
case 353:
case 354:
case 355:
case 356:
case 357:
case 358:
case 359:
case 360:
case 361:
case 362:
case 363:
case 364:
case 365:
case 366:
case 367:
case 368:
case 369:
ch = 330 - ch;
break;
case 389:
case 390:
case 391:
case 392:
case 393:
case 394:
case 395:
case 396:
ch = 349 - ch;
}
#elif defined(OS_UNIX_COMPATIBLE)
/* TODO: */
/* Note: If GCC for Linux on PCs uses the same keyboard codes as the
other PC platforms in the previous #if section, then it should
be possible to add a user-defined HARBOUR_GCC_PC #define and
include it in the previous #if section, with the appropriate
#elif or || defined(HARBOUR_GCC_PC) to get the keyboard input */
#else
/* TODO: Support for other platforms, such as Mac */
#endif
if( ch )
{
if( hb_set.HB_SET_TYPEAHEAD )
{
/* Proper typeahead support is set */
int head = s_inkeyHead;
s_inkeyBuffer[ head++ ] = ch;
if( head >= hb_set.HB_SET_TYPEAHEAD ) head = 0;
if( head != s_inkeyTail ) s_inkeyHead = head;
else /* TODO: Add error sound */ ;
}
else s_inkeyForce = ch; /* Typeahead support is disabled */
}
}
}
void hb_inkeyReset( BOOL allocate) /* Reset the keyboard buffer */
{
/* Reset the buffer head and tail pointers, the last key value,
and the polling override flag */
s_inkeyHead = 0;
s_inkeyTail = 0;
s_inkeyLast = 0;
s_inkeyPoll = FALSE;
s_inkeyForce = 0;
/* The allocate flag allows the same function to be used to reset the
buffer or to reset and allocate, reallocate, or free the buffer */
if( allocate )
{
/* If the buffer already exists, free it */
if( s_inkeyBuffer ) hb_xfree( s_inkeyBuffer );
/* Always allocate a new buffer, unless it's being freed from hb_setRelease() */
if( hb_set.HB_SET_TYPEAHEAD > -1 )
{
/* The buffer min and max are determined by SET(HB_SET_TYPEAHEAD, but it
can also set the typeahead to 0 to disable polling, in which case the
minimum buffer size (which is 16) must still be allocated, because
even when polling is disabled, calling INKEY() or NEXTKEY() will
temporarily re-enable polling */
s_inkeyBuffer = (int *)hb_xgrab( sizeof( int )
* ( hb_set.HB_SET_TYPEAHEAD == 0 ? 16 : hb_set.HB_SET_TYPEAHEAD ) );
}
}
}
/* $DOC$
* $FUNCNAME$
* INKEY()
* $CATEGORY$
* Console input
* $ONELINER$
* Extracts the next key code from the Harbour keyboard buffer
* $SYNTAX$
* INKEY( [<nTimeout>] [,<nEvents>] ) --> nKey
* $ARGUMENTS$
* <nTimeout> is an optional timeout value in seconds, with a granularity
* of 1/10th of a second. If omitted, INKEY() returns immediately. If set
* to 0, INKEY() waits until an input event occurs. If set to any other
* value, INKEY() will return either when an input event occurs or when
* the timeout period has elapsed. If only this parameter is specified
* and it is not numeric, it will be treated as if it were 0. But if both
* parameters are specified and this parameter is not numeric, it will be
* treated as if it were not present.
* <nEvents> is an optional mask of input events that are to be enabled.
* If omitted, defaults to hb_set.HB_SET_EVENTMASK. Valid input maks are
* in inkey.ch and are explained below. It is recommended that the mask
* names be used rather than their numeric values, in case the numeric
* values change in future releases of Harbour. To allow more than one
* type of input event, simply add the various mask names together.
* INKEY_MOVE = Mouse motion events are allowed
* INKEY_LDOWN = The mouse left click down event is allowed
* INKEY_LUP = The mouse left click up event is allowed
* INKEY_RDOWN = The mouse right click down event is allowed
* INKEY_RUP = The mouse right click up event is allowed
* INKEY_KEYBOARD = All keyboard events are allowed
* INKEY_ALL = All mouse and keyboard events are allowed
* If the parameter is not numeric, it will be treated as if it were set
* to hb_set.HB_SET_EVENTMASK.
* $RETURNS$
* 0 in case of timeout with no input event, otherwise returns a value
* in the range -39 to 386 for keyboard events or the range 1001 to 1007
* for mouse events. Mouse events and non-printable keyboard events are
* represented by the K_<event> values listed in inkey.ch. Keyboard
* event return codes in the range 32 through 127 are equivalent to the
* printable ASCII character set. Keyboard event return codes in the
* range 128 through 255 are assumed to be printable, but results may
* vary based on hardware and nationality.
* $DESCRIPTION$
* INKEY() can be used to detect input events, such as keypress, mouse
* movement, or mouse key clicks (up and/or down).
* $EXAMPLES$
* // Wait for the user to press the Esc key
* ? "Please press the ESC key."
* WHILE INKEY( 0.1 ) != K_ESC
* END
* $TESTS$
* KEYBOARD "AB"; ? INKEY(), INKEY() ==> 65 66
* $STATUS$
* S
* $COMPLIANCE$
* INKEY() is compliant with the Clipper 5.3 INKEY() function with one
* exceptions: The Harbour INKEY() function will raise an argument error
* if the first parameter is less than or equal to 0 and the second
* parameter (or the default mask) is not valid, because otherwise INKEY
* would never return, because it was, in effect, asked to wait forever
* for no events (Note: In Clipper, this also blocks SET KEY events).
* $SEEALSO$
* inkey.ch
* $END$
*/
HARBOUR HB_INKEY( void )
{
int args = hb_pcount(), key = 0, wait = FALSE, forever = FALSE;
clock_t end_clock;
double seconds;
s_eventmask = hb_set.HB_SET_EVENTMASK; /* Default to the SET input event mask */
if( args == 1 || ( args > 1 && hb_param( 1, IT_NUMERIC ) ) )
{
/* If only one parameter or if 1st parameter is numeric, then use it
as the number of seconds to wait for an input event, in seconds. */
seconds = hb_parnd( 1 );
wait = TRUE;
if( seconds * CLOCKS_PER_SEC < 1 ) forever = TRUE;
}
if( args > 1 && hb_param( 2, IT_NUMERIC ) )
{
/* If 2nd parameter is numeric, then use it as the input mask */
s_eventmask = ( HB_inkey_enum )hb_parni( 2 );
}
if( wait && forever && ( s_eventmask & ( INKEY_ALL + INKEY_EXTENDED ) ) == 0 )
{
/* There is no point in waiting forever for no input events! */
hb_errorRT_BASE(EG_ARG, 9001, "Argument error", "INKEY");
}
else
{
/* Check or wait for input events */
if( wait ) end_clock = clock() + seconds * CLOCKS_PER_SEC;
s_inkeyPoll = TRUE; /* Force polling */
while( wait && hb_inkeyNext() == 0 )
{
/* Release the CPU between checks */
hb_releaseCPU();
/* Check for timeout */
if( !forever && clock() >= end_clock ) wait = FALSE;
}
/* Get the current input event or 0 */
key = hb_inkeyGet();
s_inkeyPoll = FALSE; /* Stop forced polling */
}
s_eventmask = hb_set.HB_SET_EVENTMASK; /* Restore the SET input event mask */
hb_retni( key );
}
/* $DOC$
* $FUNCNAME$
* __KEYBOARD( [<cString>] )
* $CATEGORY$
* Console input
* $ONELINER$
* DO NOT CALL THIS FUNCTION DIRECTLY!
* $SYNTAX$
* KEYBOARD <cString>
* CLEAR TYPEAHEAD
* $ARGUMENTS$
* <cString> is the optional string to stuff into the Harbour keyboard
* buffer after clearing it first.
* $RETURNS$
* There is no return value
* $DESCRIPTION$
* Clears the Harbour keyboard typeahead buffer and then inserts an
* optional string into it.
* $EXAMPLES$
* // Stuff an Enter key into the keyboard buffer
* KEYBOARD CHR(13)
* // Clear the keyboard buffer
* CLEAR TYPEAHEAD
* $TESTS$
* KEYBOARD CHR(13); ? INKEY() ==> 13
* KEYBOARD "HELLO"; CLEAR TYPEAHEAD; ? INKEY() ==> 0
* $STATUS$
* C
* $COMPLIANCE$
* NEXTKEY() is compliant with CA-Clipper 5.3
* $SEEALSO$
* CLEAR TYPEAHEAD, KEYBOARD
* $END$
*/
HARBOUR HB___KEYBOARD( void )
{
/* Clear the typeahead buffer without reallocating the keyboard buffer */
hb_inkeyReset( FALSE );
if( hb_pcount() > 0 && hb_param( 1, IT_STRING ) && hb_parclen( 1 ) )
{
/* Stuff the string */
char *fPtr = hb_parc( 1 );
long size = hb_parclen( 1 );
if( size >= hb_set.HB_SET_TYPEAHEAD )
{
/* Have to allow for a zero size typehead buffer */
if( hb_set.HB_SET_TYPEAHEAD ) size = hb_set.HB_SET_TYPEAHEAD - 1;
else size = 0;
}
while( size-- )
{
s_inkeyBuffer[ s_inkeyHead++ ] = *fPtr++;
}
}
}
/* $DOC$
* $FUNCNAME$
* NEXTKEY()
* $CATEGORY$
* Console input
* $ONELINER$
* Returns the value of the next key in the Harbour keyboard buffer
* $SYNTAX$
* NEXTKEY() --> nKey
* $ARGUMENTS$
* None
* $RETURNS$
* There is no return value
* $DESCRIPTION$
* Returns the value of the next key in the Harbour keyboard buffer
* without extracting it.
* $EXAMPLES$
* // Use NEXTKEY() with INKEY() to change display character or by
* // itself to exit the loop, so that the caller can detect the Esc.
* LOCAL nKey, cChar := "+"
* WHILE TRUE
* ?? cChar
* nKey := NEXTKEY()
* IF nKey == K_ESC
* EXIT
* ELSE
* IF nKey != 0
* cChar := CHR( nKey )
* END IF
* END IF
* END WHILE
* $TESTS$
* KEYBOARD "AB"; ? NEXTKEY(), NEXTKEY() ==> 65 65
* $STATUS$
* C
* $COMPLIANCE$
* __KEYBOARD is compliant with CA-Clipper 5.3
* $SEEALSO$
* INKEY(), LASTKEY()
* $END$
*/
HARBOUR HB_NEXTKEY( void )
{
hb_retni( hb_inkeyNext() );
}
/* $DOC$
* $FUNCNAME$
* LASTKEY()
* $CATEGORY$
* Console input
* $ONELINER$
* Returns the last key exttracted from the Harbour keyboard buffer
* $SYNTAX$
* LASTKEY() --> nKey
* $ARGUMENTS$
* None
* $RETURNS$
* There is no return value
* $DESCRIPTION$
* Returns the value of the last key exttracted from the Harbour
* keyboard buffer
* $EXAMPLES$
* // Continue looping unless the ESC key was pressed in MainFunc()
* WHILE TRUE
* MainFunc()
* IF LASTKEY() == K_ESC
* EXIT
* END IF
* END WHILE
* $TESTS$
* KEYBOARD "AB"; ? INKEY(), LASTKEY() ==> 65 65
* $STATUS$
* C
* $COMPLIANCE$
* __KEYBOARD is compliant with CA-Clipper 5.3
* $SEEALSO$
* INKEY(), LASTKEY()
* $END$
*/
HARBOUR HB_LASTKEY( void )
{
hb_retni( s_inkeyLast );
}

20
harbour/source/rtl/math.c
View File

@@ -152,20 +152,20 @@ HARBOUR HB_MAX( void )
{
if( hb_pcount() == 2 )
{
PHB_ITEM p1 = hb_param(1, IT_NUMERIC + IT_DATE), p2 = hb_param(2, IT_NUMERIC + IT_DATE);
PHB_ITEM p1 = hb_param(1, IT_ANY), p2 = hb_param(2, IT_ANY);
if( p1 && p2 && p1->type == p2->type )
if( ( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) ) || ( IS_DATE( p1 ) && IS_DATE( p2 ) ) )
{
if( p1->type == IT_DATE )
{
long l1 = p1->item.asDate.value, l2 = p2->item.asDate.value;
hb_retds(l1 > l2? hb_pards(1): hb_pards(2));
hb_retds(l1 >= l2? hb_pards(1): hb_pards(2));
}
else
{
double d1 = hb_parnd(1), d2 = hb_parnd(2);
hb_retnd(d1 > d2? d1: d2);
stack.Return.item.asDouble.decimal = (d1 > d2? p1->item.asDouble.decimal : p2->item.asDouble.decimal);
hb_retnd(d1 >= d2? d1: d2);
stack.Return.item.asDouble.decimal = (d1 >= d2? p1->item.asDouble.decimal : p2->item.asDouble.decimal);
}
}
else
@@ -185,20 +185,20 @@ HARBOUR HB_MIN( void )
{
if( hb_pcount() == 2 )
{
PHB_ITEM p1 = hb_param(1, IT_NUMERIC + IT_DATE), p2 = hb_param(2, IT_NUMERIC + IT_DATE);
PHB_ITEM p1 = hb_param(1, IT_ANY), p2 = hb_param(2, IT_ANY);
if( p1 && p2 && p1->type == p2->type )
if( ( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) ) || ( IS_DATE( p1 ) && IS_DATE( p2 ) ) )
{
if( p1->type == IT_DATE )
{
long l1 = p1->item.asDate.value, l2 = p2->item.asDate.value;
hb_retds(l1 < l2? hb_pards(1): hb_pards(2));
hb_retds(l1 <= l2? hb_pards(1): hb_pards(2));
}
else
{
double d1 = hb_parnd(1), d2 = hb_parnd(2);
hb_retnd(d1 < d2? d1: d2);
stack.Return.item.asDouble.decimal = (d1 < d2? p1->item.asDouble.decimal : p2->item.asDouble.decimal);
hb_retnd(d1 <= d2? d1: d2);
stack.Return.item.asDouble.decimal = (d1 <= d2? p1->item.asDouble.decimal : p2->item.asDouble.decimal);
}
}
else

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

@@ -168,6 +168,7 @@
#include <sys/stat.h>
#endif
#include <set.h>
#include <inkey.h>
#include <errno.h>
#ifndef O_BINARY
@@ -639,8 +640,10 @@ HARBOUR HB_SET (void)
BOOL bFlag;
int args = hb_pcount();
PHB_ITEM pArg2, pArg3;
HB_set_enum set_specifier;
HB_set_enum set_specifier = (HB_set_enum) hb_parni(1);
if (args > 0) set_specifier = (HB_set_enum) hb_parni(1);
else set_specifier = HB_INVALID_SET;
if (args > 1) pArg2 = hb_param (2, IT_ANY);
if (args > 2) pArg3 = hb_param (3, IT_ANY);
@@ -873,9 +876,13 @@ HARBOUR HB_SET (void)
if (args > 1)
{
/* Set the value and limit the range */
hb_set.HB_SET_TYPEAHEAD = set_logical (pArg2);
if( hb_set.HB_SET_TYPEAHEAD < 16 ) hb_set.HB_SET_TYPEAHEAD = 16;
int old = hb_set.HB_SET_TYPEAHEAD;
hb_set.HB_SET_TYPEAHEAD = set_number (pArg2, old);
if( hb_set.HB_SET_TYPEAHEAD == 0 ) /* Do nothing */ ;
else if( hb_set.HB_SET_TYPEAHEAD < 16 ) hb_set.HB_SET_TYPEAHEAD = 16;
else if( hb_set.HB_SET_TYPEAHEAD > 4096 ) hb_set.HB_SET_TYPEAHEAD = 4096;
/* Always reset the buffer, but only reallocate if the size changed */
hb_inkeyReset( old == hb_set.HB_SET_TYPEAHEAD ? FALSE : TRUE );
}
break;
case HB_SET_UNIQUE :
@@ -886,6 +893,9 @@ HARBOUR HB_SET (void)
hb_retl (hb_set.HB_SET_WRAP);
if (args > 1) hb_set.HB_SET_WRAP = set_logical (pArg2);
break;
default :
/* Return NIL if called with invalid SET specifier */
hb_ret();
}
}
@@ -938,7 +948,7 @@ void hb_setInitialize (void)
hb_set.HB_SET_SCOREBOARD = TRUE;
hb_set.HB_SET_SCROLLBREAK = TRUE;
hb_set.HB_SET_SOFTSEEK = FALSE;
hb_set.HB_SET_TYPEAHEAD = 50;
hb_set.HB_SET_TYPEAHEAD = 50; hb_inkeyReset( TRUE ); /* Allocate keyboard typeahead buffer */
hb_set.HB_SET_UNIQUE = FALSE;
hb_set.HB_SET_WRAP = FALSE;
}
@@ -965,4 +975,5 @@ void hb_setRelease (void)
hb_xfree (hb_set.HB_SET_PATH);
if (hb_set.HB_SET_PRINTFILE)
hb_xfree (hb_set.HB_SET_PRINTFILE);
hb_set.HB_SET_TYPEAHEAD = -1; hb_inkeyReset( TRUE ); /* Free keyboard typeahead buffer */
}

1
harbour/source/tools/Makefile
View File

@@ -31,6 +31,7 @@ C_SOURCES=\
strright.c \
PRG_SOURCES=\
fileread.prg \
stringp.prg \
LIB=tools

334
harbour/source/tools/fileread.prg Normal file
View File

@@ -0,0 +1,334 @@
/* $Id$
Harbour Project source code
A class that reads a file one line at a time
Copyright 1999 David G. Holm <dholm@jsd-llc.com>
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/).
V 1.1 David G. Holm Committed to CVS.
V 1.0 David G. Holm Initial version.
*/
#include "fileio.ch"
#define oF_ERROR_MIN 1
#define oF_CREATE_OBJECT 1
#define oF_OPEN_FILE 2
#define oF_READ_FILE 3
#define oF_CLOSE_FILE 4
#define oF_ERROR_MAX 4
#define oF_DEFAULT_READ_SIZE 4096
/* $DOC$
* $FUNCNAME$
* TFileRead()
* $CATEGORY$
* Harbour Tools
* $ONELINER$
* Read a file one line at a time
* $SYNTAX$
* oFile := TFileRead():New( <cFileName> [, <nReadSize> ] )
* $ARGUMENTS$
* cFileName is the required name of the file to be read.
* nReadSize is the optional size to use when reading from the file.
* The default value is 4096 and the allowed range is 1 through 65535.
* Any value outside of this range causes the default value to be used.
* $RETURNS$
* An instance of the File Reader class
* $DESCRIPTION$
* TFileRead() is used to access a file one line at a time. You must
* specify the name of the file when an instance of the class is created.
* The class data should be considered private to the class.
* The class methods are as follows:
* New() Creates a new instance of the TFileRead class.
* Open([<nFlags>]) Opens the file for reading. The optional nFlags
* parameter can use any of the FOPEN() flags from
* fileio.ch. The default is FO_READ + FO_SHARED.
* Calling this method when the file is already
* open causes the next ReadLine() to start over
* from the beginning of the file.
* Close() Closes the file.
* ReadLine() Returns one line from the file, stripping the
* newline characters. The following sequences are
* treated as one newline: 1) CR CR LF; 2) CR LF;
* 3) LF; and 4) CR. Note: LF CR is 2 newlines.
* Name() Returns the name of the file.
* IsOpen() Returns .T. if the file is open.
* MoreToRead() Returns .T. if there are more lines to be read
* (think of it as an inverse EOF function).
* Error() Returns .T. if an error has occurred.
* ErrorNo() Returns the current error code.
* ErrorMsg([<cPre>]) Returns a formatted error message.
* $EXAMPLES$
* #ifdef __HARBOUR__
* #define NEW_LINE CHR( 10 )
* #else
* #define NEW_LINE CHR( 13 ) + CHR( 10 )
* #endif
* #include "fileio.ch"
*
* PROCEDURE Main( cFile )
* LOCAL oFile := TFileRead():New( cFile )
*
* oFile:Open()
* IF oFile:Error()
* QOUT( oFile:ErrorMsg( "FileRead: " ) )
* ELSE
* WHILE oFile:MoreToRead()
* OUTSTD( oFile:ReadLine() )
* OUTSTD( NEW_LINE )
* END WHILE
* oFile:Close()
* END IF
* QUIT
* $TESTS$
* See Examples
* $STATUS$
* C
* $COMPLIANCE$
* This is a new Harbour Tools class
* $SEEALSO$
* TClass
* $END$
*/
FUNCTION TFileRead()
STATIC oClass
IF oClass == NIL
oClass := TClass():New( "TFile" ) // New class
oClass:AddClassData( "cFile" ) // The filename
oClass:AddClassData( "nHan" ) // The open file handle
oClass:AddClassData( "lEOF" ) // The end of file reached flag
oClass:AddClassData( "nError" ) // The current file error code
oClass:AddClassData( "nLastOp" ) // The last operation done (for error messages)
oClass:AddClassData( "cBuffer" ) // The readahead buffer
oClass:AddClassData( "nReadSize" ) // How much to add to the readahead buffer on
// each read from the file
oClass:AddMethod( "New", @f_new() ) // Create a new class instance
oClass:AddMethod( "Open", @f_open() ) // Open the file for reading
oClass:AddMethod( "Close", @f_close() ) // Close the file when done
oClass:AddMethod( "ReadLine", @f_read() ) // Read a line from the file
oClass:AddMethod( "Name", @f_name() ) // Retunrs the file name
oClass:AddMethod( "IsOpen", @f_is_open() ) // Returns .T. if file is open
oClass:AddMethod( "MoreToRead", @f_more() ) // Returns .T. if more to be read
oClass:AddMethod( "Error", @f_error() ) // Returns .T. if error occurred
oClass:AddMethod( "ErrorNo", @f_error_no() ) // Returns current error code
oClass:AddMethod( "ErrorMsg", @f_error_msg() ) // Returns formatted error message
oClass:Create()
END IF
RETURN oClass:Instance()
STATIC FUNCTION f_new( cFile, nSize )
LOCAL oSelf := Qself()
IF nSize == NIL .OR. nSize < 1
// The readahead size can be set to as little as 1 byte, or as much as
// 65535 bytes, but venturing out of bounds forces the default size.
nSize := oF_DEFAULT_READ_SIZE
END IF
oSelf:cFile := cFile // Save the file name
oSelf:nHan := -1 // It's not open yet
oSelf:lEOF := .T. // So it must be at EOF
oSelf:nError := 0 // But there haven't been any errors
oSelf:nLastOp := oF_CREATE_OBJECT // Because we just created the class
oSelf:cBuffer := "" // and nothing has been read yet
oSelf:nReadSize := nSize // But will be in this size chunks
RETURN oSelf
STATIC FUNCTION f_open( nMode )
LOCAL oSelf := Qself()
IF oSelf:nHan == -1
// Only open the file if it isn't already open.
IF nMode == NIL
nMode := FO_READ + FO_SHARED // Default to shared read-only mode
END IF
oSelf:nLastOp := oF_OPEN_FILE
oSelf:nHan := FOPEN( oSelf:cFile, nMode ) // Try to open the file
IF oSelf:nHan == -1
oSelf:nError := FERROR() // It didn't work
oSelf:lEOF := .T. // So force EOF
ELSE
oSelf:nError := 0 // It worked
oSelf:lEOF := .F. // So clear EOF
END IF
ELSE
// The file is already open, so rewind to the beginning.
IF FSEEK( oSelf:nHan, 0 ) == 0
oSelf:lEOF := .F. // Definitely not at EOF
ELSE
oSelf:nError := FERROR() // Save error code if not at BOF
END IF
oSelf:cBuffer := "" // Clear the readahead buffer
END IF
RETURN oSelf
STATIC FUNCTION f_read()
LOCAL oSelf := Qself()
LOCAL cLine := ""
LOCAL nPos
oSelf:nLastOp := oF_READ_FILE
IF oSelf:nHan == -1
oSelf:nError := -1 // Set unknown error if file not open
ELSE
// Is there a whole line in the readahead buffer?
nPos := f_EOL_pos( oSelf )
WHILE ( nPos <= 0 .OR. nPos > LEN( oSelf:cBuffer ) - 3 ) .AND. !oSelf:lEOF
// Either no or maybe, but there is possibly more to be read.
// Maybe means that we found either a CR or an LF, but we don't
// have enough characters to discriminate between the three types
// of end of line conditions that the class recognizes (see below).
cLine := FREADSTR( oSelf:nHan, oSelf:nReadSize )
IF EMPTY( cLine )
// There was nothing more to be read. Why? (Error or EOF.)
oSelf:nError := FERROR()
IF oSelf:nError == 0
// Because the file is at EOF.
oSelf:lEOF := .T.
END IF
ELSE
// Add what was read to the readahead buffer.
oSelf:cBuffer += cLine
cLine := ""
END IF
// Is there a whole line in the readahead buffer yet?
nPos := f_EOL_pos( oSelf )
END WHILE
// Is there a whole line in the readahead buffer?
IF nPos <= 0
// No, which means that there is nothing left in the file either, so
// return the entire buffer contents as the last line in the file.
cLine := oSelf:cBuffer
oSelf:cBuffer := ""
ELSE
// Yes. Is there anything in the line?
IF nPos > 1
// Yes, so return the contents.
cLine := LEFT( oSelf:cBuffer, nPos - 1 )
ELSE
// No, so return an empty string.
cLine := ""
END IF
// Deal with multiple possible end of line conditions.
DO CASE
CASE SUBSTR( oSelf:cBuffer, nPos, 3 ) == CHR( 13 ) + CHR( 13 ) + CHR( 10 )
// It's a messed up DOS newline (such as that created by a program
// that uses "\r\n" as newline when writing to a text mode file,
// which causes the '\n' to expand to "\r\n", giving "\r\r\n").
nPos += 3
CASE SUBSTR( oSelf:cBuffer, nPos, 2 ) == CHR( 13 ) + CHR( 10 )
// It's a standard DOS newline
nPos += 2
OTHERWISE
// It's probably a Mac or Unix newline
nPos++
END CASE
oSelf:cBuffer := SUBSTR( oSelf:cBuffer, nPos )
END IF
END IF
RETURN cLine
STATIC FUNCTION f_EOL_pos( oFile )
LOCAL nCRpos, nLFpos, nPos
// Look for both CR and LF in the file read buffer.
nCRpos := AT( CHR( 13 ), oFile:cBuffer )
nLFpos := AT( CHR( 10 ), oFile:cBuffer )
DO CASE
CASE nCRpos == 0
// If there's no CR, use the LF position.
nPos := nLFpos
CASE nLFpos == 0
// If there's no LF, use the CR position.
nPos := nCRpos
OTHERWISE
// If there's both a CR and an LF, use the position of the first one.
nPos := MIN( nCRpos, nLFpos )
END CASE
RETURN nPos
STATIC FUNCTION f_close()
LOCAL oSelf := Qself()
oSelf:nLastOp := oF_CLOSE_FILE
oSelf:lEOF := .T.
// Is the file already closed.
IF oSelf:nHan == -1
// Yes, so indicate an unknown error.
oSelf:nError := -1
ELSE
// No, so close it already!
FCLOSE( oSelf:nHan )
oSelf:nError := FERROR()
oSelf:nHan := -1 // The file is no longer open
oSelf:lEOF := .T. // So force an EOF condition
END IF
RETURN oSelf
STATIC FUNCTION f_name()
LOCAL oSelf := Qself()
// Returns the filename associated with this class instance.
RETURN oSelf:cFile
STATIC FUNCTION f_is_open()
LOCAL oSelf := Qself()
// Returns .T. if the file is open.
RETURN oSelf:nHan != -1
STATIC FUNCTION f_more()
LOCAL oSelf := Qself()
// Returns .T. if there is more to be read from either the file or the
// readahead buffer. Only when both are exhausted is there no more to read.
RETURN !oSelf:lEOF .OR. !EMPTY( oSelf:cBuffer )
STATIC FUNCTION f_error()
LOCAL oSelf := Qself()
// Retunrs .T. if an error was recorded.
RETURN oSelf:nError != 0
STATIC FUNCTION f_error_no()
LOCAL oSelf := Qself()
// Returns the last error code that was recorded.
RETURN oSelf:nError
STATIC FUNCTION f_error_msg( cText )
STATIC cAction := {"on", "creating object for", "opening", "reading from", "closing"}
LOCAL oSelf := Qself()
LOCAL cMessage, nTemp
// Has an error been recorded?
IF oSelf:nError == 0
// No, so report that.
cMessage := "No errors have been recorded for " + oSelf:cFile
ELSE
// Yes, so format a nice error message, while avoiding a bounds error.
IF oSelf:nLastOp < oF_ERROR_MIN .OR. oSelf:nLastOp > oF_ERROR_MAX
nTemp := 1
ELSE
nTemp := oSelf:nLastOp + 1
END IF
cMessage := IF( EMPTY( cText ), "", cText ) + "Error " + ALLTRIM( STR( oSelf:nError ) ) + " " + cAction[ nTemp ] + " " + oSelf:cFile
END IF
RETURN cMessage

10
harbour/source/vm/hvm.c
View File

@@ -45,10 +45,11 @@
#include <string.h>
#include "hbsetup.h" /* main configuration file */
#include <extend.h>
#include <errorapi.h>
#include <pcode.h>
#include <set.h>
#include "extend.h"
#include "errorapi.h"
#include "pcode.h"
#include "set.h"
#include "inkey.h"
HARBOUR HB_ERRORSYS( void );
HARBOUR HB_ERRORNEW( void );
@@ -307,6 +308,7 @@ void VirtualMachine( PBYTE pCode, PSYMBOL pSymbols )
while( ( bCode = pCode[ w ] ) != HB_P_ENDPROC && ! bQuit )
{
hb_inkeyPoll(); /* Poll the console keyboard */
switch( bCode )
{
case HB_P_AND:

5
harbour/tests/working/Makefile
View File

@@ -52,6 +52,7 @@ PRG_SOURCES=\
inherit.prg \
inifiles.prg \
initexit.prg \
inkeytst.prg \
inline.prg \
instr.prg \
iotest.prg \
@@ -75,6 +76,7 @@ PRG_SOURCES=\
passref.prg \
procline.prg \
procname.prg \
readfile.prg \
readhrb.prg \
recursiv.prg \
returns.prg \
@@ -88,8 +90,6 @@ PRG_SOURCES=\
set_test.prg \
statfun.prg \
statics.prg \
statics1.prg \
statics2.prg \
strcmp.prg \
strdelim.prg \
strings.prg \
@@ -150,5 +150,6 @@ LIBS=\
vm \
rtl \
rdd \
hbpp \
include $(TOP)$(ROOT)config/test.cf

172
harbour/tests/working/inkeytst.prg Normal file
View File

@@ -0,0 +1,172 @@
//
// $Id$
//
// Testing Harbour rounding.
/* Harbour Project source code
http://www.Harbour-Project.org/
Copyright 1999 David G. Holm <dholm@jsd-llc.com>
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
#include "inkey.ch"
PROCEDURE main()
LOCAL nKey, nMask, cText
? "Testing the KEYBOARD and CLEAR TYPEAHEAD commands and the"
? "INKEY(), NEXTKEY(), and LASTKEY() functions."
?
? "For the first test, the keyboard will be stuffed with the"
? "text 'AB' and then INKEY() will be called twice."
?
? "The result should be: 65 66"
?
Results()
?
KEYBOARD "AB"
? INKEY(), INKEY()
?
NextTest()
?
? "For the second test, the keyboard will be stuffed with the"
? "text 'HELLO', then the typeahead will be cleared, and then"
? "INKEY() will be called once."
?
? "The result should be: 0"
?
Results()
?
KEYBOARD "HELLO"
CLEAR TYPEAHEAD
? INKEY()
?
NextTest()
?
? "For the third test, the keyboard will be stuffed with the"
? "text 'AB', then NEXTKEY() will be called twice and finally"
? "INKEY() will be called twice."
?
? "The result should be: 65 65 65 66"
?
Results()
?
KEYBOARD "AB"
? NEXTKEY(), NEXTKEY(), INKEY(), INKEY()
?
NextTest()
?
? "For the fourth test, the keyboard will be stuffed with the"
? "Text 'AB', then INKEY() will be called once, LASTKEY() will"
? "be called twice, NEXTKEY() will be called once, and finally"
? "INKEY() will be called once."
?
? "The result should be: 65 65 65 66 66"
?
Results()
?
KEYBOARD "AB"
? INKEY(), LASTKEY(), LASTKEY(), NEXTKEY(), INKEY()
?
NextTest()
?
cText := "THIS IS A TEST. THIS IS ONLY A TEST. DO NOT PANIC!"
? "For the fifth test, the keyboard will be stuffed with the"
? "Text '" + cText + "'"
? "with the typeahead buffer set to the default size, then 25"
? "then 16, then 0. After each attempt to stuff the buffer,"
? "the buffer will be emptied using NEXTKEY() and INKEY() and"
? "the ASCII text that was extracted will be displayed."
?
? "For the default size, which is 50, all but '" + RIGHT( cText, LEN( cText ) - 49 ) + "' should be"
? "displayed. For size 25, '" + LEFT( cText, 24 ) + "' should"
? "be displayed. Size 16 should display '" + LEFT( cText, 15 ) + "',"
? "while size 0 should display ''."
?
? "Default TYPEAHEAD (50)"
?
Results()
?
? TEST( cText )
?
? "SET TYPEAHEAD TO 25"
?
Results()
?
SET TYPEAHEAD TO 25
? TEST( cText )
?
? "SET TYPEAHEAD TO 16"
?
Results()
?
SET TYPEAHEAD TO 16
? TEST( cText )
?
? "SET TYPEAHEAD TO 0"
?
Results()
?
SET TYPEAHEAD TO 0
? TEST( cText )
?
NextTest()
?
? "The typeahead is now being set to a value greater than the maximum,"
? "which is 4096 and is the value that will both be used and reported."
?
SET TYPEAHEAD TO 5000
? SET(_SET_TYPEAHEAD)
?
NextTest()
?
? "For the last test, a loop is started and all keyboard and mouse"
? "events are allowed. Each event will be displayed. Press the ESC"
? "key to exit. Try moving the mouse, holding and releasing the mouse"
? "buttons as well as double-clicking the mouse buttons."
?
? "TODO: Mouse support needs to be added to Harbour."
?
? "Press any key."
nMask := INKEY_ALL + INKEY_EXTENDED
SET(_SET_EVENTMASK, nMask)
WHILE (nKey := INKEY( 0, nMask )) != K_ESC
DO CASE
CASE nKey == K_MOUSEMOVE
? "The mouse moved."
CASE nKey == K_LBUTTONDOWN
? "The left mouse button was pushed."
CASE nKey == K_LBUTTONUP
? "The left mouse button was released."
CASE nKey == K_RBUTTONDOWN
? "The right mouse button was pushed."
CASE nKey == K_RBUTTONUP
? "The right mouse button was released."
CASE nKey == K_LDBLCLK
? "The left mouse button was double-clicked."
CASE nKey == K_RDBLCLK
? "The right mouse button was double-clicked."
OTHERWISE
? "A keyboard key was pressed: ", nKey, IF( nKey >= 32 .AND. nKey <= 255, CHR( nKey ), "" )
END CASE
END WHILE
? "The ESC key was pressed. Exiting..."
QUIT
PROCEDURE Results()
? "Wait 2 seconds or press most any key to see the results of this test."
INKEY( 2 )
RETURN
PROCEDURE NextTest()
? "Press any key to continue on to the next test."
INKEY( 0 )
RETURN
FUNCTION TEST( cText )
LOCAL cResult := ""
INKEY( 2 )
KEYBOARD cText
WHILE NEXTKEY() <> 0
cResult += CHR( INKEY () )
END WHILE
RETURN "'" + cResult + "'"

37
harbour/tests/working/mathtest.prg
View File

@@ -3,18 +3,27 @@
//
func main()
qout(sin(33) )
qout(cos(43) )
qout(tan(54))
qout(log10(112))
qout(log(12))
qout(sqrt(16))
qout(asin(33) )
qout(acos(43) )
qout(atan(54))
qout(abs(10))
qout(exp(15))
qout(454.14)
qout(int(454.14))
qout(int(454))
qout( 1 / 0 )
qout( 1 % 0 )
qout( sin( 33 ) )
qout( cos( 43 ) )
qout( tan( 54 ) )
qout( log10( 112 ) )
qout( log( 12 ) )
qout( sqrt( 16 ) )
qout( asin( 33 ) )
qout( acos( 43 ) )
qout( atan( 54 ) )
qout( abs( 10 ) )
qout( exp( 15 ) )
qout( 454.14 )
qout( int( 454.14 ) )
qout( int( 454 ) )
qout( min( 1, 1.0 ) )
qout( min( 1, 10 ) )
qout( max( 1.0, 1 ) )
qout( max( 1, 10 ) )
qout( min( stod( "19990101" ), stod( "20000101" ) ) )
qout( max( stod( "19990101" ), stod( "20000101" ) ), "An argument error will appear on the next line.")
qout( min( stod( "19990101" ), 20000101 ) )
return nil

31
harbour/tests/working/readfile.prg Normal file
View File

@@ -0,0 +1,31 @@
//
// $Id$
//
// Test program for new class that reads a file one line at a time
/* Harbour Project source code
http://www.Harbour-Project.org/
Copyright 1999 David G. Holm <dholm@jsd-llc.com>
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
#ifdef __HARBOUR__
#define NEW_LINE CHR( 10 )
#else
#define NEW_LINE CHR( 13 ) + CHR( 10 )
#endif
#include "fileio.ch"
PROCEDURE Main( cFile )
LOCAL oFile := TFileRead():New( cFile )
oFile:Open()
IF oFile:Error()
QOUT( oFile:ErrorMsg( "FileRead: " ) )
ELSE
WHILE oFile:MoreToRead()
OUTSTD( oFile:ReadLine() )
OUTSTD( NEW_LINE )
END WHILE
oFile:Close()
END IF
QUIT

27
harbour/tests/working/seconds.prg
View File

@@ -9,13 +9,26 @@
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
function Main()
local n
#ifdef __HARBOUR__
#define NEWLINE CHR(10)
#else
#define NEWLINE CHR(13)+CHR(10)
#endif
QOUT(SECONDS())
FOR n := 1 TO 10
__ACCEPT("Pause: ")
QOUT(SECONDS())
function Main( cParam )
local n, limit := 10
IF( ! EMPTY( cParam ) )
limit := VAL( cParam )
END IF
OUTSTD( SECONDS() )
OUTSTD( NEWLINE )
FOR n := 1 TO limit
IF( EMPTY( cParam ) )
__ACCEPT( "Pause: " )
END IF
OUTSTD( SECONDS() )
OUTSTD( NEWLINE )
NEXT
return NIL
RETURN NIL