diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 0dac099fb5..b6f9cc3dcb 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,64 @@ +19990726-21:35 EDT David G. Holm + * 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 + Build40.bat and Makefile.b40 Build and makefile for Borland 4.0 diff --git a/harbour/config/os2/dir.cf b/harbour/config/os2/dir.cf index 5f035f57a8..a8a761acf3 100644 --- a/harbour/config/os2/dir.cf +++ b/harbour/config/os2/dir.cf @@ -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 diff --git a/harbour/config/os2/install.cf b/harbour/config/os2/install.cf index 535862fc8f..a662736d1f 100644 --- a/harbour/config/os2/install.cf +++ b/harbour/config/os2/install.cf @@ -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 diff --git a/harbour/include/inkey.ch b/harbour/include/inkey.ch index 08a19b73a4..842af45c35 100644 --- a/harbour/include/inkey.ch +++ b/harbour/include/inkey.ch @@ -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 diff --git a/harbour/include/inkey.h b/harbour/include/inkey.h new file mode 100644 index 0000000000..57e960d94a --- /dev/null +++ b/harbour/include/inkey.h @@ -0,0 +1,48 @@ +/* $Id$ + + Harbour Project source code + + This module contains the Harbour declarations for INKEY management. + + Copyright 1999 David G. Holm + 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 + +/* 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 diff --git a/harbour/include/set.h b/harbour/include/set.h index 919a0a315b..7741acbc72 100644 --- a/harbour/include/set.h +++ b/harbour/include/set.h @@ -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, diff --git a/harbour/source/hbpp/Makefile b/harbour/source/hbpp/Makefile index 81c8b1169e..535d75c9dd 100644 --- a/harbour/source/hbpp/Makefile +++ b/harbour/source/hbpp/Makefile @@ -7,6 +7,7 @@ ROOT = ../../ C_SOURCES=\ hbpp.c \ hbppint.c \ + preproc.c \ table.c \ LIB=hbpp diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index ce7d856d70..26cbf6a301 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -19,6 +19,7 @@ C_SOURCES=\ files.c \ gtapi.c \ hardcr.c \ + inkey.c \ itemapi.c \ math.c \ memvars.c \ diff --git a/harbour/source/rtl/dates.c b/harbour/source/rtl/dates.c index e7f3d1166b..a55f4810d0 100644 --- a/harbour/source/rtl/dates.c +++ b/harbour/source/rtl/dates.c @@ -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 } diff --git a/harbour/source/rtl/files.c b/harbour/source/rtl/files.c index 8f0f7de770..87687590fe 100644 --- a/harbour/source/rtl/files.c +++ b/harbour/source/rtl/files.c @@ -6,6 +6,7 @@ #include #include #include +#include #if defined(__CYGNUS__) #include @@ -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; diff --git a/harbour/source/rtl/inkey.c b/harbour/source/rtl/inkey.c new file mode 100644 index 0000000000..66709fb48d --- /dev/null +++ b/harbour/source/rtl/inkey.c @@ -0,0 +1,622 @@ +/* $Id$ + + Harbour Project source code + + This module contains the Harbour functions for INKEY management. + + Copyright 1999 David G. Holm + 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 +#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__MSC__) || defined(_MSC_VER) + #include + #include +#elif defined(__DJGPP__) + #include + #include +#elif defined(HARBOUR_GCC_OS2) + #include +#elif defined(__IBMCPP__) + #include +#endif + +#ifdef __WATCOMC__ + #include + #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( [] [,] ) --> nKey + * $ARGUMENTS$ + * 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. + * 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_ 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( [] ) + * $CATEGORY$ + * Console input + * $ONELINER$ + * DO NOT CALL THIS FUNCTION DIRECTLY! + * $SYNTAX$ + * KEYBOARD + * CLEAR TYPEAHEAD + * $ARGUMENTS$ + * 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 ); +} diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index 6e75ee8ed5..eb81733ccb 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -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 diff --git a/harbour/source/rtl/set.c b/harbour/source/rtl/set.c index b2798824db..42f6f22453 100644 --- a/harbour/source/rtl/set.c +++ b/harbour/source/rtl/set.c @@ -168,6 +168,7 @@ #include #endif #include +#include #include #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 */ } diff --git a/harbour/source/tools/Makefile b/harbour/source/tools/Makefile index 6a684c81f4..7af7943bb6 100644 --- a/harbour/source/tools/Makefile +++ b/harbour/source/tools/Makefile @@ -31,6 +31,7 @@ C_SOURCES=\ strright.c \ PRG_SOURCES=\ + fileread.prg \ stringp.prg \ LIB=tools diff --git a/harbour/source/tools/fileread.prg b/harbour/source/tools/fileread.prg new file mode 100644 index 0000000000..7fa6d34fa5 --- /dev/null +++ b/harbour/source/tools/fileread.prg @@ -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 + 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( [, ] ) + * $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([]) 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([]) 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 diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index c430f657d7..8cc5e68402 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -45,10 +45,11 @@ #include #include "hbsetup.h" /* main configuration file */ -#include -#include -#include -#include +#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: diff --git a/harbour/tests/working/Makefile b/harbour/tests/working/Makefile index b333a6968a..5751f4adff 100644 --- a/harbour/tests/working/Makefile +++ b/harbour/tests/working/Makefile @@ -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 diff --git a/harbour/tests/working/inkeytst.prg b/harbour/tests/working/inkeytst.prg new file mode 100644 index 0000000000..ce6ec19482 --- /dev/null +++ b/harbour/tests/working/inkeytst.prg @@ -0,0 +1,172 @@ +// +// $Id$ +// + +// Testing Harbour rounding. +/* Harbour Project source code + http://www.Harbour-Project.org/ + Copyright 1999 David G. Holm + 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 + "'" diff --git a/harbour/tests/working/mathtest.prg b/harbour/tests/working/mathtest.prg index a7f03f101c..16f2df6bf4 100644 --- a/harbour/tests/working/mathtest.prg +++ b/harbour/tests/working/mathtest.prg @@ -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 diff --git a/harbour/tests/working/readfile.prg b/harbour/tests/working/readfile.prg new file mode 100644 index 0000000000..62068cc3ab --- /dev/null +++ b/harbour/tests/working/readfile.prg @@ -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 + 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 diff --git a/harbour/tests/working/seconds.prg b/harbour/tests/working/seconds.prg index 60174340ab..83998c5e5e 100644 --- a/harbour/tests/working/seconds.prg +++ b/harbour/tests/working/seconds.prg @@ -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