diff --git a/harbour/contrib/libnf/kspeed.c b/harbour/contrib/libnf/kspeed.c new file mode 100644 index 0000000000..36786fe43c --- /dev/null +++ b/harbour/contrib/libnf/kspeed.c @@ -0,0 +1,177 @@ +/* + * $Id$ + */ + +/* File......: KSPEED.ASM +* Author....: James R. Zack +* CIS ID....: 75410,1567 +* +* This is an original work by James R. Zack and is placed in the +* public domain. +* +* Modification history: +* --------------------- +* +* Rev 1.2 15 Aug 1991 23:06:54 GLENN +* Forest Belt proofread/edited/cleaned up doc +* +* Rev 1.1 14 Jun 1991 19:54:40 GLENN +* Minor edit to file header +* +* Rev 1.0 01 Apr 1991 01:03:28 GLENN +* Nanforum Toolkit +* +*/ + + +/* $DOC$ +* $FUNCNAME$ +* FT_SETRATE() +* $CATEGORY$ +* Keyboard/Mouse +* $ONELINER$ +* Set the keyboard delay and repeat rate on PC/AT & PS/2 +* $SYNTAX$ +* FT_SETRATE( [ ] [, ] ) -> NIL +* $ARGUMENTS$ +* is the keyboard delay time. +* +* is the keyboard repeat rate. +* +* 旼컴컴컴컴컴컴컴컴컴컴컴� 旼컴컴컴컴컴컴컴컴컴컴컴커 +* � nDelayTime DELAY � � RepeatRate SPEED � +* 쳐컴컴컴컴컴컴컴컴컴컴컴� 쳐컴컴컴컴컴컴컴컴컴컴컴캑 +* � 0 250ms � � 0 30.0cps � +* � 1 (default) 500ms � � 1 26.7cps � +* � 2 750ms � � 2 24.0cps � +* � 3 1000ms � � 3 21.8cps � +* 읕컴컴컴컴컴컴컴컴컴컴컴� � 4 20.0cps � +* � 5 18.5cps � +* � 6 17.1cps � +* � 7 16.0cps � +* � 8 15.0cps � +* � 9 13.3cps � +* � 10 12.0cps � +* � 11 10.9cps � +* � 12 (default) 10.0cps � +* � 13 9.2cps � +* � 14 8.6cps � +* � 15 8.0cps � +* � 16 7.5cps � +* � 17 6.7cps � +* � 18 6.0cps � +* � 19 5.5cps � +* � 20 5.0cps � +* � 21 4.6cps � +* � 22 4.3cps � +* � 23 4.0cps � +* � 24 3.7cps � +* � 25 3.3cps � +* � 26 3.0cps � +* � 27 2.7cps � +* � 28 2.5cps � +* � 29 2.3cps � +* � 30 2.1cps � +* � 31 2.0cps � +* 읕컴컴컴컴컴컴컴컴컴컴컴켸 +* $RETURNS$ +* NIL +* $DESCRIPTION$ +* This routine is used to adjust the IBM PC/AT and PS/2 "typematic" +* repeat and delay feature. This is used to allow the users of your +* application to adjust these speeds to the most comfortable level. +* +* This source code is written for Microsoft Assembler v5.1. +* $EXAMPLES$ +* FT_SETRATE(0,0) // Set keyboard to fastest possible settings +* FT_SETRATE() // Set keyboard to AT defaults (10.9cps,500ms delay) +* FT_SETRATE(11,1) // Set keyboard to PS/2 defaults (10cps,500ms delay) +* $END$ +*/ +/*This is the Original FT_SETRATE() code +PUBLIC FT_SETRATE * MAKE ROUTINE VISIBLE + +EXTRN __PARNI:FAR * DECLARE EXTERNALS +EXTRN __RET:FAR +EXTRN __PARINFO:FAR + +_NANFOR SEGMENT 'CODE' + ASSUME CS:_NANFOR * POINT CS TO MY CODE +FT_SETRATE PROC FAR + PUSH BP * SAVE BASE POINTER + MOV BP,SP * POINT TO TOP OF STACK + PUSH DS * SAVE REGISTERS + PUSH ES + PUSH SI + PUSH DI + MOV AX,0 * LOOK AT NUMBER OF PARAMS PASSED + PUSH AX * SET UP FOR __PARINFO + CALL __PARINFO * GET NUMBER OF PARAMS PASSED + ADD SP,2 * ADJUST STACK + CMP AX,2 * WERE BOTH PARMS PASSED? + JL DEFAULTS * NO, USE DEFAULTS + JMP GETPARMS * OTHERWISE, LETS GET SOME PARAMS. +DEFAULTS: MOV BX,010CH * SET UP DEFAULTS (for AT) + jmp goodparm * and make the int call. +getparms: mov ax,01h * First param is repeat rate + push ax * Set up for __PARNI + call __PARNI * Get first param + add sp,2 * Adjust stack + mov bl,al * Put repeat rate into BL + cmp bl,20h * Is BL > 20h? (max value) + jg defaults * Yes, then use defaults + mov ax,02h * Second parm is typeamatic delay + push ax * Set up for __PARNI + call __PARNI * Get second param + add sp,2 * Adjust stack + mov bh,al * Put delay into BH + cmp bh,04h * Is BH > 04h (max value) + jg defaults * Yes, then use defaults +goodparm: mov ax,0305h * BIOS Function 03 Subfunction 05 + int 16h * Set Typematic Rate and Delay +exit: pop di * Retore registers + pop si + pop es + pop ds + pop bp + call __RET * Clean up for Clipper + ret * Pass control back to Clipper +FT_SETRATE ENDP +_NanFor ENDS + END +*/ + +/* This is the New one Rewriten in C*/ + +#include "extend.h" +#include "dos.h" + +HB_FUNC( FT_SETRATE) +{ +#if defined(HB_OS_DOS) + { + + union REGS registers; + int tempo,nrepete; + switch(PCOUNT) { + case 0: tempo = 0 ; + nrepete = 0; + break; + case 1: tempo = hb_parni(1) ; + nrepete = 0; + break; + case 0: tempo = hb_parni(1); + nrepete = hb_parni(2); + break; + } + registers.h.ah = 0x03; + registers.h.al = 0x05; + registers.h.bh = tempo; + registers.h.bl = nrepete; + HB_DOS_INT86(0x16,®isters,®isters); + } +#endif +} + + + diff --git a/harbour/contrib/libnf/lastday.prg b/harbour/contrib/libnf/lastday.prg new file mode 100644 index 0000000000..e19e3915ea --- /dev/null +++ b/harbour/contrib/libnf/lastday.prg @@ -0,0 +1,61 @@ +/* + * File......: LASTDAY.PRG + * Author....: Mike Schinkel + * CIS ID....: ? + * + * This is an original work by Mike Schinkel and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.1 15 Aug 1991 23:02:32 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.0 14 Jun 1991 04:24:04 GLENN + * Initial revision. + * + * + */ + + + /* Librarian's note: The toolkit's original ft_lday() function was + submitted by Jeff Bryant. Mike saw it and optimized it. Thanks + to you both for your great code! + + */ + +/* $DOC$ + * $FUNCNAME$ + * FT_LDAY() + * $CATEGORY$ + * Date/Time + * $ONELINER$ + * Return last day of the month + * $SYNTAX$ + * FT_LDAY( [ ] ) -> dLastDay + * $ARGUMENTS$ + * is a date within a month for which you want to find + * the last date of that month. If not passed or is an incorrect + * type, defaults to current system date. + * $RETURNS$ + * A Clipper date value representing the last date of the month. + * $DESCRIPTION$ + * This function will return the last day of the month of the date + * passed, or the last day of the current month if no argument is + * supplied. + * $EXAMPLES$ + * dDate := CTOD( "09/15/90" ) + * ? FT_LDAY( dDate ) // 09/30/90 + * ? FT_LDAY() // 03/31/91 (current month) + * $SEEALSO$ + * FT_FDAY() + * $END$ + */ + +FUNCTION ft_lday( dDate ) + LOCAL d:= dDate + IF dDate == NIL + d:= Date() + ENDIF + RETURN ( d+= 45 - Day( d ) ) - Day( d ) diff --git a/harbour/contrib/libnf/linked.prg b/harbour/contrib/libnf/linked.prg new file mode 100644 index 0000000000..1ca2336ee1 --- /dev/null +++ b/harbour/contrib/libnf/linked.prg @@ -0,0 +1,135 @@ +/* + * File......: Linked.PRG + * Author....: Brian Loesgen + * CIS ID....: 74326,1174 + * + * This is an original work by Brian Loesgen and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.2 15 Aug 1991 23:05:52 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 14 Jun 1991 19:52:08 GLENN + * Minor edit to file header + * + * Rev 1.0 13 Jun 1991 15:21:26 GLENN + * Initial revision. + * + */ + + +/* $DOC$ + * $FUNCNAME$ + * FT_LINKED() + * $CATEGORY$ + * Environment + * $ONELINER$ + * Determine if a function was linked in + * $SYNTAX$ + * FT_LINKED( ) -> lResult + * $ARGUMENTS$ + * is a character string containing one or more function + * calls + * $RETURNS$ + * .T. if all functions within the string are currently linked into + * the application, .F. if one or more aren't. See below for a + * definition of "function." + * $DESCRIPTION$ + * + * This function would be used in data driven application to determine + * whether or not a macro compiled function was linked in. + * + * Several functions can be passed, and nested, in . + * + * Caveat: Some function calls are converted by the preprocessor + * into other function calls. You cannot have these types of + * functions in a macro compiled string as they never exist at + * runtime. FT_LINKED will correctly tell you that they are invalid. + * + * For instance: there is no function called SORT() in any of the + * Nantucket LIBraries, but it is a valid CLIPPER command because the + * preprocessor will convert it to other function calls. + * + * + * $EXAMPLES$ + * + * cString := "FT_GoodFunc(BadFunc(3,2))" + * IF FT_LINKED(cString) + * EVAL( &("{||"+cString+"}") ) + * ELSE + * ALERT("Error: "+cString+" was not linked in. Called by FT_LINKED()") + * ENDIF + * + * + * $END$ + */ + + +#ifdef FT_TEST + + FUNCTION Main + LOCAL cString + LOCAL aString := { "TRIM('abc ')", ; + "NotARealFunc()", ; + "FT_DispMsg()", ; + 'TRIM(cVar+"abc"+LEFT(cString)), FOUND()', ; + "IsItLinked()", ; + "lRetVal := FOUND()", ; + "!EOF() .AND. MONTH(DATE())=12 .AND. YeeHa()", ; + "!EOF() .AND. MONTH(DATE())=12", ; + "!EOF() .AND. MONTH(DATE(YeeHa()))=12", ; + "LEFT(SUBSTR(nNum,4,VAL(cChar+ASC(c))))", ; + "EOF(>> Note: Syntax IS NOT checked! <<)" ; + } + CLS + @1,0 SAY "String Tested Result" + @2,0 TO 2,MAXCOL() + AEVAL(aString, {|ele,num| QOUT(ele, SPACE(45-LEN(ele)), FT_Linked(ele)) } ) + @MAXROW()-2,0 + RETURN NIL + +#endif + +*------------------------------------------------ + + +FUNCTION FT_Linked( cFuncs ) + +// A function is detected by the left parenthesis, "(", and it begins +// at the space, comma or start-of-string preceeding the "(" + +// Returns: .T. if all functions are available, +// .F. if not + +LOCAL aFuncArray := {}, nSpace, nComma, nFEnd, lRetVal := .F. + +IF AT("(",cFuncs) = 0 + // No functions in string + ALERT("Warning: Expected function(s) in FT_Linked(), but none were found") +ELSE + DO WHILE (nFEnd := AT("(",cFuncs)) > 0 + // Add the current function to the array of functions + AADD( aFuncArray,LEFT(cFuncs,nFEnd)+")" ) + // Remove the current function from the string + cFuncs := SUBSTR(cFuncs, nFEnd+1) + nSpace := AT(" ",cFuncs) ; nComma := AT(",",cFuncs) + DO WHILE (nComma > 0 .and. nComma < nFEnd) .or. ; + (nSpace > 0 .and. nSpace < nFEnd) + // We have extra parameters or spaces prior to the start + // of the function. Strip them out. + if nComma > 0 + cFuncs := SUBSTR(cFuncs, nComma+1) + elseif nSpace > 0 + cFuncs := SUBSTR(cFuncs, nSpace+1) + endif + nSpace := AT(" ", cFuncs) ; nComma := AT(",", cFuncs) + ENDDO + ENDDO + // Scan through the array of functions, stop after the first occurence + // of a function which returns a TYPE() of "U" (hence is not linked in) + lRetVal := ASCAN(aFuncArray,{|element| TYPE(element)=="U"})=0 +ENDIF +RETURN( lRetVal ) diff --git a/harbour/contrib/libnf/madd.prg b/harbour/contrib/libnf/madd.prg new file mode 100644 index 0000000000..987ebb70ed --- /dev/null +++ b/harbour/contrib/libnf/madd.prg @@ -0,0 +1,102 @@ +/* + * File......: MADD.PRG + * Author....: Jo W. French dba Practical Computing + * CIS ID....: 74731,1751 + * + * The functions contained herein are the original work of Jo W. French + * and are placed in the public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.3 28 Sep 1992 00:39:04 GLENN + * Jo French cleaned up. + * + * Rev 1.2 15 Aug 1991 23:03:58 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 14 Jun 1991 19:52:14 GLENN + * Minor edit to file header + * + * Rev 1.0 01 Apr 1991 01:01:38 GLENN + * Nanforum Toolkit + * + */ + +/* $DOC$ + * $FUNCNAME$ + * FT_MADD() + * $CATEGORY$ + * Date/Time + * $ONELINER$ + * Add or subtract months to/from a date + * $SYNTAX$ + * FT_MADD( [ ], [ ], [ ] ) + * -> dDate + * $ARGUMENTS$ + * is any valid date in any date format. Defaults to + * current system date if not supplied. + * + * is the number of months to be added or subtracted. + * Defaults to 0 if not supplied. + * + * is a logical variable indicating whether or not to + * force the returned date to the last date of the month. It only + * affects the returned date if is an end-of-month date. + * $RETURNS$ + * A date. + * $DESCRIPTION$ + * FT_MADD() adds or subtracts months to/from a given date. + * + * If MakeEOM is passed and dGivenDate is the last day of a month, + * it will return the EOM of calculated month. Otherwise it will + * return the same day as the day of the passed date. + * $EXAMPLES$ + * dDate := CTOD( "09/15/90" ) + * ? FT_MADD( dDate, 1 ) // 10/15/90 + * ? FT_MADD( dDate, -2 ) // 07/15/90 + * + * // force EOM + * dDate := CTOD( "04/30/91" ) + * ? FT_MADD( dDate, 1 ) // 05/30/91 + * ? FT_MADD( dDate, 1, .T. ) // 05/31/91 <- forced EOM + * ? FT_MADD( dDate, 2 ) // 06/30/91 + * ? FT_MADD( dDate, 2, .T. ) // 06/30/91 <- June only has 30 days + * ? FT_MADD( dDate, 3 ) // 07/30/91 + * ? FT_MADD( dDate, 3, .T. ) // 07/31/91 <- forced EOM + * + * $SEEALSO$ + * FT_DAYOFYR() FT_DAYTOBOW() + * $END$ +*/ + +FUNCTION FT_MADD( dGivenDate, nAddMonths, lMakeEOM) + LOCAL nAdjDay, dTemp, i + + IF(VALTYPE(dGivenDate) != 'D', dGivenDate := DATE(), ) + IF(VALTYPE(nAddMonths) != 'N', nAddMonths := 0, ) + IF(VALTYPE(lMakeEOM) != 'L', lMakeEom := .F., ) + + nAdjDay := DAY( dGivenDate ) - 1 + + /* If givendate is end of month and lMakeEom, then force EOM.*/ + + lMakeEom := ( lMakeEom .AND. dGivenDate == dGivenDate - nAdjDay + 31 - ; + DAY( dGivenDate - nAdjDay + 31 ) ) + + dTemp := dGivenDate - nAdjDay // first of month + + /* Work with 1st of months.*/ + FOR i := 1 TO ABS(nAddMonths) + dTemp += IF( nAddMonths > 0, 31, -1 ) + dTemp += 1 - DAY( dTemp ) + NEXT + + IF lMakeEom + dTemp += 31 - DAY( dTemp + 31 ) + ELSE + dTemp := MIN( (dTemp + nAdjday), (dTemp += 31 - DAY( dTemp + 31 ))) + ENDIF + +RETURN dTemp + diff --git a/harbour/contrib/libnf/menu1.prg b/harbour/contrib/libnf/menu1.prg new file mode 100644 index 0000000000..e29bbfca20 --- /dev/null +++ b/harbour/contrib/libnf/menu1.prg @@ -0,0 +1,544 @@ +/* + * File......: MENU1.PRG + * Author....: Paul Ferrara + * CIS ID....: 76702,556 + * + * This is an original work by Paul Ferrara and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.2 15 Aug 1991 23:04:42 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 14 Jun 1991 19:52:12 GLENN + * Minor edit to file header + * + * Rev 1.0 01 Apr 1991 01:01:40 GLENN + * Nanforum Toolkit + * + */ + + +/* $DOC$ + * $FUNCNAME$ + * FT_MENU1() + * $CATEGORY$ + * Menus/Prompts + * $ONELINER$ + * Pulldown menu system + * $SYNTAX$ + * FT_MENU1( , , , + * [, ], [ ] ) -> NIL + * $ARGUMENTS$ + * is a character array containing the names to appear + * on the menu bar. + * + * is a multi-dimensional array with one element for each + * selection to appear on the pulldown menus. + * + * is an array containing the colors for the menu groups. + * + * is a numeric value that determines the row for the menu + * bar. If omitted, it defaults to 0. + * + * is a logical variable. If true (.T.) or omitted, it + * uses FT_SHADOW() to add a transparent shadow to the each + * pulldown menu. If false (.F.), the menu is drawn without + * the shadow. + * + * All arguments except nTopRow and lShadow are required. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * FT_MENU1() is a function that displays a pulldown menu for each item + * on the menu bar and executes the corresponding function for the item + * selected. When a called function returns false, FT_MENU1 returns + * control to the calling program. + * + * Valid keystrokes and their corresponding actions: + * + * Home - Activates Pulldown for first item on the menu bar + * End - Activates Pulldown for last item on the menu bar + * Left Arrow - Activates next Pulldown to the left + * Right Arrow - Activates next Pulldown to the right + * Tab - Same as Right Arrow + * Shift-Tab - Same as Left Arrow + * Page Up - Top item on current Pulldown menu + * Page Down - Bottom item on current Pulldown menu + * Enter - Selects current item + * Alpha Character - Moves to closest match and selects + * Alt- - Moves to corresponding menu bar item + * Escape - Prompts for confirmation and either returns to + * the calling routine or resumes + * $EXAMPLES$ + * // Declare arrays + * LOCAL aColors := {} + * LOCAL aBar := { " ENTER/EDIT ", " REPORTS ", " DISPLAY " } + * + * // Include the following two lines of code in your program, as is. + * // The first creates aOptions with the same length as aBar. The + * // second assigns a three-element array to each element of aOptions. + * LOCAL aOptions[ LEN( aBar ) ] + * AEVAL( aBar, { |x,i| aOptions[i] := { {},{},{} } } ) + * + * // fill color array + * // Box Border, Menu Options, Menu Bar, Current Selection, Unselected + * aColors := IF( lColor, {"W+/G", "N/G", "N/G", "N/W", "N+/G"}, ; + * {"W+/N", "W+/N", "W/N", "N/W","W/N"} ) + * + * // array for first pulldown menu + * FT_FILL( aOptions[1], 'A. Execute A Dummy Procedure' , {|| fubar()}, .t. ) + * FT_FILL( aOptions[1], 'B. Enter Daily Charges' , {|| .t.}, .f. ) + * FT_FILL( aOptions[1], 'C. Enter Payments On Accounts', {|| .t.}, .t. ) + * + * // array for second pulldown menu + * FT_FILL( aOptions[2], 'A. Print Member List' , {|| .t.}, .t. ) + * FT_FILL( aOptions[2], 'B. Print Active Auto Charges' , {|| .t.}, .t. ) + * + * // array for third pulldown menu + * FT_FILL( aOptions[3], 'A. Transaction Totals Display', {|| .t.}, .t. ) + * FT_FILL( aOptions[3], 'B. Display Invoice Totals' , {|| .t.}, .t. ) + * FT_FILL( aOptions[3], 'C. Exit To DOS' , {|| .f.}, .t. ) + * + * Call FT_FILL() once for each item on each pulldown menu, passing it + * three parameters: + * + * FT_FILL( , , + * + * is a character string which will be displayed on + * the pulldown menu. + * + * should contain one of the following: + * + * A function name to execute, which in turn should return .T. or .F. + * FT_MENU1 WILL RETURN CONTROL TO THE CALLING PROGRAM IF .F. IS + * RETURNED OR CONTINUE IF .T. IS RETURNED. + * + * .F. WHICH WILL CAUSE FT_MENU1 TO RETURN CONTROL TO THE CALLING + * PROGRAM. + * + * .T. WHICH WILL DO NOTHING. THIS ALLOWS THE DEVELOPER TO DESIGN A + * SKELETON MENU STRUCTURE PRIOR TO COMPLETING ALL OF THE SUBROUTINES. + * + * // CALL FT_MENU1 + * FT_MENU1( aBar, aOptions, aColors, 0 ) + * + * NOTE: FT_MENU1() disables Alt-C and Alt-D in order to make them + * available for the menu bar. It enables Alt-D and resets + * Alt-C to its previous state prior to calling each function. + * $SEEALSO$ + * FT_FILL() + * $END$ + */ + + + + +/* + For the sample program: + + Compile with "/n /dFT_TEST" SWITCHES AND LINK. + + PASS "MONO" OR "MONO" AS A COMMAND LINE PARAMETER TO FORCE MONO MODE. + + PASS "NOSNOW" OR "NOSNOW" AS A COMMAND LINE PARAMETER ON A CGA. + + PASS "VGA" OR "VGA" AS A COMMAND LINE PARAMETER FOR 50-LINE MODE. + */ + + + + +#define LEFTARROW 19 +#define RIGHTARROW 4 +#define ENTER 13 +#define CTRLEND 23 +#define CTRLHOME 29 +#define HOME 1 +#define END 6 +#define TAB 9 +#define SHIFTTAB 271 +#define PGUP 18 +#define PGDN 3 +#define ESCAPE 27 +#define HITTOP 1 +#define HITBOTTOM 2 +#define KEYEXCEPT 3 +#define NEXTITEM 3 +#define RESUME 2 +#define MAKESELECT 1 +#define ABORT 0 +#define DISABLE 0 +#define ENABLE 1 +#define SCNONE 0 +#define SCNORMAL 1 + +STATIC ACHOICES := {}, AVALIDKEYS := {} +STATIC NHPOS, NVPOS, NMAXROW, NMAXCOL + +// BEGINNING OF DEMO PROGRAM +#IFDEF FT_TEST + // DUMMY PROCEDURE NAME SO "CCMDLINE" WILL BE LOCAL + PROCEDURE CALLMENU( cCmdLine ) + LOCAL sDosScrn, nDosRow, nDosCol, lColor + + // my approach to color variables + // see colorchg.arc on NANFORUM + STATIC cNormH, cNormN, cNormE, ; + cWindH, cWindN, cWindE, ; + cErrH, cErrN, cErrE + + // options on menu bar + LOCAL aColors := {} + LOCAL aBar := { " ENTER/EDIT ", " REPORTS ", " DISPLAY ", " MAINTENANCE ", " QUIT " } + LOCAL aOptions[ LEN( aBar ) ] + AEVAL( aBar, { |x,i| aOptions[i] := { {},{},{} } } ) + + cCmdLine := IF( cCmdLine == NIL, "", cCmdLine ) + + lColor := IF( "MONO" $ UPPER( cCmdLine ), .F., ISCOLOR() ) + + * Border, Box, Bar, Current, Unselected + aColors := IF( lColor, {"W+/G", "N/G", "N/G", "N/W", "N+/G"}, ; + {"W+/N", "W+/N", "W/N", "N/W", "W/N"} ) + + FT_FILL( aOptions[1], 'A. Execute A Dummy Procedure' , {|| fubar()}, .t. ) + FT_FILL( aOptions[1], 'B. Enter Daily Charge/Credit Slips' , {|| .t.}, .t. ) + FT_FILL( aOptions[1], 'C. Enter Payments On Accounts' , {|| .t.}, .f. ) + FT_FILL( aOptions[1], 'D. Edit Daily Transactions' , {|| .t.}, .t. ) + FT_FILL( aOptions[1], 'E. Enter/Update Member File' , {|| .t.}, .t. ) + FT_FILL( aOptions[1], 'F. Update Code File' , {|| .t.}, .f. ) + FT_FILL( aOptions[1], 'G. Add/Update Auto Charge File' , {|| .t.}, .t. ) + FT_FILL( aOptions[1], 'H. Post All Transactions To A/R File', {|| .t.}, .t. ) + FT_FILL( aOptions[1], 'I. Increment Next Posting Date' , {|| .t.}, .t. ) + + FT_FILL( aOptions[2], 'A. Print Member List' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'B. Print Active Auto Charges' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'C. Print Edit List' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'D. Print Pro-Usage Report' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'E. Print A/R Transaction Report' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'F. Aging Report Preparation' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'G. Add Interest Charges' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'H. Print Aging Report' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'I. Print Monthly Statements' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'J. Print Mailing Labels' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'K. Print Transaction Totals' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'L. Print Transaction Codes File' , {|| .t.}, .t. ) + FT_FILL( aOptions[2], 'M. Print No-Activity List' , {|| .t.}, .t. ) + + FT_FILL( aOptions[3], 'A. Transaction Totals Display' , {|| .t.}, .t. ) + FT_FILL( aOptions[3], 'B. Display Invoice Totals' , {|| .t.}, .t. ) + FT_FILL( aOptions[3], 'C. Accounts Receivable Display' , {|| .t.}, .t. ) + + FT_FILL( aOptions[4], 'A. Backup Database Files' , {|| .t.}, .t. ) + FT_FILL( aOptions[4], 'B. Reindex Database Files' , {|| .t.}, .t. ) + FT_FILL( aOptions[4], 'C. Set System Parameters' , {|| .t.}, .t. ) + FT_FILL( aOptions[4], 'D. This EXITs Too' , {|| .f. }, .t. ) + + FT_FILL( aOptions[5], 'A. Does Nothing' , {|| .t.}, .t. ) + FT_FILL( aOptions[5], 'B. Exit To DOS' , {|| .f. }, .t. ) + + // main routine starts here + SET SCOREBOARD OFF + + cNormH := IF( lColor, "W+/G", "W+/N" ) + cNormN := IF( lColor, "N/G" , "W/N" ) + cNormE := IF( lColor, "N/W" , "N/W" ) + cWindH := IF( lColor, "W+/B", "W+/N" ) + cWindN := IF( lColor, "W/B" , "W/N" ) + cWindE := IF( lColor, "N/W" , "N/W" ) + cErrH := IF( lColor, "W+/R", "W+/N" ) + cErrN := IF( lColor, "W/R" , "W/N" ) + cErrE := IF( lColor, "N/W" , "N/W" ) + + SAVE SCREEN TO sDosScrn + nDosRow=ROW() + nDosCol=COL() + SETCOLOR( "w/n" ) + CLS + NOSNOW( ( "NOSNOW" $ UPPER( cCmdLine ) ) ) + IF "VGA" $ UPPER( cCmdLine ) + SETMODE(50,80) + ENDIF + nMaxRow := MAXROW() + SETBLINK(.f.) + SETCOLOR( cWindN + "*" ) + CLEAR SCREEN + SETCOLOR( cNormN ) + @ nMaxRow, 0 + @ nMaxRow, 0 SAY " FT_MENU1 1.0 � " + @ NMAXROW,16 SAY "WRITTEN BY PAUL FERRARA [76702,556] FOR NANFORUM.LIB" + @ NMAXROW,69 SAY "� "+DTOC( DATE() ) + + SETCOLOR( cErrH ) + @ nMaxRow-11, 23, nMaxRow-3, 56 BOX "旼엿耗윰 " + @ nMaxRow- 9,23 SAY "쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴캑" + SETCOLOR( cErrN ) + @ nMaxRow-10,33 SAY "Navigation Keys" + @ nMaxRow- 8,25 SAY "LeftArrow RightArrow Alt-E" + @ nMaxRow- 7,25 SAY "Home End Alt-R" + @ nMaxRow- 6,25 SAY "Tab Shift-Tab Alt-D" + @ nMaxRow- 5,25 SAY "PgUp PgDn Alt-M" + @ nMaxRow- 4,25 SAY "Enter ESCape Alt-Q" + SETCOLOR( cNormN ) + + FT_MENU1( aBar, aOptions, aColors ) + + SETCOLOR( "W/N" ) + SETCURSOR( SCNORMAL ) + SETBLINK(.t.) + IF "VGA" $ UPPER( cCmdLine ) + SETMODE(25,80) + ENDIF + RESTORE SCREEN FROM sDosScrn + SETPOS(nDosRow, nDosCol) + QUIT + + FUNCTION fubar() + LOCAL OldColor:= SETCOLOR( "W/N" ) + CLEAR SCREEN + Qout( "Press Any Key" ) + INKEY(0) + SETCOLOR( OldColor ) + RETURN .t. +#endif +// end of demo program + + +FUNCTION FT_MENU1( aBar, aOptions, aColors, nTopRow, lShadow ) + LOCAL nTtlWid, nTtlUsed, i, j, nPad + LOCAL sMainScrn, lCancMode, lLooping := .t. + + // column position for each item on the menu bar + LOCAL aBarCol[LEN(aBar)] + + // inkey code for each item on menu bar + LOCAL aBarKeys[ LEN( aBar ) ] + + // inkey codes for A - Z + LOCAL aKeyCodes := { 286, 304, 302, 288, 274, 289, 290, 291, 279, ; + 292, 293, 294, 306, 305, 280, 281, 272, 275, ; + 287, 276, 278, 303, 273, 301, 277, 300 } + + // LEN() of widest array element for for each pulldown menu + LOCAL aBarWidth[LEN(aBar)] + + // starting column for each box + LOCAL aBoxLoc[LEN(aBar)] + + // last selection for each element + LOCAL aLastSel[LEN(aBar)] + + // color memvars + LOCAL cBorder := aColors[1] + LOCAL cBox := aColors[2] + LOCAL cBar := aColors[3] + LOCAL cCurrent := aColors[4] + LOCAL cUnSelec := aColors[5] + + nMaxRow := MAXROW() + nMaxCol := MAXCOL() + + // row for menu bar + nTopRow := IF( nTopRow == NIL, 0, nTopRow ) + + AFILL(aLastSel,1) + aChoices := aOptions + + // this is the routine that calculates the position of each item + // on the menu bar. + nTtlWid := 0 + aBarCol[1] := 0 + nTtlUsed := LEN( aBar[1] ) + 1 + AEVAL( aBar, ; + {|x,i| aBarcol[i]:= nTtlUsed,nTtlUsed+= (LEN(aBar[i]) +1 )}, ; + 2, LEN(aBar) -1 ) + + // calculates widest element for each pulldown menu + // see below for _ftWidest() + AFILL(aBarWidth,1) + AEVAL( aChoices, { |x,i| _ftWidest( @i, aChoices, @aBarWidth ) } ) + + // box location for each pulldown menu + // see below for _ftLocat() + AEVAL( aChoices, { |x,i| _ftLocat( i, aBarCol, aBarWidth, @aBoxLoc, nMaxCol ) } ) + + // valid keys for each pulldown menu + // see below for _ftValKeys() + AEVAL( aChoices,{|x,i| AADD( aValidkeys,"" ),; + _ftValKeys( i,aChoices,@aValidKeys ) } ) + + // display the menu bar + SETCOLOR( cBar ) + @ nTopRow, 0 + AEVAL( aBar, { |x,i| Devpos(nTopRow, aBarCol[i]), Devout(aBar[i]) }) + + // store inkey code for each item on menu bar to aBarKeys + AEVAL( aBarKeys, {|x,i| aBarKeys[i] := ; + aKeyCodes[ ASC( UPPER( LTRIM( aBar[i] ) ) ) - 64 ] } ) + + // disable Alt-C and Alt-D + lCancMode := SETCANCEL( .f. ) + AltD( DISABLE ) + + // main menu loop + SAVE SCREEN TO sMainScrn + // which menu and which menu item + nHpos := 1; nVpos := 1 + DO WHILE lLooping + RESTORE SCREEN FROM sMainScrn + SETCOLOR( cCurrent ) + @ nTopRow, aBarCol[nHpos] SAY aBar[nHpos] + IF lShadow == NIL .OR. lShadow + FT_SHADOW( nTopRow+1, aBoxLoc[nHpos], LEN(aChoices[nHpos,1])+nTopRow+2, aBarWidth[nHpos]+3+aBoxLoc[nHpos] ) + ENDIF + SETCOLOR( cBorder ) + @ nTopRow+1, aBoxLoc[nHpos], LEN(aChoices[nHpos,1])+nTopRow+2, aBarWidth[nHpos]+3+aBoxLoc[nHpos] BOX "�敲볼苦� " + SETCOLOR( cBox +","+ cCurrent +",,,"+ cUnselec ) + nVpos := ACHOICE( nTopRow+2, aBoxLoc[nHpos]+2, LEN(aChoices[nHpos,1])+nTopRow+2, aBarWidth[nHpos]+1+aBoxLoc[nHpos], aChoices[nHpos,1], aChoices[nHpos,3], "__ftAcUdf", aLastSel[nHpos]) + DO CASE + CASE LASTKEY() == RIGHTARROW .OR. LASTKEY() == TAB + IF( nHpos == LEN( aChoices ), nHpos := 1, nHpos := nHpos + 1 ) + CASE LASTKEY() == LEFTARROW .OR. LASTKEY() == SHIFTTAB + IF( nHpos == 1, nHpos := LEN( aChoices ), nHpos := nHpos - 1 ) + CASE LASTKEY() == ESCAPE + lLooping := _ftBailOut( cBorder, cBox ) + CASE LASTKEY() == HOME + nHpos := 1 + CASE LASTKEY() == END + nHpos := LEN( aChoices ) + CASE LASTKEY() == ENTER + aLastSel[nHpos] := nVpos + IF aChoices[nHpos,2,nVpos] != NIL + SETCANCEL( lCancMode ) + ALTD( ENABLE ) + lLooping := EVAL( aChoices[nHpos,2,nVpos] ) + ALTD( DISABLE ) + SETCANCEL( .f. ) + ENDIF + CASE ASCAN( aBarKeys, LASTKEY() ) > 0 + nHpos := ASCAN( aBarKeys, LASTKEY() ) + ENDCASE + ENDDO + SETCANCEL( lCancMode ) + AltD( ENABLE ) + RESTORE SCREEN FROM sMainScrn + RETURN NIL + +FUNCTION __ftAcUdf( nMode ) + // ACHOICE() user function + LOCAL nRtnVal := RESUME + DO CASE + CASE nMode == HITTOP + KEYBOARD CHR( CTRLEND ) + CASE nMode == HITBOTTOM + KEYBOARD CHR( CTRLHOME ) + CASE nMode == KEYEXCEPT + IF UPPER( CHR( LASTKEY() ) ) $ aValidKeys[ nHpos ] + IF aChoices[ nHpos, 3, AT( UPPER(CHR(LASTKEY())), aValidKeys[ nHpos ] )] + KEYBOARD CHR( ENTER ) + nRtnVal := NEXTITEM + ENDIF + ELSE + nRtnVal := MAKESELECT + ENDIF + ENDCASE + RETURN nRtnVal + +STATIC FUNCTION _ftWidest( i, aChoices, aBarWidth ) + AEVAL(aChoices[i,1],{|a,b| aBarWidth[i] := ; + MAX( aBarWidth[i],LEN(aChoices[i,1,b])) }) + RETURN NIL + +STATIC FUNCTION _ftLocat( i, aBarCol, aBarWidth, aBoxLoc, nMaxCol ) + aBoxLoc[i] := IF( aBarCol[i] + aBarWidth[i] + 4 > nMaxCol + 1, ; + nMaxCol - 3 - aBarWidth[i], aBarCol[i] ) + RETURN NIL + +STATIC FUNCTION _ftBailOut( cBorder, cBox ) + LOCAL cOldColor, sOldScreen, nKeyPress, nOldCursor, nCenter + nOldCursor := SETCURSOR( SCNONE ) + sOldScreen := SAVESCREEN(nMaxRow/2-1, 24, nMaxRow/2+2, 55) + cOldColor := SETCOLOR( cBorder ) + FT_SHADOW( nMaxRow/2-1, 24, nMaxRow/2+2, 55 ) + @ nMaxRow/2-1, 24, nMaxRow/2+2, 55 BOX "�敲볼苦� " + SETCOLOR( cBox ) + @ nMaxRow/2, 26 SAY "Press ESCape To Confirm Exit" + @ nMaxRow/2+1,27 SAY "Or Any Other Key To Resume" + nKeyPress := INKEY(0) + SETCOLOR( cOldColor ) + RESTSCREEN(nMaxRow/2-1, 24, nMaxRow/2+2, 55,sOldScreen ) + SETCURSOR( nOldCursor ) + RETURN !(nKeyPress == ESCAPE) + +STATIC FUNCTION _ftValKeys( nNum,aChoices,aValidkeys ) + AEVAL( aChoices[nNum,1], {|x| aValidKeys[nNum] += LEFT( x, 1)} ) + RETURN NIL + +/* $DOC$ + * $FUNCNAME$ + * FT_FILL() + * $CATEGORY$ + * Menus/Prompts + * $ONELINER$ + * Declare menu options for FT_MENU1() + * $SYNTAX$ + * FT_FILL( , , , + * ) -> NIL + * $ARGUMENTS$ + * is a sub-array of in FT_MENU1() + * denoting the group in which to include the selection -- + * e.g., acOptions[1] + * + * is the character string that will appear on + * the menu. + * + * is the code block to be executed when that menu + * option is selected. i.e. {|| MyFunction() } would execute + * the function called MyFunction(). {|| .f.} would exit the + * FT_MENU1 and return to the calling routine. {|| .T.} would + * do nothing. + * + * is a logical variable that determines whether + * the corresponding menu option is selectable or not. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * FT_FILL() is a function used to set up the menu options prior + * to calling FT_MENU1(). + * $EXAMPLES$ + * FT_FILL( aOptions[1], 'A. Execute A Dummy Procedure' , {|| fubar()}, .t. ) + * + * The above would be added to the sub-menu associated with the first menu + * bar item, would execute the function FUBAR() when that option was + * selected, and would be selectable. + * + * + * FT_FILL( aOptions[3], 'B. Enter Daily Charges' , {|| .t.}, .f. ) + * + * The above would be added to the sub-menu associated with the third menu + * bar item, and would be unselectable. + * + * + * FT_FILL( aOptions[2], 'C. Enter Payments On Accounts', {|| .t.}, .t. ) + * + * The above would be added to the sub-menu associated with the second menu + * bar item, and would be selectable, but would do nothing when selected. + * + * + * FT_FILL( aOptions[4], 'C. Exit' , {|| .f.}, .t. ) + * + * The above would be added to the sub-menu associated with the fourth menu + * bar item, and would be selectable, and would exit FT_MENU1() when chosen. + * $SEEALSO$ + * FT_MENU1() + * $END$ + */ + +FUNCTION FT_FILL( aArray, cMenuOption, bBlock, lAvailable ) + AADD( aArray[1], cMenuOption ) + AADD( aArray[2], bBlock ) + AADD( aArray[3], lAvailable ) + RETURN NIL diff --git a/harbour/contrib/libnf/menuto.prg b/harbour/contrib/libnf/menuto.prg new file mode 100644 index 0000000000..26a44b2ef1 --- /dev/null +++ b/harbour/contrib/libnf/menuto.prg @@ -0,0 +1,589 @@ +/* + * File......: MENUTO.PRG + * Author....: Ted Means + * CIS ID....: 73067,3332 + * + * This is an original work by Ted Means and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.5 16 Oct 1992 00:20:28 GLENN + * Cleaned up documentation header. + * + * Rev 1.4 16 Oct 1992 00:08:44 GLENN + * Just making sure we had Ted's latest revision. + * + * Rev 1.3 13 Oct 1992 20:45:46 GLENN + * Complete rewrite by Ted Means, dumping assembler version for a + * Clipper version. + * + * Rev 1.2 15 Aug 1991 23:03:54 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 14 Jun 1991 19:52:16 GLENN + * Minor edit to file header + * + * Rev 1.0 01 Apr 1991 01:01:42 GLENN + * Nanforum Toolkit + * + */ + +/* $DOC$ + * $FUNCNAME$ + * FT_Prompt() + * $CATEGORY$ + * Menus/Prompts + * $ONELINER$ + * Define a menu item for use with FT_MenuTo() + * $SYNTAX$ + * #include "FTMENUTO.CH" + * + * @ , PROMPT ; + * [COLOR ] ; + * [MESSAGE ] ; + * [MSGROW ] ; + * [MSGCOL ] ; + * [MSGCOLOR ] ; + * [TRIGGER ] ; + * [TRIGGERCOLOR ] ; + * [HOME ] ; + * [END ] ; + * [UP ] ; + * [DOWN ] ; + * [LEFT ] ; + * [RIGHT ] ; + * [EXECUTE ] ; + * + * $ARGUMENTS$ + * is the row at which the prompt is to appear. + * + * is the column at which the prompt will appear. + * + * is the menu item string. + * + * is optional and is the color attribute of the prompt. Note + * that two colors are required; one for the standard setting and one + * for the enhanced setting (i.e. the light bar color). See the example + * below if this isn't clear. If is not specified then the + * current SetColor() value is used by default. + * + * is optional and is the message associated with the + * prompt. If not specified, then no message will be displayed. + * + * is optional and is the row at which the message, if any, + * will appear. If not specified, the default is the current setting + * of the SET MESSAGE TO command. + * + * is optional and is the column at which the message, if + * any, will appear. If not specified, the default is either zero or + * centered, depending on the current setting of the CENTER option of + * the SET MESSAGE TO command. + * + * is optional and is the color attribute of the message. + * If not specified, the default is the same as the prompt color. + * + * is optional and is the position within the prompt string + * where the trigger character is located. If not specified, the + * default is one. + * + * is optional and is the color attribute of the trigger + * character. Note that two colors are required; one for the standard + * setting and one for the enhanced setting (i.e. the light bar color). + * See the example below if this isn't clear. If is not + * specified then the default is the same color as the rest of the + * prompt. + * + * is optional and specifies which prompt becomes active + * when the home key is pressed. If not specified, the default is + * the first prompt. + * + * is optional and specifies which prompt becomes active + * when the end key is pressed. If not specified, the default is + * the last prompt. + * + * is optional and specifies which prompt becomes active + * when the up arrow key is pressed. If not specified, the + * default is the previous prompt. The current setting of SET + * WRAP TO is obeyed. + * + * is optional and specifies which prompt becomes + * active when the down arrow key is pressed. If not + * specified, the default is the next prompt. The current + * setting of SET WRAP TO is obeyed. + * + * is optional and specifies which prompt becomes + * active when the right arrow key is pressed. If not + * specified, the default is the next prompt. The current + * setting of SET WRAP TO is obeyed. + * + * is optional and specifies which prompt becomes + * active when the left arrow is pressed. If not specified, + * the default is the previous prompt. The current setting of + * SET WRAP TO is obeyed. + * + * is optional and is a code block to evaluate whenever + * the menu item to which it belongs is selected. + * $DESCRIPTION$ + * Clipper's @...PROMPT and MENU TO commands are fine as far as + * they go. But many times you need more flexibility. As + * you'll no doubt notice if you read the argument list, this + * function is almost completely flexible. You can adjust + * locations and colors for every part of the prompt and its + * associated message. In addition, since you can control the + * effect of the arrow keys, you can allow both horizontal and + * vertical movement, or even disable certain arrow keys if you + * so desire. Support for nested menus is also available, since + * the prompts are stored in stack-based static arrays. + * + * Note that this command can also be called using function-style + * syntax. See the entry for FT_PROMPT() for further details. + * + * This enhanced version of @...PROMPT requires the inclusion of + * the header file FTMENUTO.CH in any source file that uses it. + * It is may be used in place of the standard Clipper @...PROMPT + * command. However, in the interests of functionality it is NOT + * 100% compatible. No whining! If compatibility is such a big + * deal then use the standard Clipper commands. + * + * $EXAMPLES$ + * #include "FTMENUTO.CH" + * + * // Simple prompt + * @ 1, 1 PROMPT "Menu choice #1" + * + * // Prompt with color + * @ 3, 1 PROMPT "Menu choice #2" COLOR "W+/R,W+/B" + * + * // Prompt with a message + * @ 5, 1 PROMPT "Menu choice #3" MESSAGE "Go to lunch" + * + * // Prompt with pinpoint message control + * @ 7, 1 PROMPT "Menu choice #4" MESSAGE "Drop Dead" ; + * MSGROW 22 MSGCOL 4 MSGCOLOR "GR+/N" + * + * // Prompt with a trigger character ("#" character) + * @11, 1 PROMPT "Menu choice #6" TRIGGER 13 + * + * // Prompt with trigger character color control + * @13, 1 PROMPT "Menu Choice #7" TRIGGER 13 TRIGGERCOLOR "R+/BG,G+/N" + * + * // Prompt with right and left arrow keys disabled + * @15, 1 PROMPT "Menu Choice #8" RIGHT 8 LEFT 8 + * $INCLUDE$ + * FTMENUTO.CH + * $SEEALSO$ + * + * $END$ + */ + +#include "SETCURS.CH" +#include "INKEY.CH" + +#xcommand if then => ; + if ; ; end + +#xtranslate display( , , , ) => ; + setpos( , ) ; dispout( , ) + +#xtranslate EnhColor( ) => ; + substr( , at( ",", ) + 1 ) + +#xtranslate isOkay( ) => ; + ( \> 0 .and. \<= nCount ) + +#xtranslate isBetween( , , ) => ; + ( \>= .and. \<= ) + +#define nTriggerInkey asc( upper( substr( cPrompt, nTrigger, 1 ) ) ) +#define cTrigger substr( cPrompt, nTrigger, 1 ) +#define nCurrent nMenu,nActive +#define nLast nMenu,nPrev + +// These arrays hold information about each menu item + +static aRow := {{}} +static aCol := {{}} +static aPrompt := {{}} +static aColor := {{}} +static aMsgRow := {{}} +static aMsgCol := {{}} +static aMessage := {{}} +static aMsgColor := {{}} +static aTrigger := {{}} +static aTriggerInkey := {{}} +static aTriggerColor := {{}} +static aHome := {{}} +static aEnd := {{}} +static aUp := {{}} +static aDown := {{}} +static aLeft := {{}} +static aRight := {{}} +static aExecute := {{}} +static nLevel := 1 + +function FT_Prompt( nRow, nCol, cPrompt, cColor, ; + nMsgRow, nMsgCol, cMessage, cMsgColor, ; + nTrigger, cTriggerColor, nHome, nEnd, ; + nUp, nDown, nLeft, nRight, bExecute ) + +// If the prompt color setting is not specified, use default + +if cColor == NIL then cColor := setcolor() + +// If no message is supplied, set message values to NIL + +if cMessage == NIL + + nMsgRow := nMsgCol := cMsgColor := NIL + +else + + // If message row not supplied, use the default + + if nMsgRow == NIL then nMsgRow := set( _SET_MESSAGE ) + + // If message column not supplied, use the default + + if nMsgCol == NIL + if set( _SET_MCENTER ) + nMsgCol := int( ( maxcol() + 1 - len( cPrompt ) ) / 2 ) + else + nMsgCol := 0 + endif + endif + + // If message color not specified, use the default + + if cMsgColor == NIL then cMsgColor := cColor +endif + +// If trigger values not specifed, set the defaults + +if nTrigger == NIL then nTrigger := 1 +if cTriggerColor == NIL then cTriggerColor := cColor + +// Now add elements to the static arrays -- nLevel indicates the recursion +// level, which allows for nested menus. + +aadd( aRow[ nLevel ], nRow ) +aadd( aCol[ nLevel ], nCol ) +aadd( aPrompt[ nLevel ], cPrompt ) +aadd( aColor[ nLevel ], cColor ) +aadd( aMsgRow[ nLevel ], nMsgRow ) +aadd( aMsgCol[ nLevel ], nMsgCol ) +aadd( aMessage[ nLevel ], cMessage ) +aadd( aMsgColor[ nLevel ], cMsgColor ) +aadd( aTrigger[ nLevel ], nTrigger ) +aadd( aTriggerInkey[ nLevel ], nTriggerInkey ) +aadd( aTriggerColor[ nLevel ], cTriggerColor ) +aadd( aHome[ nLevel ], nHome ) +aadd( aEnd[ nLevel ], nEnd ) +aadd( aUp[ nLevel ], nUp ) +aadd( aDown[ nLevel ], nDown ) +aadd( aLeft[ nLevel ], nLeft ) +aadd( aRight[ nLevel ], nRight ) +aadd( aExecute[ nLevel ], bExecute ) + +// Now display the prompt for the sake of compatibility + +dispbegin() +display( nRow, nCol, cPrompt, cColor ) +display( nRow, nCol - 1 + nTrigger, cTrigger, cTriggerColor ) +dispend() + +return NIL + + + +/* $DOC$ + * $FUNCNAME$ + * FT_MenuTo() + * $CATEGORY$ + * Menus/Prompts + * $ONELINER$ + * Execute light bar menu using prompts created with @...PROMPT + * $SYNTAX$ + * #include "FTMENUTO.CH" + * + * MENU TO [COLD] + * $ARGUMENTS$ + * is the name of the variable to which the result of the menu + * selection should be assigned. + * + * [COLD] is optional and if specified indicates that trigger characters + * should be treated as "cold," i.e. rather than causing the menu item + * to be selected it only causes the light bar to move to that selection. + * $DESCRIPTION$ + * This enhanced version of MENU TO requires the inclusion of the header + * file FTMENUTO.CH in any source file that uses it. It may be used in + * place of the standard Clipper MENU TO command. However, in the + * interests of functionality it is NOT 100% compatible (in particular, + * you should make sure that the target memvar exists before executing + * the menu -- the Clipper version will create a PRIVATE memvar for you + * if it does not already exist, but this version does not). No whining! + * If compatibility is such a big deal then use the standard Clipper + * command. + * + * Note that this command can also be called using function-style + * syntax. See the entry for FT_MENUTO() for further details. + * $EXAMPLES$ + * #include "FTMENUTO.CH" + * + * // Simple command + * + * MENU TO memvar + * + * $INCLUDE$ + * FTMENUTO.CH + * $SEEALSO$ + * FT_Prompt() + * $END$ + */ + +function FT_MenuTo( bGetSet, cReadVar, lCold ) + +local nMenu := nLevel++ +local nActive := 1 +local nCount := len( aRow[ nMenu ] ) +local lChoice := .F. +local nCursor := set( _SET_CURSOR,SC_NONE ) +local nKey,bKey,nScan,lWrap,cScreen,nPrev + +// Validate the incoming parameters and assign some reasonable defaults +// to prevent a crash later. + +cReadVar := iif( cReadVar == NIL, "", upper( cReadVar ) ) + +if bGetSet == NIL then bGetSet := {|| 1} + +// Eval the incoming getset block to initialize nActive, which indicates +// the menu prompt which is to be active when the menu is first displayed. +// If nActive is outside the appropriate limits, a value of 1 is assigned. + +nActive := eval( bGetSet ) + +if ( nActive < 1 .or. nActive > nCount ) then nActive := 1 + +// Increment the recursion level in case a hotkey procedure +// calls FT_Prompt(). This will cause a new set of prompts +// to be created without disturbing the current set. + +aadd( aRow, {} ) +aadd( aCol, {} ) +aadd( aPrompt, {} ) +aadd( aColor, {} ) +aadd( aMsgRow, {} ) +aadd( aMsgCol, {} ) +aadd( aMessage, {} ) +aadd( aMsgColor, {} ) +aadd( aTrigger, {} ) +aadd( aTriggerInkey, {} ) +aadd( aTriggerColor, {} ) +aadd( aUp, {} ) +aadd( aDown, {} ) +aadd( aLeft, {} ) +aadd( aRight, {} ) +aadd( aExecute, {} ) + +// Loop until Enter or Esc is pressed + +while .not. lChoice + + // Evaluate the getset block to update the target memory variable + // in case it needs to be examined by a hotkey procedure. + + eval( bGetSet,nActive ) + + // Get the current setting of SET WRAP so that the desired menu behavior + // can be implemented. + + lWrap := set( _SET_WRAP ) + + // If a message is to be displayed, save the current screen contents + // and then display the message, otherwise set the screen buffer to NIL. + + dispbegin() + + if aMessage[ nCurrent ] != NIL + cScreen := savescreen( aMsgRow[ nCurrent ], aMsgCol[ nCurrent ], ; + aMsgRow[ nCurrent ], aMsgCol[ nCurrent ] + ; + len( aMessage[ nCurrent ] ) - 1 ) + + display( aMsgRow[ nCurrent ], aMsgCol[ nCurrent ], ; + aMessage[ nCurrent ], aMsgColor[ nCurrent ] ) + + else + cScreen := NIL + endif + + // Display the prompt using the designated colors for the prompt and + // the trigger character. + + display( aRow[ nCurrent ], aCol[ nCurrent ], ; + aPrompt[ nCurrent ], EnhColor( aColor[ nCurrent ] ) ) + + display( aRow[ nCurrent ], ; + aCol[ nCurrent ] - 1 + aTrigger[ nCurrent ], ; + substr( aPrompt[ nCurrent ], aTrigger[ nCurrent ], 1 ), ; + EnhColor( aTriggerColor[ nCurrent ] ) ) + + dispend() + + // Wait for a keystroke + + nKey := inkey( 0 ) + + // If the key was an alphabetic char, convert to uppercase + + if isBetween( nKey,97,122 ) then nKey -= 32 + + // Set nPrev to the currently active menu item + + nPrev := nActive + + do case + + // Check for a hotkey, and evaluate the associated block if present. + + case ( bKey := setkey( nKey ) ) != NIL + eval( bKey, ProcName( 1 ), ProcLine( 1 ), cReadVar ) + + // If Enter was pressed, either exit the menu or evaluate the + // associated code block. + + case nKey == K_ENTER + if aExecute[ nCurrent ] != NIL + eval( aExecute[ nCurrent ] ) + else + lChoice := .T. + endif + + // If ESC was pressed, set the selected item to zero and exit. + + case nKey == K_ESC + lChoice := .T. + nActive := 0 + + // If Home was pressed, go to the designated menu item. + + case nKey == K_HOME + nActive := iif( aHome[ nCurrent ] == NIL, 1, aHome[ nCurrent ] ) + + // If End was pressed, go to the designated menu item. + + case nKey == K_END + nActive := iif( aEnd[ nCurrent ] == NIL, nCount, aEnd[ nCurrent ] ) + + // If Up Arrow was pressed, go to the designated menu item. + + case nKey == K_UP + if aUp[ nCurrent ] == NIL + if --nActive < 1 then nActive := iif( lWrap, nCount, 1 ) + else + if isOkay( aUp[ nCurrent ] ) then nActive := aUp[ nCurrent ] + endif + + // If Down Arrow was pressed, go to the designated menu item. + + case nKey == K_DOWN + if aDown[ nCurrent ] == NIL + if ++nActive > nCount then nActive := iif( lWrap, 1, nCount ) + else + if isOkay( aDown[ nCurrent ] ) then nActive := aDown[ nCurrent ] + endif + + // If Left Arrow was pressed, go to the designated menu item. + + case nKey == K_LEFT + if aLeft[ nCurrent ] == NIL + if --nActive < 1 then nActive := iif( lWrap, nCount, 1 ) + else + if isOkay( aLeft[ nCurrent ] ) then nActive := aLeft[ nCurrent ] + endif + + // If Right Arrow was pressed, go to the designated menu item. + + case nKey == K_RIGHT + if aRight[ nCurrent ] == NIL + if ++nActive > nCount then nActive := iif( lWrap, 1, nCount ) + else + if isOkay( aRight[ nCurrent ] ) then nActive := aRight[ nCurrent ] + endif + + // If a trigger letter was pressed, handle it based on the COLD + // parameter. + + case ( nScan := ascan( aTriggerInkey[ nMenu ], nKey ) ) > 0 + nActive := nScan + if .not. lCold then FT_PutKey( K_ENTER ) + endcase + + // Erase the highlight bar in preparation for the next iteration + + if .not. lChoice + dispbegin() + display( aRow[ nLast ], aCol[ nLast ], ; + aPrompt[ nLast ], aColor[ nLast ] ) + + display( aRow[ nLast ], aCol[ nLast ] - 1 + aTrigger[ nLast ], ; + substr( aPrompt[ nLast ], aTrigger[ nLast ], 1 ), ; + aTriggerColor[ nLast ] ) + + + if cScreen != NIL then restscreen( aMsgRow[ nLast ], ; + aMsgCol[ nLast ], ; + aMsgRow[ nLast ], ; + aMsgCol[ nLast ] ; + + len( aMessage[ nLast ] ) - 1, ; + cScreen ) + dispend() + endif +end + +// Now that we're exiting, decrement the recursion level and erase all +// the prompt information for the current invocation. + +nLevel-- + +asize( aRow, nLevel ) +asize( aCol, nLevel ) +asize( aPrompt, nLevel ) +asize( aColor, nLevel ) +asize( aMsgRow, nLevel ) +asize( aMsgCol, nLevel ) +asize( aMessage, nLevel ) +asize( aMsgColor, nLevel ) +asize( aTrigger, nLevel ) +asize( aTriggerInkey, nLevel ) +asize( aTriggerColor, nLevel ) +asize( aUp, nLevel ) +asize( aDown, nLevel ) +asize( aLeft, nLevel ) +asize( aRight, nLevel ) +asize( aExecute, nLevel ) + + aRow[ nLevel ] := {} + aCol[ nLevel ] := {} + aPrompt[ nLevel ] := {} + aColor[ nLevel ] := {} + aMsgRow[ nLevel ] := {} + aMsgCol[ nLevel ] := {} + aMessage[ nLevel ] := {} + aMsgColor[ nLevel ] := {} + aTrigger[ nLevel ] := {} +aTriggerInkey[ nLevel ] := {} +aTriggerColor[ nLevel ] := {} + aUp[ nLevel ] := {} + aDown[ nLevel ] := {} + aLeft[ nLevel ] := {} + aRight[ nLevel ] := {} + aExecute[ nLevel ] := {} + +set( _SET_CURSOR, nCursor ) + +eval( bGetSet, nActive ) + +return nActive + diff --git a/harbour/contrib/libnf/metaph.prg b/harbour/contrib/libnf/metaph.prg new file mode 100644 index 0000000000..ab17903bc2 --- /dev/null +++ b/harbour/contrib/libnf/metaph.prg @@ -0,0 +1,389 @@ +/* + * File......: METAPH.PRG + * Author....: Dave Adams + * CIS ID....: ? + * + * This is an original work by Dave Adams and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.2 15 Aug 1991 23:04:00 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 14 Jun 1991 19:52:20 GLENN + * Minor edit to file header + * + * Rev 1.0 01 Apr 1991 01:01:44 GLENN + * Nanforum Toolkit + * + */ + + +/* $DOC$ + * $FUNCNAME$ + * FT_METAPH() + * $CATEGORY$ + * String + * $ONELINER$ + * Convert a character string to MetaPhone format + * $SYNTAX$ + * FT_METAPH( [, ] ) -> cMetaPhone + * $ARGUMENTS$ + * is the character string to convert + + * is the length of the character string to be returned. + * If not specified the default length is 4 bytes. + * $RETURNS$ + * A phonetically spelled character string + * $DESCRIPTION$ + * This function is a character function use to index and search for + * sound-alike or phonetic matches. It is an alternative to + * the SOUNDEX() function, and addresses some basic pronunciation + * rules, by looking at surrounding letters to determine how parts of + * the string are pronounced. FT_METAPH() will group sound-alikes + * together, and forgive shortcomings in spelling ability. + * $EXAMPLES$ + * USE Persons + * INDEX ON FT_METAPH( LastName ) TO LastName + * SEEK FT_METAPH( "Philmore" ) + * ? FOUND(), LastName // Result: .T. Philmore + * SEEK FT_METAPH( "Fillmore" ) + * ? FOUND(), LastName // Result: .T. Philmore + * $END$ + */ + +/* + * File Contents + * + * FT_METAPH() Calculates the metaphone of a name + * _ftMakeAlpha() Removes non-alpha characters from a string + * _ftConvVowel() Converts all vowels to the letter 'v' + * + * + * Commentary + * + * The concepts for this algoritm were adapted from an article in the + * Computer Language Magazine (Dec.90, Vol.7, No.12) written by + * Lawrence B.F. Phillips. + * + * The STRTRAN function was selected to calculate the MetaPhone, to + * allow the algoritm to be fine-tuned in an easy manner, as there are + * always exceptions to any phonetic pronunciation in not only English, + * but many other languages as well. + * + * What is a metaphone? + * Basically it takes a character string, removes the vowels, and equates + * letters (or groups of letters) to other consonent sounds. The vowels + * are not removed until near the end, as they play an important part + * in determining how some consonents sound in different surroundings. + * + * The consonant sounds are: B, F, H, J, K, L, M, N, P, R, S, T, W, X, Y, 0 + * Vowels are only included if they are at the beginning. + * Here are the transformations. The order of evaluation is important + * as characters may meet more than one transformation conditions. + * ( note: v = vowel ) + * + * B --> B unless at end of a word after 'm' as in dumb. + * C --> X (sh) CIA, TCH, CH, ISCH, CC + * S SCI, SCE, SCY, CI, CE, CY + * K otherwise ( including CK ) + * D --> J DGE, DGY, DGI + * T otherwise + * F --> F + * G --> K GHv, vGHT + * W vGH + * J DGE, DGY, DGI, GI, GE, GY + * N GN + * K otherwise + * H --> H vHv + * otherwise silent + * J --> J + * K --> K + * L --> L + * M --> M + * N --> N + * P --> F PH + * P otherwise + * Q --> K + * R --> R + * S --> X (sh) SH, SIO, SIA, ISCH + * S otherwise + * T --> X (sh) TIA, TIO, TCH + * 0 (th) TH + * T otherwise + * V --> F + * W --> W + * X --> KS + * Y --> vY + * Y otherwise + * Z --> S + * + */ + +*------------------------------------------------ +// Demo of FT_METAPH() + +// #define FT_TEST .T. + +#IFDEF FT_TEST + FUNCTION MAIN() + LOCAL cJunk := SPACE( 8000 ) + LOCAL aNames := {} + LOCAL cName, nElem + + SET( _SET_SCOREBOARD, .F. ) + SET( _SET_COLOR, "W/B" ) + CLS + + // Demo will create an array of names and display in 3 columns + // _ftRow() and _ftCol() will calculate the screen co-ordinates + // by evaluating the element number + + AADD( aNames, "Adams" ) + AADD( aNames, "Addams" ) + AADD( aNames, "Atoms" ) + AADD( aNames, "Adamson" ) + AADD( aNames, "Cajun" ) + AADD( aNames, "Cagen" ) + AADD( aNames, "Cochy" ) + AADD( aNames, "Cocci" ) + AADD( aNames, "Smith" ) + AADD( aNames, "Smythe" ) + AADD( aNames, "Naylor" ) + AADD( aNames, "Nailer" ) + AADD( aNames, "Holberry" ) + AADD( aNames, "Wholebary" ) + AADD( aNames, "Jackson" ) + AADD( aNames, "Jekksen" ) + AADD( aNames, "The Source" ) + AADD( aNames, "The Sores" ) + AADD( aNames, "Jones" ) + AADD( aNames, "Johns" ) + AADD( aNames, "Lennon" ) + AADD( aNames, "Lenin" ) + AADD( aNames, "Fischer" ) + AADD( aNames, "Fisher" ) + AADD( aNames, "O'Donnell" ) + AADD( aNames, "O Donald" ) + AADD( aNames, "Pugh" ) + AADD( aNames, "Pew" ) + AADD( aNames, "Heimendinger" ) + AADD( aNames, "Hymendinker" ) + AADD( aNames, "Knight" ) + AADD( aNames, "Nite" ) + AADD( aNames, "Lamb" ) + AADD( aNames, "Lamb Chops" ) + AADD( aNames, "Stephens" ) + AADD( aNames, "Stevens" ) + AADD( aNames, "Neilson" ) + AADD( aNames, "Nelson" ) + AADD( aNames, "Tchaikovski" ) + AADD( aNames, "Chikofski" ) + AADD( aNames, "Caton" ) + AADD( aNames, "Wright" ) + AADD( aNames, "Write" ) + AADD( aNames, "Right" ) + AADD( aNames, "Manual" ) + AADD( aNames, "Now" ) + AADD( aNames, "Wheatabix" ) + AADD( aNames, "Science" ) + AADD( aNames, "Cinzano" ) + AADD( aNames, "Lucy" ) + AADD( aNames, "Reece" ) + AADD( aNames, "Righetti" ) + AADD( aNames, "Oppermann" ) + AADD( aNames, "Bookkeeper" ) + AADD( aNames, "McGill" ) + AADD( aNames, "Magic" ) + AADD( aNames, "McLean" ) + AADD( aNames, "McLane" ) + AADD( aNames, "Maclean" ) + AADD( aNames, "Exxon" ) + + // display names and metaphones in 3 columns on screen + AEVAL( aNames, ; + { | cName, nElem | ; + SETPOS( _ftRow( nElem ), _ftCol( nElem ) ), ; + QQOUT( PadR( cName, 18, "." ) + FT_METAPH( cName ) ) ; + } ) + + SETPOS( 21, 00 ) + QUIT + + *------------------------------------------------ + STATIC FUNCTION _ftRow( nElem ) // Determine which row to print on + RETURN IIF( nElem > 40, nElem - 40, IIF( nElem > 20, nElem - 20, nElem ) ) + *------------------------------------------------ + STATIC FUNCTION _ftCol( nElem ) // Determine which column to start print + RETURN IIF( nElem > 40, 55, IIF( nElem > 20, 28, 1 ) ) + *------------------------------------------------ + +#endif +// End of Test program + +*------------------------------------------------ +FUNCTION FT_METAPH ( cName, nSize ) +// Calculates the metaphone of a character string + +LOCAL cMeta + +cName := IIF( cName == NIL, "", cName ) // catch-all +nSize := IIF( nSize == NIL, 4, nSize ) // default size: 4-bytes + +// Remove non-alpha characters and make upper case. +// The string is padded with 1 space at the beginning & end. +// Spaces, if present inside the string, are not removed until all +// the prefix/suffix checking has been completed. +cMeta := " " + _ftMakeAlpha( UPPER( ALLTRIM( cName ) ) ) + " " + +// prefixes which need special consideration +IF " KN" $ cMeta ; cMeta := STRTRAN( cMeta, " KN" , " N" ) ; ENDIF +IF " GN" $ cMeta ; cMeta := STRTRAN( cMeta, " GN" , " N" ) ; ENDIF +IF " PN" $ cMeta ; cMeta := STRTRAN( cMeta, " PN" , " N" ) ; ENDIF +IF " AE" $ cMeta ; cMeta := STRTRAN( cMeta, " AE" , " E" ) ; ENDIF +IF " X" $ cMeta ; cMeta := STRTRAN( cMeta, " X" , " S" ) ; ENDIF +IF " WR" $ cMeta ; cMeta := STRTRAN( cMeta, " WR" , " R" ) ; ENDIF +IF " WHO" $ cMeta ; cMeta := STRTRAN( cMeta, " WHO", " H" ) ; ENDIF +IF " WH" $ cMeta ; cMeta := STRTRAN( cMeta, " WH" , " W" ) ; ENDIF +IF " MCG" $ cMeta ; cMeta := STRTRAN( cMeta, " MCG", " MK" ) ; ENDIF +IF " MC" $ cMeta ; cMeta := STRTRAN( cMeta, " MC" , " MK" ) ; ENDIF +IF " MACG" $ cMeta ; cMeta := STRTRAN( cMeta, " MACG"," MK" ) ; ENDIF +IF " MAC" $ cMeta ; cMeta := STRTRAN( cMeta, " MAC", " MK" ) ; ENDIF +IF " GI" $ cMeta ; cMeta := STRTRAN( cMeta, " GI", " K" ) ; ENDIF + +// Suffixes which need special consideration +IF "MB " $ cMeta ; cMeta := STRTRAN( cMeta, "MB " , "M " ) ; ENDIF +IF "NG " $ cMeta ; cMeta := STRTRAN( cMeta, "NG " , "N " ) ; ENDIF + +// Remove inner spaces (1st and last byte are spaces) +IF " " $ SUBSTR( cMeta, 2, LEN( cMeta ) - 2 ) + cMeta := " " + STRTRAN( cMeta, " " , "" ) + " " +ENDIF + +// Double consonants sound much the same as singles +IF "BB" $ cMeta ; cMeta := STRTRAN( cMeta, "BB" , "B" ) ; ENDIF +IF "CC" $ cMeta ; cMeta := STRTRAN( cMeta, "CC" , "CH" ) ; ENDIF +IF "DD" $ cMeta ; cMeta := STRTRAN( cMeta, "DD" , "T" ) ; ENDIF +IF "FF" $ cMeta ; cMeta := STRTRAN( cMeta, "FF" , "F" ) ; ENDIF +IF "GG" $ cMeta ; cMeta := STRTRAN( cMeta, "GG" , "K" ) ; ENDIF +IF "KK" $ cMeta ; cMeta := STRTRAN( cMeta, "KK" , "K" ) ; ENDIF +IF "LL" $ cMeta ; cMeta := STRTRAN( cMeta, "LL" , "L" ) ; ENDIF +IF "MM" $ cMeta ; cMeta := STRTRAN( cMeta, "MM" , "M" ) ; ENDIF +IF "NN" $ cMeta ; cMeta := STRTRAN( cMeta, "NN" , "N" ) ; ENDIF +IF "PP" $ cMeta ; cMeta := STRTRAN( cMeta, "PP" , "P" ) ; ENDIF +IF "RR" $ cMeta ; cMeta := STRTRAN( cMeta, "RR" , "R" ) ; ENDIF +IF "SS" $ cMeta ; cMeta := STRTRAN( cMeta, "SS" , "S" ) ; ENDIF +IF "TT" $ cMeta ; cMeta := STRTRAN( cMeta, "TT" , "T" ) ; ENDIF +IF "XX" $ cMeta ; cMeta := STRTRAN( cMeta, "XX" , "KS" ) ; ENDIF +IF "ZZ" $ cMeta ; cMeta := STRTRAN( cMeta, "ZZ" , "S" ) ; ENDIF + +// J sounds +IF "DGE" $ cMeta ; cMeta := STRTRAN( cMeta, "DGE" , "J" ) ; ENDIF +IF "DGY" $ cMeta ; cMeta := STRTRAN( cMeta, "DGY" , "J" ) ; ENDIF +IF "DGI" $ cMeta ; cMeta := STRTRAN( cMeta, "DGI" , "J" ) ; ENDIF +IF "GI" $ cMeta ; cMeta := STRTRAN( cMeta, "GI" , "J" ) ; ENDIF +IF "GE" $ cMeta ; cMeta := STRTRAN( cMeta, "GE" , "J" ) ; ENDIF +IF "GY" $ cMeta ; cMeta := STRTRAN( cMeta, "GY" , "J" ) ; ENDIF + +// X sounds (KS) +IF "X" $ cMeta ; cMeta := STRTRAN( cMeta, "X" , "KS" ) ; ENDIF + +// special consideration for SCH +IF "ISCH" $ cMeta; cMeta := STRTRAN( cMeta, "ISCH", "IX" ) ; ENDIF +IF "SCH" $ cMeta ; cMeta := STRTRAN( cMeta, "SCH" , "SK" ) ; ENDIF + +// sh sounds (X) +IF "CIA" $ cMeta ; cMeta := STRTRAN( cMeta, "CIA" , "X" ) ; ENDIF +IF "SIO" $ cMeta ; cMeta := STRTRAN( cMeta, "SIO" , "X" ) ; ENDIF +IF "C" $ cMeta ; cMeta := STRTRAN( cMeta, "SIA" , "X" ) ; ENDIF +IF "SH" $ cMeta ; cMeta := STRTRAN( cMeta, "SH" , "X" ) ; ENDIF +IF "TIA" $ cMeta ; cMeta := STRTRAN( cMeta, "TIA" , "X" ) ; ENDIF +IF "TIO" $ cMeta ; cMeta := STRTRAN( cMeta, "TIO" , "X" ) ; ENDIF +IF "TCH" $ cMeta ; cMeta := STRTRAN( cMeta, "TCH" , "X" ) ; ENDIF +IF "CH" $ cMeta ; cMeta := STRTRAN( cMeta, "CH" , "X" ) ; ENDIF + +// hissing sounds (S) +IF "SCI" $ cMeta ; cMeta := STRTRAN( cMeta, "SCI" , "S" ) ; ENDIF +IF "SCE" $ cMeta ; cMeta := STRTRAN( cMeta, "SCE" , "S" ) ; ENDIF +IF "SCY" $ cMeta ; cMeta := STRTRAN( cMeta, "SCY" , "S" ) ; ENDIF +IF "CI" $ cMeta ; cMeta := STRTRAN( cMeta, "CI" , "S" ) ; ENDIF +IF "CE" $ cMeta ; cMeta := STRTRAN( cMeta, "CE" , "S" ) ; ENDIF +IF "CY" $ cMeta ; cMeta := STRTRAN( cMeta, "CY" , "S" ) ; ENDIF +IF "Z" $ cMeta ; cMeta := STRTRAN( cMeta, "Z" , "S" ) ; ENDIF + +// th sound (0) +IF "TH" $ cMeta ; cMeta := STRTRAN( cMeta, "TH" , "0" ) ; ENDIF + +// Convert all vowels to 'v' from 3rd byte on +cMeta := LEFT( cMeta, 2 ) + _ftConvVowel( SUBSTR( cMeta, 3 ) ) + +// Make Y's silent if not followed by vowel +IF "Y" $ cMeta + cMeta := STRTRAN( cMeta, "Yv" , "#" ) // Y followed by vowel + cMeta := STRTRAN( cMeta, "Y" , "" ) // not followed by vowel + cMeta := STRTRAN( cMeta, "#" , "Yv" ) // restore Y and vowel +ENDIF + +// More G sounds, looking at surrounding vowels +IF "GHv" $ cMeta ; cMeta := STRTRAN( cMeta, "GHv" , "G" ) ; ENDIF +IF "vGHT" $ cMeta; cMeta := STRTRAN( cMeta, "vGHT", "T" ) ; ENDIF +IF "vGH" $ cMeta ; cMeta := STRTRAN( cMeta, "vGH" , "W" ) ; ENDIF +IF "GN" $ cMeta ; cMeta := STRTRAN( cMeta, "GN" , "N" ) ; ENDIF +IF "G" $ cMeta ; cMeta := STRTRAN( cMeta, "G" , "K" ) ; ENDIF + +// H sounds, looking at surrounding vowels +IF "vHv" $ cMeta ; cMeta := STRTRAN( cMeta, "vHv" , "H" ) ; ENDIF +IF "vH" $ cMeta ; cMeta := STRTRAN( cMeta, "vH" , "" ) ; ENDIF + +// F sounds +IF "PH" $ cMeta ; cMeta := STRTRAN( cMeta, "PH" , "F" ) ; ENDIF +IF "V" $ cMeta ; cMeta := STRTRAN( cMeta, "V" , "F" ) ; ENDIF + +// D sounds a bit like T +IF "D" $ cMeta ; cMeta := STRTRAN( cMeta, "D" , "T" ) ; ENDIF + +// K sounds +IF "CK" $ cMeta ; cMeta := STRTRAN( cMeta, "CK" , "K" ) ; ENDIF +IF "Q" $ cMeta ; cMeta := STRTRAN( cMeta, "Q" , "K" ) ; ENDIF +IF "C" $ cMeta ; cMeta := STRTRAN( cMeta, "C" , "K" ) ; ENDIF + +// Remove vowels +cMeta := STRTRAN( cMeta, "v", "" ) + +RETURN PadR( ALLTRIM( cMeta ), nSize ) + +*------------------------------------------------ +STATIC FUNCTION _ftMakeAlpha ( cStr ) +// Strips non-alpha characters from a string, leaving spaces + +LOCAL x, cAlpha := "" + +FOR x := 1 to LEN( cStr ) + IF SUBSTR( cStr, x, 1 ) == " " .OR. ISALPHA( SUBSTR( cStr, x, 1 ) ) + cAlpha := cAlpha + SUBSTR( cStr, x, 1 ) + ENDIF +NEXT + +RETURN cAlpha + +*------------------------------------------------ +STATIC FUNCTION _ftConvVowel ( cStr ) +// Converts all vowels to letter 'v' + +LOCAL x, cConverted := "" + +FOR x := 1 to LEN( cStr ) + IF SUBSTR( cStr, x, 1 ) $ "AEIOU" + cConverted := cConverted + "v" + ELSE + cConverted := cConverted + SUBSTR( cStr, x, 1 ) + ENDIF +NEXT + +RETURN cConverted + +*------------------------------------------------ +// eof metaph.prg + diff --git a/harbour/contrib/libnf/miltime.prg b/harbour/contrib/libnf/miltime.prg new file mode 100644 index 0000000000..41770d11ac --- /dev/null +++ b/harbour/contrib/libnf/miltime.prg @@ -0,0 +1,280 @@ +/* + * File......: MILTIME.PRG + * Author....: Alexander B. Spencer + * CIS ID....: 76276,1012 + * + * This is an original work by Alexander B. Spencer and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.2 15 Aug 1991 23:04:02 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 14 Jun 1991 19:52:22 GLENN + * Minor edit to file header + * + * Rev 1.0 14 Jun 1991 03:43:52 GLENN + * Initial revision. + * + */ + + + + + +#ifdef FT_TEST + + function main() + + cls + ? "am-pm" + ? ft_civ2mil(" 5:40 pm") + ? ft_civ2mil("05:40 pm") + ? ft_civ2mil(" 5:40 PM") + ? ft_civ2mil(" 5:40 am") + ? ft_civ2mil("05:40 am") + ? ft_civ2mil(" 5:40 AM") + ? + inkey(0) + cls + ? "noon-midnight" + ? ft_civ2mil("12:00 m") + ? ft_civ2mil("12:00 M") + ? ft_civ2mil("12:00 m") + ? ft_civ2mil("12:00 n") + ? ft_civ2mil("12:00 N") + ? ft_civ2mil("12:00 n") + ? + inkey(0) + cls + ? "errors in noon-midnight" + ? ft_civ2mil("12:01 n") + ? ft_civ2mil("22:00 n") + ? ft_civ2mil("12:01 m") + ? ft_civ2mil("22:00 n") + ? + ? "sys to mil" + ? time() + ? ft_sys2mil() + return nil + +#endif + + + +/* $DOC$ + * $FUNCNAME$ + * FT_MIL2MIN() + * $CATEGORY$ + * Date/Time + * $ONELINER$ + * Convert time in military format to number of minute of day. + * $SYNTAX$ + * FT_MIL2MIN( ) -> nMINUTE + * $ARGUMENTS$ + * character string of form hhmm, where 0<=hh<24. + * $RETURNS$ + * numeric value representing minute of day. + * $DESCRIPTION$ + * Converts time in military format to number of minute of the day. + * $EXAMPLES$ + * FT_MIL2MIN( "1729" ) -> 1049 + * $SEEALSO$ + * FT_MIN2MIL() FT_CIV2MIL() FT_MIL2CIV() FT_SYS2MIL() + * $END$ + */ + +function FT_MIL2MIN(cMILTIME) + return int(val(left(cMILTIME,2))*60 + val(right(cMILTIME,2))) + + +/* $DOC$ + * $FUNCNAME$ + * FT_MIN2MIL() + * $CATEGORY$ + * Date/Time + * $ONELINER$ + * Convert minute of day to military format time. + * $SYNTAX$ + * FT_MIN2MIL( ) -> cMILTIME + * $ARGUMENTS$ + * numeric integer representing minute of day. + * $RETURNS$ + * character string of form hhmm, where 0<=hh<24. + * $DESCRIPTION$ + * Converts minute of the day to military format time. + * $EXAMPLES$ + * FT_MIN2MIL( 279 ) -> 0439 + * $SEEALSO$ + * FT_MIL2MIN() FT_MIL2CIV() FT_CIV2MIL() FT_SYS2MIL() + * $END$ + */ + +function FT_MIN2MIL(nMIN) + nMIN := nMIN%1440 + return right("00" + ltrim(str(INT(nMIN/60))),2) + ; + right("00" + ltrim(str(INT(nMIN%60))),2) + + + +/* $DOC$ + * $FUNCNAME$ + * FT_MIL2CIV() + * $CATEGORY$ + * Date/Time + * $ONELINER$ + * Convert time in military format to civilian format. + * $SYNTAX$ + * FT_MIL2CIV( ) -> dMILTIME + * $ARGUMENTS$ + * character string of form hhmm, where 0<=hh<24. + * $RETURNS$ + * character string of form hh:mm (am,pm,n or m), + * where 0 4:40 pm + * + * FT_MIL2CIV( "0440" ) -> 4:40 am + * + * FT_MIL2CIV( "1200" ) -> 12:00 n + * + * FT_MIL2CIV( "0000" ) and FT_MIL2CIV( "2400" ) -> 12:00 m + * + * Caution: leading blanks are irrelevant. + * $SEEALSO$ + * FT_CIV2MIL() FT_SYS2MIL() FT_MIL2MIN() FT_MIN2MIL() + * $END$ + */ + +function FT_MIL2CIV(cMILTIME) + local cHRS,cMINS,nHRS,cCIVTIME + + nHRS := val(LEFT(cMILTIME,2)) + cMINS := right(cMILTIME,2) + + do case + case (nHRS == 24 .OR. nHRS == 0) .AND. (cMINS == "00") // Midnight + cCIVTIME = "12:00 m" + case (nHRS == 12) // Noon to 12:59pm + if cMINS == "00" + cCIVTIME = "12:00 n" + else + cCIVTIME = "12:" + cMINS + " pm" + endif + case (nHRS < 12) && AM + if nHRS == 0 + cHRS = "12" + else + cHRS = right(" " + ltrim(str(int(nHRS))),2) + endif + cCIVTIME = cHRS + ":" + cMINS + " am" + + otherwise && PM + cCIVTIME = right(" " + ltrim(str(int(nHRS - 12))), 2) + ; + ":" + cMINS + " pm" + endcase + + return cCIVTIME + + + +/* $DOC$ + * $FUNCNAME$ + * FT_CIV2MIL() + * $CATEGORY$ + * Date/Time + * $ONELINER$ + * Convert usual civilian format time to military time. + * $SYNTAX$ + * FT_CIV2MIL( ) -> cMILTIME + * $ARGUMENTS$ + * character string of form hh:mm (am,pm,n or m), + * where 0 character string of form hhmm, where 0<=hh<24. + * $DESCRIPTION$ + * Converts time from 12-hour civilian format to military. + * $EXAMPLES$ + * FT_CIV2MIL( " 5:40 pm" ) -> 1740 + * + * FT_CIV2MIL( " 5:40 am" ) -> 0540 + * + * FT_CIV2MIL( "12:00 n" ) -> 1200 + * + * FT_CIV2MIL( "12:00 m" ) -> 0000 + * + * Caution: leading blanks are irrelevant; p,a,n,m must be preceded by + * one and only one space. + * $SEEALSO$ + * FT_MIL2CIV() FT_SYS2MIL() FT_MIL2MIN() FT_MIN2MIL() + * $END$ + */ + +function FT_CIV2MIL(cTIME) + local cKEY, cMILTIME + +*** Insure leading 0's +cTIME = REPLICATE("0", 3 - at(":", ltrim(cTIME))) + ltrim(cTIME) + +*** Adjust for popular use of '12' for first hour after noon and midnight +if left(ltrim(cTIME),2) == "12" + cTIME = stuff(cTIME, 1, 2, "00") +endif + +*** am, pm, noon or midnight +cKEY = substr(ltrim(cTIME), 7, 1) + +do case +case upper(cKEY) == "N" && noon + if left(cTIME,2) + substr(cTIME,4,2) == "0000" + cMILTIME = "1200" + else + cMILTIME = " " + endif + case upper(cKEY) == "M" && midnight + if left(cTIME,2) + substr(cTIME,4,2) == "0000" + cMILTIME = "0000" + else + cMILTIME = " " + endif + case upper(cKEY) == "A" && am + cMILTIME = right("00" + ltrim(str(val(left(cTIME,2)))),2) + ; + substr(cTIME,4,2) + case upper(cKEY) == "P" && pm + cMILTIME = right("00" + ltrim(str(val(left(cTIME,2))+12)),2) + ; + substr(cTIME,4,2) + otherwise + cMILTIME = " " && error +endcase + + return cMILTIME + + +/* $DOC$ + * $FUNCNAME$ + * FT_SYS2MIL() + * $CATEGORY$ + * Date/Time + * $ONELINER$ + * Convert system time to military time format. + * $SYNTAX$ + * FT_SYS2MIL() -> cMILTIME + * $ARGUMENTS$ + * none + * $RETURNS$ + * character string of form hhmm, where 0<=hh<24. + * $DESCRIPTION$ + * Return current system time as character string in military format. + * $EXAMPLES$ + * FT_SYS2MIL() -> 1623 + * $SEEALSO$ + * FT_MIL2CIV() FT_CIV2MIL() + * $END$ + */ + +function FT_SYS2MIL() +return left(stuff(time(),3,1,""),4) diff --git a/harbour/contrib/libnf/min2dhm.prg b/harbour/contrib/libnf/min2dhm.prg new file mode 100644 index 0000000000..d3a2f42af7 --- /dev/null +++ b/harbour/contrib/libnf/min2dhm.prg @@ -0,0 +1,58 @@ +/* + * File......: MIN2DHM.PRG + * Author....: Alexander B. Spencer + * CIS ID....: 76276,1012 + * + * This is an original work by Alexander B. Spencer and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.3 17 Aug 1991 15:33:50 GLENN + * Don Caton fixed some spelling errors in the doc + * + * Rev 1.2 15 Aug 1991 23:04:46 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 14 Jun 1991 19:52:26 GLENN + * Minor edit to file header + * + * Rev 1.0 07 Jun 1991 23:39:50 GLENN + * Initial revision. + * + */ + + + +/* $DOC$ + * $FUNCNAME$ + * FT_MIN2DHM() + * $CATEGORY$ + * Date/Time + * $ONELINER$ + * Convert numeric minutes to days, hours and minutes. + * $SYNTAX$ + * FT_MIN2DHM( ) -> aDHM_ + * $ARGUMENTS$ + * the number of minutes. + * $RETURNS$ + * + * where: + * aDHM_[1] = cDAYS, aDHM_[2] = cHours, aDHM_[3] = cMinutes + * $DESCRIPTION$ + * Converts numeric minutes into a character array containing + * days, hours & minutes. + * $EXAMPLES$ + * aDHM_ = MIN2DHM(16789) -> aDHM_[1] = 11, aDHM_[2] = 15, aDHM_[3] = 49 + * $END$ + */ + +function FT_MIN2DHM(nMINS) + local aDHM_[3] + + aDHM_[1] = ltrim((str(int(nMINS/1440)))) + aDHM_[2] = ltrim(str(int((nMINS%1440)/60))) + aDHM_[3] = ltrim(str(int((nMINS%1440)%60))) + + return aDHM_ diff --git a/harbour/contrib/libnf/mkdir.c b/harbour/contrib/libnf/mkdir.c new file mode 100644 index 0000000000..4a1bf826cf --- /dev/null +++ b/harbour/contrib/libnf/mkdir.c @@ -0,0 +1,105 @@ +/* + * $Id$ + */ + +/*; File......: MKDIR.ASM +; Author....: Ted Means +; CIS ID....: 73067,3332 +; +; This is an original work by Ted Means and is placed in the +; public domain. +; +; Modification history: +; --------------------- +; +; Rev 1.2 15 Aug 1991 23:06:58 GLENN +; Forest Belt proofread/edited/cleaned up doc +; +; Rev 1.1 14 Jun 1991 19:54:44 GLENN +; Minor edit to file header +; +; Rev 1.0 01 Apr 1991 01:03:32 GLENN +; Nanforum Toolkit +; +; +*/ + +/* $DOC$ +* $FUNCNAME$ +* FT_MKDIR() +* $CATEGORY$ +* DOS/BIOS +* $ONELINER$ +* Create a subdirectory +* $SYNTAX$ +* FT_MKDIR( ) -> nResult +* $ARGUMENTS$ +* is the name of the directory to create. +* $RETURNS$ +* 0 if successful +* 3 if Path Not Found +* 5 if Access Denied or directory already exists +* 99 if invalid parameters passed +* $DESCRIPTION$ +* Use this function to create the subdirectories needed by your +* application. It might be especially useful in an installation +* program. +* +* The source code is written to adhere to Turbo Assembler's IDEAL mode. +* To use another assembler, you will need to rearrange the PROC and +* SEGMENT directives, and also the ENDP and ENDS directives (a very +* minor task). +* $EXAMPLES$ +* FT_MKDIR( "C:\CLIPPER" ) +* FT_MKDIR( "\EXAMPLE" ) +* FT_MKDIR( "..\SOURCE" ) +* $END$ +*/ + +/*This is the Original FT_CHDIR() code +IDEAL +MODEL HUGE +Public _HB_FUN_FT_MKDIR + +Extrn _hb_ftdir:Far + +Segment _NanFor Word Public "CODE" + Assume CS:_NanFor + +Proc _HB_FUN_FT_MKDIR Far + + Mov AH,39h * DOS service--create directory + Push AX * Save on stack + Call _hb_ftdir * Call generic directory routine + Add SP,2 * Realign stack + Ret +Endp _HB_FUN_FT_MKDIR +Ends _NanFor +End +*/ + +/* This is the New one Rewriten in C*/ + +#include "hbapi.h" +#include "dos.h" + +HB_FUNC(FT_MKDIR) +{ +#if defined(HB_OS_DOS) + { + + int Status; + char *path=hb_parc(1); + union REGS regs; + struct SREGS sregs; + segread(&sregs); + regs.h.ah=0x39; + sregs.ds=FP_SEG(path); + regs.HB_XREGS.dx=FP_OFF(path); + int86x(0x21,®s,®s,&sregs); + Status=regs.HB_XREGS.ax; + hb_retni(Status); + } +#endif +} + diff --git a/harbour/contrib/libnf/month.prg b/harbour/contrib/libnf/month.prg new file mode 100644 index 0000000000..85ceb14b10 --- /dev/null +++ b/harbour/contrib/libnf/month.prg @@ -0,0 +1,110 @@ +/* + * File......: MONTH.PRG + * Author....: Jo W. French dba Practical Computing + * CIS ID....: 74731,1751 + * + * The functions contained herein are the original work of Jo W. French + * and are placed in the public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.3 28 Sep 1992 00:40:00 GLENN + * Jo French cleaned up. + * + * Rev 1.2 15 Aug 1991 23:05:42 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 14 Jun 1991 19:52:28 GLENN + * Minor edit to file header + * + * Rev 1.0 01 Apr 1991 01:01:46 GLENN + * Nanforum Toolkit + * + */ + +/* $DOC$ + * $FUNCNAME$ + * FT_MONTH() + * $CATEGORY$ + * Date/Time + * $ONELINER$ + * Return Calendar or Fiscal Month Data + * $SYNTAX$ + * FT_MONTH( [ ], [nMonthNum] ) -> aDateInfo + * $ARGUMENTS$ + * is any valid date in any date format. Defaults + * to current system date if not supplied. + * + * is a number from 1 to 12 signifying a month. + * Defaults to current month if not supplied. + * $RETURNS$ + * A three element array containing the following data: + * + * aDateInfo[1] - The year and month as a character string "YYYYMM" + * aDateInfo[2] - The beginning date of the month + * aDateInfo[3] - The ending date of the month + * $DESCRIPTION$ + * FT_MONTH() returns an array containing data about the month + * containing the given date. + * + * Normally the return data will be based on a year beginning + * on January 1st with weeks beginning on Sunday. + * + * The beginning of year date and/or beginning of week day can be + * changed by using FT_DATECNFG(), which will affect all subsequent + * calls to FT_MONTH() until another call to FT_DATECNFG(). + * + * The beginning of year date and beginning of week day may be reset + * to January 1 and Sunday by calling FT_DATECNFG() with no + * parameters. + * $EXAMPLES$ + * // get info about month containing 9/15/90 + * aDateInfo := FT_MONTH( CTOD("09/15/90") ) + * ? aDateInfo[1] // 199009 (9th month) + * ? aDateInfo[2] // 09/01/90 beginning of month 9 + * ? aDateInfo[3] // 09/30/90 end of week month 9 + * + * // get info about month 5 in year containing 9/15/90 + * aDateInfo := FT_MONTH( CTOD("09/15/90"), 5 ) + * ? aDateInfo[1] // 199005 + * ? aDateInfo[2] // 05/01/90 beginning of month 5 + * ? aDateInfo[3] // 05/31/90 end of month 5 + * + * // get info about month 5 in current year (1991) + * aDateInfo := FT_MONTH( , 5 ) + * ? aDateInfo[1] // 199105 + * ? aDateInfo[2] // 05/01/91 beginning of month 5 + * ? aDateInfo[3] // 05/31/91 end of month 5 + * $SEEALSO$ + * FT_DATECNFG() FT_WEEK() FT_QTR() FT_YEAR() + * $END$ +*/ + +FUNCTION FT_MONTH( dGivenDate, nMonthNum ) +LOCAL lIsMonth, nTemp, aRetVal + + IF !( VALTYPE(dGivenDate) $ 'ND') + dGivenDate := DATE() + ELSEIF VALTYPE(dGivenDate) == 'N' + nMonthNum := dGivenDate + dGivenDate := DATE() + ENDIF + + aRetVal := FT_YEAR(dGivenDate) + + lIsMonth := ( VALTYPE(nMonthNum) == 'N' ) + IF lISMonth + IF( nMonthNum < 1 .OR. nMonthNum > 12, nMonthNum := 12, ) + dGivenDate := FT_MADD(aRetVal[2], nMonthNum - 1) + ENDIF + + nTemp := MONTH( dGivenDate ) - MONTH( aRetVal[2] ) + nTemp += IF(nTemp >= 0, 1, 13) + + aRetVal[1] += PADL(LTRIM(STR(nTemp, 2)), 2, '0') + aRetVal[2] := FT_MADD( aRetVal[2], nTemp - 1 ) + aRetVal[3] := FT_MADD( aRetVal[2], 1 ) - 1 + +RETURN aRetVal + diff --git a/harbour/contrib/libnf/mouse.c b/harbour/contrib/libnf/mouse.c new file mode 100644 index 0000000000..533c858c1c --- /dev/null +++ b/harbour/contrib/libnf/mouse.c @@ -0,0 +1,555 @@ +/* + * $Id$ + */ + +/* + Harbour Project source code + + mouse.c Support functions for Nanfor Library + + Copyright 2000 Luiz Rafael Culik + www - http://www.harbour-project.org + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version, with one exception: + + The exception is that if you link the Harbour Runtime Library (HRL) + and/or the Harbour Virtual Machine (HVM) with other files to produce + an executable, this does not by itself cause the resulting executable + to be covered by the GNU General Public License. Your use of that + executable is in no way restricted on account of linking the HRL + and/or HVM code into it. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + their web site at http://www.gnu.org/). + +*/ + +#include "extend.h" +#include "dos.h" +#include "hbapiitm.h" +#include "hbapigt.h" + +HB_FUNC(_MGET_PAGE) +{ + int iPage; +#if defined(HB_OS_DOS) + + { + + union REGS regs; + regs.HB_XREGS.ax=0x1E; + HB_DOS_INT86(0x33,®s,®s); + } +#else + { + iPage=0; + } +#endif + { + hb_retni(iPage); + } + +} + + +HB_FUNC(_MSET_PAGE) +{ +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=0x1D; + regs.HB_XREGS.bx=hb_parni(1); + HB_DOS_INT86(0x33,®s,®s); + } +#endif +} + + +HB_FUNC(_MGET_MVERSION) +{ + int iMinor; + int iType; + int iIRQ; + int iMajor; + +#if defined(HB_OS_DOS) + + { + union REGS regs; + + regs.HB_XREGS.ax = 0x24; + HB_DOS_INT86( 0x33, ®s, ®s ); + + iMinor = regs.h.bl; + iType = regs.h.ch; + iIRQ = regs.h.cl; + iMajor = regs.h.bh; + } + +#else + + { + iMinor = 0; + iType = 0; + iIRQ = 0; + iMajor = 0; + } + +#endif + + { + PHB_ITEM pArray = hb_itemArrayNew( 4 ); + + PHB_ITEM pMinor = hb_itemPutNI( NULL, iMinor ); + PHB_ITEM pType = hb_itemPutNI( NULL, iType ); + PHB_ITEM pIRQ = hb_itemPutNI( NULL, iIRQ ); + PHB_ITEM pMajor = hb_itemPutNI( NULL, iMajor ); + + hb_itemArrayPut( pArray, 1, pMinor ); + hb_itemArrayPut( pArray, 2, pType ); + hb_itemArrayPut( pArray, 3, pIRQ ); + hb_itemArrayPut( pArray, 4, pMajor ); + + hb_itemReturn( pArray ); + + hb_itemRelease( pMajor ); + hb_itemRelease( pIRQ ); + hb_itemRelease( pType ); + hb_itemRelease( pMinor ); + + hb_itemRelease( pArray ); + } + + +} + + +HB_FUNC(_MGET_HORISPEED) +{ + int iSpeed; + +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=0x1B; + HB_DOS_INT86(0x33,®s,®s); + iSpeed=regs.HB_XREGS.bx; + } +#else + { + iSpeed=0; + } +#endif + { + hb_retni(iSpeed); + } +} +HB_FUNC(_MGET_VERSPEED) +{ + int iSpeed; +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=0x1B; + HB_DOS_INT86(0x33,®s,®s); + iSpeed=regs.HB_XREGS.cx; + } +#else + { + iSpeed=0; + } +#endif + { + hb_retni(iSpeed); + } +} +HB_FUNC(_MGET_DOUBLESPEED) +{ + int iSpeed; +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=0x1B; + HB_DOS_INT86(0x33,®s,®s); + iSpeed=regs.HB_XREGS.dx; + } +#else + { + iSpeed=0; + } +#endif + { + hb_retni(iSpeed); + } +} + +HB_FUNC(_MSET_SENSITIVE) //nHoriz,nVert,nDouble) +{ +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=0x1A; + regs.HB_XREGS.bx=hb_parni(1); + regs.HB_XREGS.cx=hb_parni(2); + regs.HB_XREGS.dx=hb_parni(3); + HB_DOS_INT86(0x33,®s,®s); + } +#endif +} +HB_FUNC(_MSE_CONOFF) //nTop*8,nLeft*8,nBotton*8,nRight*8) +{ +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=0x1A; + regs.HB_XREGS.cx=hb_parni(2); + regs.HB_XREGS.dx=hb_parni(1); + regs.HB_XREGS.si=hb_parni(4); + regs.HB_XREGS.di=hb_parni(3); + HB_DOS_INT86(0x33,®s,®s); + } +#endif +} + +HB_FUNC(_MGET_MICS) +{ +int iHori; +int iVert; +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=0x0B; + HB_DOS_INT86(0x33,®s,®s); + iHori=regs.HB_XREGS.cx; + iVert=regs.HB_XREGS.dx; + } +#else + { + iHori=0; + iVert=0; + } +#endif + { + PHB_ITEM pArray = hb_itemArrayNew(2); + PHB_ITEM pHori = hb_itemPutNI(NULL,iHori); + PHB_ITEM pVert = hb_itemPutNI(NULL,iVert); + + + hb_itemArrayPut( pArray, 1, pHori ); + hb_itemArrayPut( pArray, 2, pVert ); + hb_itemReturn(pArray); + + hb_itemRelease(pArray); + hb_itemRelease(pHori); + hb_itemRelease(pVert); + + } +} + + +HB_FUNC(_M_RESET) +{ + int iMouse; +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=0; + HB_DOS_INT86(0x33,®s,®s); + iMouse=regs.HB_XREGS.ax; + } +#else + { + iMouse=0; + } +#endif + { + hb_retl(iMouse); + } + +} +HB_FUNC( _MSE_SHOWCURS) +{ +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=1; + HB_DOS_INT86(0x33,®s,®s); + } +#endif +} + +HB_FUNC( _MSE_MHIDECRS) + { +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=2; + HB_DOS_INT86(0x33,®s,®s); + } +#endif +} + +HB_FUNC( _MSE_GETPOS) + +{ +int iHori; +int iVert; +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=3; + HB_DOS_INT86(0x33,®s,®s); + iHori=regs.HB_XREGS.cx; + iVert=regs.HB_XREGS.dx; + } +#else + { + iHori=0; + iVert=0; + } +#endif + { + PHB_ITEM pArray = hb_itemArrayNew(2); + PHB_ITEM pHori = hb_itemPutNI(NULL,iHori); + PHB_ITEM pVert = hb_itemPutNI(NULL,iVert); + + + hb_itemArrayPut( pArray, 1, pHori ); + hb_itemArrayPut( pArray, 2, pVert ); + hb_itemReturn(pArray); + + hb_itemRelease(pArray); + hb_itemRelease(pHori); + hb_itemRelease(pVert); + + } + +} + +HB_FUNC( _M_GETX) +{ + int iRow; +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=3; + HB_DOS_INT86(0x33,®s,®s); + iRow=regs.HB_XREGS.dx; + } +#else + { + iRow=0; + } +#endif + { + hb_retni(iRow); + } + +} + +HB_FUNC( _M_GETY) +{ + int iCol ; +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=3; + HB_DOS_INT86(0x33,®s,®s); + iCol=regs.HB_XREGS.cx; + } +#else + { + iCol=0; + } +#endif + { + hb_retni(iCol); + } + +} + +HB_FUNC( _M_MSETPOS) +{ +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=4; + regs.HB_XREGS.cx=hb_parni(1); + regs.HB_XREGS.dx=hb_parni(2); + HB_DOS_INT86(0x33,®s,®s); + } +#endif +} + +HB_FUNC( _M_MSETCOORD) +{ +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=4; + regs.HB_XREGS.cx=hb_parni(1); + regs.HB_XREGS.dx=hb_parni(2); + HB_DOS_INT86(0x33,®s,®s); + } +#endif +} + +HB_FUNC( _M_MXLIMIT) +{ + int iMaxRow; + int iMinRow; + +#if defined(HB_OS_DOS) + { + union REGS regs; + iMaxRow=hb_parni(2); + iMinRow=hb_parni(1); + + regs.HB_XREGS.ax=7; + regs.HB_XREGS.cx=iMinRow; + regs.HB_XREGS.dx=iMaxRow; + + HB_DOS_INT86(0x33,®s,®s); + } +#endif +} + + +HB_FUNC( _M_MYLIMIT) +{ + int iMaxCol; + int iMinCol; +#if defined(HB_OS_DOS) + { + union REGS regs; + iMaxCol=hb_parni(2); + iMinCol=hb_parni(1); + regs.HB_XREGS.ax=8; + + regs.HB_XREGS.cx=iMinCol; + regs.HB_XREGS.dx=iMaxCol; + HB_DOS_INT86(0x33,®s,®s); + } +#endif +} + +HB_FUNC( _M_MBUTPRS) +{ + int inX; + int inY; + int inButton ; + BOOL lStatus; +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=6; + regs.HB_XREGS.bx=hb_parni(1); + HB_DOS_INT86(0x33,®s,®s); + + inY=regs.HB_XREGS.cx; + inX=regs.HB_XREGS.dx; + inButton=regs.HB_XREGS.bx; + lStatus=regs.HB_XREGS.ax; + } +#else + { + inY=0; + inX=0; + inButton=0; + lStatus=0; +} +#endif + { + PHB_ITEM pArray = hb_itemArrayNew(4); + PHB_ITEM pY = hb_itemPutNI(NULL,inY); + PHB_ITEM pX = hb_itemPutNI(NULL,inX); + PHB_ITEM pButton = hb_itemPutNI(NULL,inButton); + PHB_ITEM pStatus = hb_itemPutNI(NULL,lStatus); + hb_itemArrayPut( pArray, 1, pButton ); /* NOTE: I've changed 1 to 3 */ + hb_itemArrayPut( pArray, 2, pX ); + hb_itemArrayPut( pArray, 3, pY ); + hb_itemArrayPut( pArray, 4, pStatus ); /* NOTE: I've changed 1 to 3 */ + hb_itemReturn(pArray); + + hb_itemRelease(pArray); + hb_itemRelease(pX); + hb_itemRelease(pY); + hb_itemRelease(pStatus); + hb_itemRelease(pButton); + } +} + +HB_FUNC( _M_MDEFCRS) +{ +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=0x0A; + regs.HB_XREGS.bx=hb_parni(1); + regs.HB_XREGS.cx=hb_parni(2); + regs.HB_XREGS.dx=hb_parni(3); + + HB_DOS_INT86(0x33,®s,®s); + } +#endif +} + + + +HB_FUNC( _M_MGETCOORD) +{ +int inX; +int inY; +int inButton; + +#if defined(HB_OS_DOS) + { + union REGS regs; + regs.HB_XREGS.ax=3; + HB_DOS_INT86(0x33,®s,®s); + + inButton=regs.HB_XREGS.bx; + inY=regs.HB_XREGS.cx; + inX=regs.HB_XREGS.dx; + + } + +#else + + { + inX=0; + inY=0; + inButton=0; + + } +#endif + { + PHB_ITEM pArray = hb_itemArrayNew(3); + + PHB_ITEM pnY = hb_itemPutNI(NULL,inY); + PHB_ITEM pnX = hb_itemPutNI(NULL,inX); + PHB_ITEM pnButton= hb_itemPutNI(NULL,inButton); + + hb_itemArrayPut( pArray, 1, pnX ); + hb_itemArrayPut( pArray, 2, pnY ); + hb_itemArrayPut( pArray, 3, pnButton ); + + hb_itemReturn(pArray); + + hb_itemRelease(pArray); + hb_itemRelease(pnY); + hb_itemRelease(pnX); + hb_itemRelease(pnButton); + } + +} diff --git a/harbour/contrib/libnf/mouse1.prg b/harbour/contrib/libnf/mouse1.prg new file mode 100644 index 0000000000..784c588fe5 --- /dev/null +++ b/harbour/contrib/libnf/mouse1.prg @@ -0,0 +1,1470 @@ + +static lCrsState:=.F. +static lMinit:=.F. + +#ifdef FT_TEST + + FUNCTION MAIN(nRow,nCol) + +* Pass valid row and column values for different video modes to change modes + + local nX, nY, cSavClr + local cSavScr := savescreen( 0, 0, maxrow(), maxcol() ) + local nXm, nYm + local nSaveRow:=MAXROW()+1, nSaveCol:=MAXCOL()+1 + local nMinor, nType, nIRQ + local aType:={"Bus","Serial","InPort","PS/2","HP"} + local nHoriz, nVert, nDouble + local nTime + + IF nRow=NIL + nRow=MAXROW()+1 + ELSE + nRow=VAL(nRow) + ENDIF + + IF nCol=NIL + nCol=MAXCOL()+1 + ELSE + nCol=VAL(nCol) + ENDIF + + if !FT_MINIT() + @ maxrow(), 0 say "Mouse driver is not installed!" + + return "" + endif + + * ..... Set up the screen + cSavClr := setcolor( "w/n" ) + @ 0,0,maxrow(),maxcol() box "같같같같�" + + setcolor( "GR+/RB" ) +// scroll( 7,2,19,63,0 ) + @ 7,2 to 20,63 + + @ 17, 10 to 19, 40 double + + setcolor( "N/W" ) + @ 18, 11 say " Double Click here to Quit " + + setcolor( "GR+/RB" ) + + * ..... Start the demo + + @MAXROW(),0 SAY "Driver version: "+; + ALLTRIM(STR(FT_MVERSION(@nMinor,@nType,@nIRQ),2,0))+"."+; + ALLTRIM(STR(nMinor,2,0)) + @ ROW(),COL() SAY " "+aType[nType]+" mouse using IRQ "+STR(nIRQ,1,0) + + FT_MGETSENS(@nHoriz,@nVert,@nDouble) // Get the current sensitivities + FT_MSETSENS(70,70,60) // Bump up the sensitivity of the mouse + + FT_MSHOWCRS() + FT_MSETCOORD(10,20) // just an arbitrary place for demo + +* put the unchanging stuff + + devpos( 9, 10 ) + devout( "FT_MMICKEYS :" ) + + devpos( 10, 10 ) + devout( "FT_MGETPOS :" ) + + devpos( 11, 10 ) + devout( "FT_MGETX :" ) + + devpos( 12, 10 ) + devout( "FT_MGETY :") + + devpos( 13, 10 ) + devout( "FT_MGETCOORD:" ) + + devpos( 14, 10 ) + devout( "FT_MBUTPRS :" ) + + devpos( 16, 10 ) + devout( "FT_MBUTREL :" ) + + nX := nY := 1 + do while .t. + +* If we are not moving then wait for movement. +* This whole demo is a bit artificial in its requirements when compared +* to a "normal" CLIPPER program so some of these examples are a bit out of +* the ordinary. + + DO WHILE nX=0.AND.nY=0 + FT_MMICKEYS( @nX, @nY ) + ENDDO +* tell the mouse driver where updates will be taking place so it can hide +* the cursor when necessary. + + FT_MCONOFF( 9, 23, 16, 53 ) + nTime=-1 + + devpos( 9, 23 ) + devout( nX ) + devout( nY ) + + devpos( 10, 23 ) + DEVOUT( FT_MGETPOS( @nX, @nY ) ) + devout( nX ) + devout( nY ) + + devpos( 11, 23 ) + DEVOUT( FT_MGETX() ) + + devpos( 12, 23 ) + DEVOUT( FT_MGETY() ) + + devpos( 13, 23 ) + devout( FT_MGETCOORD( @nX, @nY ) ) + devout ( nX ) + devout ( nY ) + + nX:=nY:=0 + devpos( 14, 23 ) + DEVOUT( FT_MBUTPRS(1) ) + DEVOUT( FT_MBUTPRS(0,, nX, nY) ) + devpos( 15, 23 ) + +* show only the last Press since it flashes by so quickly + + IF nX!=0.OR.nY!=0 + devout( nX ) + devout( nY ) + endif + + nX:=nY:=0 + devpos( 16, 23 ) + devout( FT_MBUTREL(0,, @nX, @nY) ) + +* show only the last release since it flashes by so quickly + + if nX!=0.OR.nY!=0 + devout( nX ) + devout( nY ) + endif + +* Restore the cursor if it has been hidden + + FT_MSHOWCRS() + + if FT_MINREGION( 18, 11, 18, 39 ) + +* Change the type of cursor when in the box. Just slightly different than the +* normal. The character is shown in high intensity. + + FT_MDEFCRS(0,32767,32512) + if FT_MDBLCLK(2,0,0.8) + exit + endif + endif + + if FT_MINREGION( 18, 11, 18, 39 ) + +* Change the type of cursor when in the box. Just slightly different than the +* normal. The character is shown in high intensity. + + FT_MDEFCRS(0,32767,32512) + else + +* Put the cursor back to normal mode + + FT_MDEFCRS(0,30719,30464) + endif + + FT_MMICKEYS( @nX, @nY ) + enddo + + FT_MHIDECRS() + + SETMODE(nSaveRow,nSaveCol) + setcolor( cSavClr ) + restscreen( 0, 0, maxrow(), maxcol(), cSavScr ) + devpos( maxrow(), 0 ) + +// Reset sensitivity + + FT_MSETSENS(nHoriz, nVert, nDouble) + + RETURN nil + + +#endif + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MMICKEYS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get mickeys + * $SYNTAX$ + * FT_MMICKEYS( @, @ ) -> NIL + * $ARGUMENTS$ + * is a variable that will receive the vertical mickey count. + * + * is a variable that will receive the horizontal mickey count. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * and must be passed by reference to receive + * the mouse position in Mickeys. + * $EXAMPLES$ + * FT_MMICKEYS( @nX, @nY ) + * ? nX + * ? nY + * $END$ + */ + +FUNCTION FT_MMICKEYS( nX, nY ) // read mouse motion counters +/* + aReg[AX] = 11 // set mouse function call 11 + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + Local areturn:={} + areturn:=_mget_mics() + nX := areturn[1] // store horizontal motion units + nY := areturn[2] // store vertical motion units + +RETURN NIL // no function output + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MDBLCLK() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Return true if a double click was detected + * $SYNTAX$ + * FT_MDBLCLK( [ [, [, [, [, ; + * [, ] ] ] ] ] ] ) -> lIsDoubleClk + * $ARGUMENTS$ + * is a numeric value. If it is zero FT_MDBLCLK() will not + * check for the first press but rather will simply wait the + * specified period for a single press. This is useful if this + * routine is called from one which in turn responded to a button + * press. If it is not present or not equal to 0, then FT_MDBLCLK() + * will wait for two presses of the specified button. + * + * is the mouse button number + * 0 - Left Button + * 1 - Right Button + * 2 - Middle Button [if applicable] + * + * is the interval to wait for the first click if requested + * and the time to wait for the second. If not present then defaults + * to 0.5 second. + * + * is the row number for the mouse cursor location for a double click + * to be valid. If not present then the current position is taken as + * the valid location. + * + * is the column number for the mouse cursor location for a double + * click to be valid. If not present, then the current position is + * taken as the valid location. + * + * is an optional start time for the waiting period for the first + * click (of either one or two requested). If not given then the + * time is set at entry into this routine. This is useful when this + * routine is called from another routine which was called in + * response to a mouse click but needs to know if a double click + * has occurred + * $RETURNS$ + * .T. if a double click was detected. + * $DESCRIPTION$ + * This is a mouse meta function that checks for the presence + * of a double click. + * $EXAMPLES$ + * IF FT_MISREGION( 10, 10, 11, 20 ) .AND.; + * FT_MDBLCLK(0,1,,FT_MGETX(),FT_MGETY()) && double click, right button + * && at current location with + * && default interval + * + * MnuItem1() + * ENDIF + * $SEEALSO$ + * FT_MBUTPRS() FT_MBUTREL() + * $END$ + */ + +FUNCTION FT_MDBLCLK( nClick, nButton, nInterval, nRow, nCol, nStart ) + +LOCAL nVert, nHorz // local row and col coordinates +LOCAL lDouble:=.F. // double click actually occurred +LOCAL lDone // loop flag +LOCAL nPrs // number of presses which occurred + +* Initialize any empty arguments + + if nClick=NIL + nClick=1 + endif + + if nButton=NIL + nButton=0 + endif + + if nRow=NIL + nRow=FT_MGETX() + endif + + if nCol=NIL + nCol=FT_MGETY() + endif + + if nInterval=NIL + nInterval=0.5 + endif + + if nStart=NIL + nStart=seconds() + endif + + nVert=nRow + nHorz=nCol + lDouble:=lDone:=nClick==0 + + // Wait for first press if requested + + do while !lDone + + FT_MBUTPRS( nButton, @nPrs, @nVert, @nHorz ) + nVert=INT(nVert/8) + nHorz=INT(nHorz/8) + + lDouble=(nPrs>0) + ldone= seconds() - nStart >= nInterval .or. lDouble + + enddo + + // if we have not moved then keep the preliminary double click setting + + lDouble=lDouble.and.(nVert=nRow.and.nHorz=nCol) + + // change start time if we waited for first click. nInterval is the + // maximum time between clicks not the total time for two clicks if + // requested. + + if nClick>0 + nStart=seconds() + endif + + // If we have fulfilled all of the requirements then wait for second click + + if lDouble + + lDouble:=lDone:=.F. + + do while !lDone + + FT_MBUTPRS( nButton, @nPrs, @nVert, @nHorz ) + nVert=INT(nVert/8) + nHorz=INT(nHorz/8) + + lDouble=(nPrs>0) + lDone= seconds() - nStart >= nInterval .or. lDouble + + enddo + + // make sure we haven't moved + + lDouble=lDouble.and.(nVert=nRow.and.nHorz=nCol) + + endif + + +RETURN lDouble + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MCONOFF() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Turn mouse cursur off if in specified region + * $SYNTAX$ + * FT_MCONOFF( , , , ) + * $ARGUMENTS$ + * , are the four corners of the + * screen region in row and column coordinates. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * This function tells the mouse driver to hide the cursor if it is in + * the given region. The driver hides the cursor by decrementing the cursor + * flag. A call to FT_MSHOWCRS is required to turn the cursor back on. + * Calling FT_MSHOWCRS also disables this function. + * + * See FT_MSHOWCRS for a discussion of the cursor display flag. + * $EXAMPLES$ + * FT_MCONOFF( 10, 10, 11, 20 ) + * $SEEALSO$ + * FT_MSHOWCRS() FT_MHIDECRS() FT_MXLIMIT() FT_MYLIMIT() FT_MINREGION() + * $END$ + */ + +FUNCTION FT_MCONOFF( nTop, nLeft, nBottom, nRight ) + +* Fill the registers + +/* + aReg[AX]:=16 + aReg[DX]:=nTop*8 + aReg[CX]:=nLeft*8 + aReg[DI]:=nBottom*8 + aReg[SI]:=nRight*8 + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + _mse_conoff(nTop*8,nLeft*8,nBottom*8,nRight*8) +RETURN NIL + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MINREGION() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Test if the mouse cursor is in the passed region + * $SYNTAX$ + * FT_MINREGION( , , , ) -> lInRegion + * $ARGUMENTS$ + * , are the four corners of the screen region. + * $RETURNS$ + * .T. if mouse is in specified region. + * $DESCRIPTION$ + * This function will check to see if the mouse cursor is + * within the confines of the specified region. + * $EXAMPLES$ + * IF FT_MINREGION( 10, 10, 11, 20 ) + * nChoice := 1 + * ENDIF + * $SEEALSO$ + * FT_MXLIMIT() FT_MYLIMIT() FT_MINREGION() + * $END$ + */ + +FUNCTION FT_MINREGION( nTR, nLC, nBR, nRC ) +RETURN ( FT_MGETX() >= nTR .and. FT_MGETX() <= nBR .and. ; + FT_MGETY() >= nLC .and. FT_MGETY() <= nRC ) + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MSETSENS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Set the mouse sensitivity parameters + * $SYNTAX$ + * FT_MSETSENS( , , ) -> NIL + * $ARGUMENTS$ + * is the sensitivity of the mouse on the horizontal axis. This + * value is the integer percentage of highest sensitivity and + * thus has a range of 1 to 100. The default value is 50 and at + * this setting about 3.2 inches of mouse movement will move + * the mouse cursor across the screen. If NIL, the current + * value is used. + * is the relative sensitivity of the mouse on the vertical axis. + * The value is an integer percentage of the highest sensitivity + * and thus has a range of 1 to 100. The default value is 50 and + * requires about 2 inches of mouse movement will move from top + * to bottom of the screen.If NIL, the current value is used. + * is the relative sensitivity of the mouse to doubling the ratio + * of cursor movement to mouse movement. The default + * value is 50. If NIL, the current value is used. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * This function allows one to control the mouse movement sensitivity. The + * first two arguments control the amount of movement necessary to move + * the cursor a given amount. The values are the percentage of full + * sensitivity and the default values after installing the mouse driver + * is 50 which represents approximately 3.2 inches of horizontal + * and 2 inches of vertical mouse movement to cover the entire screen. + * A value of 100 requires about 0.9 inches of horizontal mouse movement to + * cover the screen from one side to the other. + * + * The third argument changes the threshold above which the mouse moves at + * twice the normal speed. The value is a percentage of full sensitivity + * with the default (50) providing doubling at 64 mickeys per second. + * + * NOTE: These values are NOT restored after resetting the mouse driver/ + * hardware. A well behaved application should reset them to the + * original value upon exiting. + * + * NOTE: The above description is counter to all of the documentation + * I have available. However, it does not work the way it is documented + * with Microsoft drivers versions 6.16, 6.24, 7.04 and 8.20. The above + * movement values are documented to be the number of mickeys per 8 + * pixels and the double speed value as the number mickeys per second + * required to double the speed. Each of these values should range from 1 + * to 32K but the driver forces a maximum of 100. Also the documentation + * states that resetting the mouse will reset these values. This is not + * the case. + * + * + * $EXAMPLES$ + * FT_MSETSENS( 75,75,50 ) // a little less mouse movement necessary. + * $SEEALSO$ + * FT_MGETSENS() + * $END$ + */ + +FUNCTION FT_MSETSENS(nHoriz, nVert, nDouble) +LOCAL nCurHoriz, nCurVert, nCurDouble + +// Get current values + +FT_MGETSENS(@nCurHoriz, @nCurVert, @nCurDouble) + +// Set defaults if necessary + +IF VALTYPE(nHoriz)!="N" + nHoriz=nCurHoriz +ENDIF + +IF VALTYPE(nVert)!="N" + nVert=nCurVert +ENDIF + +IF VALTYPE(nDouble)!="N" + nDouble=nCurDouble +ENDIF + +* Fill the registers +_mset_sensitive(nHoriz,nVert,nDouble) + +RETURN nil + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MGETSENS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get the mouse sensitivity parameters + * $SYNTAX$ + * FT_MGETSENS( <@nHoriz>, <@nVert>, <@nDouble> ) -> NIL + * $ARGUMENTS$ + * is the percentage of maximum horizontal sensitivity. PASSED + * BY REFERENCE. + * is the percentage of maximum vertical sensitivity. PASSED BY + * REFERENCE. + * is the percentage of maximum sensitivity for doubling the + * mouse cursor's speed on the screen. PASSED BY REFERENCE. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * This function returns the current values of the mouse movement + * sensitivity parameters. The first two arguments control the amount of + * movement necessary to move the cursor a given amount. The third argument + * determines the threshold above which the mouse moves at twice the normal + * speed. For further discussion of these values see FT_MSETSENS() + * $EXAMPLES$ + * FT_MGETSENS( @nHoriz, @nVert, @nDouble ) + * $SEEALSO$ + * FT_MSETSENS() + * $END$ + */ + +FUNCTION FT_MGETSENS(nHoriz, nVert, nDouble) +/* +* Fill the register + +aReg[AX]=27 + +* Execute interupt + +FT_INT86( 51, aReg ) // execute mouse interrupt + +*/ +// Set the return values + +nHoriz = _mget_horispeed() +nVert = _mget_verspeed() +nDouble= _mget_doublespeed() + +RETURN NIL + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MVERSION() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get the mouse driver version + * $SYNTAX$ + * FT_MVERSION( <@nMinor>, <@nType>, <@nIRQ> ) -> + * $ARGUMENTS$ + * is the Minor version number. PASSED BY REFERENCE. + * is the Mouse type. PASSED BY REFERENCE. + * 1 = Bus Mouse + * 2 = Serial Mouse + * 3 = InPort Mouse + * 4 = PS/2 Mouse + * 5 = HP Mouse + * is the IRQ number used for the mouse. PASSED BY REFERENCE. + * 0 = PS/2 + * 2,3,4,5 or 7 = IRQ number + * $RETURNS$ + * which is the major version number of the mouse driver. + * $DESCRIPTION$ + * This function returns the current values of the mouse driver version + * number and type. The major version would be 6 and the minor version + * would be 10 if the driver were version 6.10. The mouse type and IRQ + * numbers are also returned. + * + * NOTE: It appears that the values reported when one starts the mouse + * driver actually have the minor version in hexadecimal! Thus on bootup + * my screen showed 6.24 but this routine returned 30 for the minor version + * number! + * $EXAMPLES$ + * nMajor=FT_MVERSION( @nMinor ) + * IF (nMajor+nMinor/100)<7.2 + * ? "Sorry mouse driver version too old" + * RETURN + * ENDIF + * $SEEALSO$ + * FT_MSETSENS() + * $END$ + */ + +FUNCTION FT_MVERSION(nMinor, nType, nIRQ) +Local aReturn:={} +// Set up register +/* +aReg[AX] = 36 + +// Call interupt + +FT_INT86( 51, aReg) +*/ +// decode out of half registers +areturn:=_mget_mversion() + +nMinor=areturn[1] +nType=areturn[2] +nIRQ=areturn[3] + +// Return + +RETURN areturn[4] + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MSETPAGE() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Set the display page for the mouse pointer + * $SYNTAX$ + * FT_MSETPAGE( <@nPage> ) -> NIL + * $ARGUMENTS$ + * is the desired display page. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * This function sets the display page for the mouse cursor. The valid + * values of nPage is dependent upon the display mode. See FT_SETVPG() + * for changing the current video page + * $EXAMPLES$ + * FT_MSETPAGE( 1 ) // Sets the mouse cursor to page 1 + * $SEEALSO$ + * FT_MGETPAGE() + * $END$ + */ + +FUNCTION FT_MSETPAGE(nPage) + +// Set up register +/* +aReg[AX] = 29 +aReg[BX]=nPage + +// Call interupt + +FT_INT86( 51, aReg) +*/ +_mset_page(nPage) +RETURN NIL + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MGETPAGE() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get the display page for the mouse pointer + * $SYNTAX$ + * FT_MGETPAGE() -> + * $ARGUMENTS$ + * None + * $RETURNS$ + * is the display page on which the mouse is currently being + * displayed + * $DESCRIPTION$ + * This function gets the display page for the mouse cursor. The valid + * values of nPage is dependent upon the display mode. See FT_SETVPG() + * for changing the current video page + * $EXAMPLES$ + * nPage = FT_MGETPAGE( ) // Gets the mouse cursor display page + * $SEEALSO$ + * FT_MSETPAGE() + * $END$ + */ + +FUNCTION FT_MGETPAGE(nPage) + + +// Set up register +/* +aReg[AX] = 30 + +// Call interupt + +FT_INT86( 51, aReg) +*/ +RETURN _mget_page() + + + + +FUNCTION FT_MINIT() + +* If not previously initialized then try + + IF !lMinit + lMinit=(FT_MRESET()!=0) + ELSE +* Reset maximum x and y limits + + FT_MYLIMIT(0,8*24) + FT_MXLIMIT(0,8*80) + ENDIF + + +RETURN lMinit + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MRESET() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Reset mouse driver and return status of mouse + * $SYNTAX$ + * FT_MRESET() -> nMouseStatus + * $ARGUMENTS$ + * NONE + * $RETURNS$ + * An integer representing the mouse status (0 == mouse not installed) + * $DESCRIPTION$ + * Resets the mouse driver and returns mouse status. Use FT_MSHOWCRS() + * to display the mouse cursor. The mouse is set to allow it to cover the + * complete screen (as defined by MAXCOL() and MAXROW()). This is necessary + * because at least some versions of the mouse drivers do not operate + * according to the documentation when confronted with a 43 or 50 line + * screen. + * + * Normally, FT_MINIT() should be used to initialize the mouse since it + * will not reinitialize if already done. + * $EXAMPLES$ + * IF Empty( FT_MRESET() ) + * ? "No mouse driver is installed" + * ENDIF + * $SEEALSO$ + * FT_MINIT() FT_MSHOWCRS() + * $END$ + */ + +FUNCTION FT_MRESET() +LOCAL lStatus +/* + aReg[AX] := 0 // set mouse function call 0 + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + lCrsState=.F. // Cursor is off after reset +lStatus:=_m_reset() +* Reset maximum x and y limits + + FT_MYLIMIT(0,8*MAXROW()) + FT_MXLIMIT(0,8*MAXCOL()) + +RETURN lStatus // return status code + + +/* $DOC$ + * $FUNCNAME$ + * FT_MCURSOR() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Set the mouse cursor + * $SYNTAX$ + * FT_MCURSOR( [ ] ) -> lCursorState + * $ARGUMENTS$ + * is a logical indicating whether to set the mouse cursor on. + * .T. - set mouse cursor on + * .F. - set mouse cursor off + * If omitted, no change is made to cursor state + * $RETURNS$ + * A logical indicating the previous mouse cursor state. + * $DESCRIPTION$ + * This function works like most Clipper state functions. If no value + * is sent to FT_MCURSOR() it will return the state of the mouse cursor. + * $EXAMPLES$ + * IF !( FT_MCURSOR() ) + * FT_MCURSOR( .T. ) + * ENDIF + * $END$ + */ + +FUNCTION FT_MCURSOR( lState ) + local lSavState := lCrsState + + if VALTYPE(lState)="L" + if ( lCrsState := lState ) + FT_MSHOWCRS() + else + FT_MHIDECRS() + endif + ENDIF + +RETURN lSavState + + +/* $DOC$ + * $FUNCNAME$ + * FT_MSHOWCRS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Increment internal cursor flag and display mouse cursor + * $SYNTAX$ + * FT_MSHOWCRS() -> NIL + * $ARGUMENTS$ + * NONE + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Displays the mouse cursor. Make sure to turn the mouse cursor off + * when redrawing screens. The mouse cursor dutifully saves the screen + * under it, so if you draw over the mouse cursor it will create a "hole" + * in your screen when you move the mouse cursor. + * + * Note: A call to FT_MHIDECRS() decrements a mouse driver variable + * which indicates whether the cursor is shown. The cursor is visible + * only when the variable = 0. Thus multiple calls to FT_MHIDECRS() + * require an equal number of calls to FT_MSHOWCRS() before the cursor + * will again be visible. Once the variable is 0 calls to FT_MSHOWCRS() + * does not increment the variable above 0. + * $EXAMPLES$ + * IF Empty( FT_MRESET() ) + * FT_MSHOWCRS() + * ENDIF + * $SEEALSO$ + * FT_MHIDECRS() FT_MCONOFF() + * $END$ + */ + +FUNCTION FT_MSHOWCRS() + /* + aReg[AX] := 1 // set mouse function call 1 + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + _mse_showcurs() + lCrsState := .t. + +RETURN NIL // no output from function + + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MHIDECRS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Decrement internal mouse cursor flag and hide mouse cursor + * $SYNTAX$ + * FT_MHIDECRS() -> NIL + * $ARGUMENTS$ + * NONE + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Hides the mouse cursor. Make sure to turn the mouse cursor off when + * redrawing screens. The mouse cursor dutifully saves the screen + * under it, so if you draw over the mouse cursor it will create a + * "hole" in your screen when you move the mouse cursor. + * + * Note: A call to FT_MHIDECRS() decrements a mouse driver variable + * which indicates whether the cursor is shown. The cursor is visible + * only when the variable = 0. Thus multiple calls to FT_MHIDECRS() + * require an equal number of calls to FT_MSHOWCRS() before the cursor + * will again be visible. Once the variable is 0 calls to FT_MSHOWCRS() + * does not increment the varaible above 0. + * $EXAMPLES$ + * FT_MHIDECRS() + * @ 10, 10 to 20, 20 + * FT_MSHOWCRS() + * $SEEALSO$ + * FT_MSHOWCRS() FT_MCONOFF() + * $END$ + */ + + + +FUNCTION FT_MHIDECRS() // decrement internal cursor flag and hide cursor +/* + aReg[AX] := 2 // set mouse function call 2 + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + _mse_mhidecrs() + lCrsState := .f. +RETURN NIL // no output from function + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MGETPOS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get mouse cursor position and button status + * $SYNTAX$ + * FT_MGETPOS( @, @ ) -> nButtonStatus + * $ARGUMENTS$ + * is a variable that will receive the mouse X position in virtual + * screen coordinates. It must be passed by reference. + * + * is a variable that will receive the mouse Y position in virtual + * screen coordinates. It must be passed by reference. + * $RETURNS$ + * an integer representing button status + * + * - 0 for no button pressed + * - 1 for left pressed + * - 2 for right pressed + * - 3 for left and right pressed + * - 4 for middle pressed + * - 5 for left and middle pressed + * - 6 for right and middle pressed + * - 7 for all three buttons pressed + * $DESCRIPTION$ + * Loads cursor position into x and y coordinates passed by reference and + * returns the button status. The coordinate system in text mode has + * eight virtual coordinates per character cell. Thus x=16 means that you + * are in the Row 2. The values returned by this routine when in text mode + * and with mouse driver versions 6 and above are multiples of 8. We have + * experience with drivers prior to that version + * $EXAMPLES$ + * LOCAL nX, nY + * LOCAL nButton := FT_MGETPOS( @nX, @nY ) + * ? "Mouse Row :", nX + * ? "Mouse Column :", nY + * ? "Button Status:", nButton + * $SEEALSO$ + * FT_MGETCOORD() FT_MSETPOS() FT_MDEFCRS() FT_MGETX() FT_MGETY() + * $END$ + */ + + + + +FUNCTION FT_MGETPOS( nX, nY ) + Local amse:={} + nX := if( nX == NIL, 0, nX ) + nY := if( nY == NIL, 0, nY ) +/* + aReg[AX] := 3 // set mouse function call 3 + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + amse:=_mse_getpos() + + nX := amse[1] // store new x-coordinate + nY := amse[2] // store new y-coordinate + +RETURN amse[3] // return button status + + + +/* $DOC$ + * $FUNCNAME$ + * FT_MGETX() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get mouse cursor row position + * $SYNTAX$ + * FT_MGETX() -> nRowPos + * $ARGUMENTS$ + * NONE + * $RETURNS$ + * which is the row position of mouse in virtual screen + * coordinates. + * $DESCRIPTION$ + * Retrieves mouse's row position in virtual screen coordinates. The + * values returned are multiples of 8 when in text mode and with at least + * Microsoft drivers 6 and above. + * $EXAMPLES$ + * ? FT_MGETX() + * $SEEALSO$ + * FT_MGETCOORD() FT_MDEFCRS() FT_MGETPOS() FT_MGETY() + * $END$ + */ + +FUNCTION FT_MGETX() + +* Duplicated code from FT_MGETPOS() for speed reasons +/* + aReg[AX] := 3 // set mouse function call 3 + FT_INT86( 51, aReg ) // execute mouse interrupt +*/ +RETURN( _m_getx()/8 ) // return x-coordinate + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MGETY() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get mouse cursor column position + * $SYNTAX$ + * FT_MGETY() -> nColPos + * $ARGUMENTS$ + * NONE + * $RETURNS$ + * Column position of mouse in virtual screen coordinates + * $DESCRIPTION$ + * Retrieves mouse's column position in virtual screen coordinates. The + * values returned are multiples of 8 when in text mode and with at least + * Microsoft drivers 6 and above. + * $EXAMPLES$ + * ? FT_MGETY() + * $SEEALSO$ + * FT_MGETCOORD() FT_MDEFCRS() FT_MGETPOS() FT_MGETX() + * $END$ + */ + +FUNCTION FT_MGETY() + +* Duplicated code from FT_MGETPOS() for speed reasons + /* + aReg[AX] := 3 // set mouse function call 3 + FT_INT86( 51, aReg ) // execute mouse interrupt + */ +RETURN( _m_gety()/8) // return y-coordinate + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MSETPOS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Position the mouse cursor using virtual screen coordinates + * $SYNTAX$ + * FT_MSETPOS( , ) -> NIL + * $ARGUMENTS$ + * is the desired mouse row. + * + * is the desired mouse column. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Positions mouse cursor on screen. The virtual coordinate system in text + * mode has eight virtual coordinates per character cell. Thus x=16 means + * that you are in the Row 2. + * $EXAMPLES$ + * FT_MSETPOS( 10, 20 ) // position mouse cursor at row 10, col 20 + * // in virtual screen coordinates + * $SEEALSO$ + * FT_MGETPOS() FT_MGETCOORD() FT_MSETCOORD() FT_MGETX() FT_MGETY() + * $END$ + */ + +FUNCTION FT_MSETPOS( nX, nY ) // set mouse cursor location +/* + aReg[AX] := 4 // set mouse function call 4 + aReg[CX] := nY // assign new x-coordinate + aReg[DX] := nX // assign new y-coordinate + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + _m_msetpos(nY,nX) +RETURN NIL // no function output + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MSETCOORD() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Position the mouse cursor using text screen coordinates + * $SYNTAX$ + * FT_MSETPOS( , ) -> NIL + * $ARGUMENTS$ + * is the desired mouse row. + * + * is the desired mouse column. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Positions mouse cursor on screen using text (normal row and column) + * coordinates. + * $EXAMPLES$ + * FT_MSETCOORD( 10, 20 ) // position mouse cursor at row 10, col 20 + * // in text screen coordinates + * $SEEALSO$ + * FT_MGETPOS() FT_MGETCOORD() FT_MSETPOS() FT_MDEFCRS() FT_MGETX() FT_MGETY() + * $END$ + */ + +FUNCTION FT_MSETCOORD( nX, nY ) // set mouse cursor location +/* + aReg[AX] := 4 // set mouse function call 4 + aReg[CX] := nY*8 // assign new x-coordinate + aReg[DX] := nX*8 // assign new y-coordinate + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + _m_MSETCOORD(nY*8,nX*8) +RETURN NIL // no function output + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MXLIMIT() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Set vertical bounds of mouse using virtual screen coord. + * $SYNTAX$ + * FT_MXLIMIT( , ) -> NIL + * $ARGUMENTS$ + * is the top row limit. + * + * is the bottom row limit. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Set maximum vertical bounds of mouse using virtual screen coordinates. + * $EXAMPLES$ + * FT_MXLIMIT( 10, 20 ) + * $SEEALSO$ + * FT_MYLIMIT() FT_MINREGION() + * $END$ + */ + +FUNCTION FT_MXLIMIT( nXMin, nXMax ) // set vertical minimum and maximum coordinates +/* + aReg[AX] = 7 // set mouse function call 7 + aReg[CX] = nXMin // load vertical minimum parameter + aReg[DX] = nXMax // load vertical maximum parameter + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + _m_mxlimit(nXMin,nXMAX) +RETURN NIL + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MYLIMIT() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Set horiz. bounds of mouse using virtual screen coordinates + * $SYNTAX$ + * FT_MYLIMIT( , ) -> NIL + * $ARGUMENTS$ + * is the left column limit. + * + * is the right column limit. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Set maximum horizontal bounds of mouse using virtual screen coordinates. + * $EXAMPLES$ + * FT_MYLIMIT( 10, 20 ) + * $SEEALSO$ + * FT_MXLIMIT() FT_MINREGION() + * $END$ + */ + +FUNCTION FT_MYLIMIT( nYMin, nYMax ) // set horizontal minimum and maximum coordinates +/* + aReg[AX] = 8 // set mouse function call 8 + aReg[CX] = nYMin // load horz minimum parameter + aReg[DX] = nYMax // load horz maximum parameter + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + _m_mYlimit(nYMin,nYMAX) +RETURN NIL // no function output + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MBUTPRS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Retrieve button press status + * $SYNTAX$ + * FT_MBUTPRS( [, @nButPrs [, @nX [, @nY] ] ] ) -> nButStatus + * $ARGUMENTS$ + * is the mouse button number: + * + * 0 - Left Button + * 1 - Right Button + * 2 - Middle Button [if applicable] + * + * is the number of times the specified button was pressed + * since the last call to this routine. PASSED BY REFERENCE. + * is the X position of the cursor when the last press occurred. + * PASSED BY REFERENCE. + * is the Y position of the cursor when the last press occurred. + * PASSED BY REFERENCE. + * + * $RETURNS$ + * An integer representing the button status: + * + * 0 - no buttons pressed + * 1 - left button pressed + * 2 - right button pressed + * 3 - left and right pressed + * 4 - middle pressed + * 5 - left and middle pressed + * 6 - middle and right buttons pressed + * 7 - all 3 buttons pressed + * $DESCRIPTION$ + * Retrieves the mouse button status and the position of the cursor when + * a button was last pressed. + * $EXAMPLES$ + * IF Empty( FT_MBUTPRS(1) ) + * ? "No Item selected" + * ENDIF + * $SEEALSO$ + * FT_MBUTREL() FT_MDBLCLK() + * $END$ + */ + +FUNCTION FT_MBUTPRS( nButton, nButPrs, nX, nY ) // get button press information +local aReg:={} +/* + aReg[AX] := 5 // set mouse function call 5 + aReg[BX] := nButton // pass parameter for left or right button + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + nButPrs := aReg[1] // store updated press count + nX := aReg[2] // x-coordinate at last press + nY := aReg[3] // y-coordinate at last press + +_m_MBUTPRS(nButton) +RETURN aReg[4] // return button status + +/* $DOC$ + * $FUNCNAME$ + * FT_MBUTREL() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get mouse button release information + * $SYNTAX$ + * FT_MBUTREL( nButton [, @nButRel [, @nX [, @nY] ] ]) -> nBStat + * $ARGUMENTS$ + * is the mouse button number + * 0 - Left Button + * 1 - Right Button + * 2 - Middle Button [if applicable] + * + * is the number of times the specified button was released + * since the last call to this routine. PASSED BY REFERENCE. + * + * is the X position of the cursor when the last release occurred. + * PASSED BY REFERENCE. + * + * is the Y position of the cursor when the last release occurred. + * PASSED BY REFERENCE. + * $RETURNS$ + * - an integer representing button release status + * 0 - None + * 1 - Left + * 2 - Right + * 3 - Middle + * $DESCRIPTION$ + * This function returns the release status of the mouse buttons and the + * coordinates of the last release. + * $EXAMPLES$ + * IF( FT_MBUTREL( 0 ) == 1 ) + * ? "Left button released" + * ENDIF + * $SEEALSO$ + * FT_MBUTPRS() FT_MDBLCLK() + * $END$ + */ + + + +FUNCTION FT_MBUTREL( nButton, nButRel, nX, nY ) // get button release information +local areg:={} +Local iButton + areg:=_m_MBUTREL(nButton) + nButRel := aReg[1] // store updated release count + nX := aReg[2] // x-coordinate at last release + nY := aReg[3] // y-coordinate at last release + iButton:= aReg[4] // return button status + +RETURN iButton + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MDEFCRS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Define the mouse cursor + * $SYNTAX$ + * FT_MDEFCRS( , , ) -> NIL + * $ARGUMENTS$ + * is the cursor type. A value of 0 indicates the software cursor + * (the default) and a value of 1 indicates the hardware cursor. + * + * is the screen mask for the software cursor or the first scan + * line of the hardware cursor. See the description for more + * information. + * + * is the cursor mask for the software cursor of the last scan + * line of the hardware cursor. See the description for more + * information. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * In text mode the mouse cursor can either be a software generated or + * the actual hardware cursor. This routine allows one choose between them. + * The software cursor is the default and its effect on the character it + * covers is determined by the screen mask and the cursor mask. Both of + * these masks are 16 bit values (which in Clipper are passed as standard + * numerical values). The 16 bit masks are arranged in a manner identical + * to the way information is stored for each character cell on the screen. + * The low order 8 bits represent the actual character displayed while the + * high order bits represent the display atributes such as blinking, + * intensity and forground and background colors. The mask is represented in + * the diagram below: + * + * Bit: �15 �14 12�11 �10 8�7 0� + * Function:쿫link 쿫ackground쿶ntensity쿯oreground쿬haracter� + * + * Blinking and high intensity are on when the bit is 1. The background and + * foreground indicate which colors are used for each. The software mouse + * cursor uses these two values by taking the mask from the screen cell it + * is on and performing a logical AND on each bit with the screen mask + * value. The result is then logically XOR'ed with the cursor mask value. + * Thus to keep the character the same but invert the foreground and + * background colors the following values would be used: + * + * Bit: �15 �14 12�11 �10 8�7 0� + * Function:쿫link 쿫ackground쿶ntensity쿯oreground쿬haracter� + * screen: � 0 � 111 � 0 � 111 �11111111 � =30719 + * cursor: � 0 � 111 � 0 � 111 �00000000 � =30464 + * + * The hardware cursor is the text cursor provided by the video board. One + * specifies the range of scan lines which are on using and + * . The range of values is dependant upon the type of monitor. + * The first scan line is 0. + * $END$ + */ + +FUNCTION FT_MDEFCRS( nCurType, nScrMask, nCurMask ) // define text cursor type and masks +/* + aReg[AX] = 10 // set mouse function call 10 + aReg[BX] = nCurType // load cursor type parameter + aReg[CX] = nScrMask // load screen mask value + aReg[DX] = nCurMask // load cursor mask value + FT_INT86( 51, aReg ) // execute mouse interrupt + */ +_m_mdefcrs(nCurType, nScrMask, nCurMask ) +RETURN NIL // no function output + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MGETCOORD() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get mouse cursor position (text coord.) and button status + * $SYNTAX$ + * FT_MGETPOS( @, @ ) -> nButtonStatus + * $ARGUMENTS$ + * is a variable that will receive the mouse X position in text + * screen coordinates. It must be passed by reference. + * + * is a variable that will receive the mouse Y position in text + * screen coordinates. It must be passed by reference. + * $RETURNS$ + * an integer representing button status + * + * - 0 for no button pressed + * - 1 for left pressed + * - 2 for right pressed + * - 3 for left and right pressed + * - 4 for middle pressed + * - 5 for left and middle pressed + * - 6 for right and middle pressed + * - 7 for all three buttons pressed + * $DESCRIPTION$ + * Loads cursor position into x and y coordinates passed by reference and + * returns the button status. + * $EXAMPLES$ + * LOCAL nX, nY + * LOCAL nButton := FT_MGETCOORD( @nX, @nY ) + * ? "Mouse Row :", nX + * ? "Mouse Column :", nY + * ? "Button Status:", nButton + * $SEEALSO$ + * FT_MGETPOS() FT_MSETPOS() FT_MDEFCRS() FT_MGETX() FT_MGETY() + * $END$ + */ + +FUNCTION FT_MGETCOORD( nX, nY ) + +* Duplicated code from FT_MGETPOS() for speed reasons +local aReg:={} +local iButton + nX := if( nX == NIL, 0, nX ) + nY := if( nY == NIL, 0, nY ) + /* + aReg[AX] := 3 // set mouse function call 3 + FT_INT86( 51, aReg ) // execute mouse interrupt + */ + areg:=_m_mgetcoord() + nX := INT(aReg[1]/8) // store new x-coordinate + nY := INT(aReg[2]/8) // store new y-coordinate + iButton:= aReg[3] // return button status + +RETURN iButton + diff --git a/harbour/contrib/libnf/mouse2.prg b/harbour/contrib/libnf/mouse2.prg new file mode 100644 index 0000000000..c9e235e5f9 --- /dev/null +++ b/harbour/contrib/libnf/mouse2.prg @@ -0,0 +1,1003 @@ +/* + * File......: MOUSE1.PRG + * Author....: Leo Letendre + * CIS ID....: 73607,233 + * + * This is an original work by Robert DiFalco and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.9 17 Oct 1992 16:28:58 GLENN + * Leo cleaned up documentation blocks. + * + * Rev 1.8 28 Sep 1992 01:38:14 GLENN + * Leo added FT_MGETSENS(), FT_MSETSENS(), FT_MSETPAGE(), FT_MGETPAGE(), + * and FT_MVERSION(). + * + * + * Rev 1.7 01 Jul 1992 01:45:18 GLENN + * Leo added documentation to FT_MDEFCRS and others. Added FT_MCONOFF(), + * FT_MINIT(), FT_MGETCOORD() and FT_MSETCOORD(). Restructured + * FT_MGETX() and FT_MGETY() for possible speed improvement and MAIN to + * better demonstrate some of the concerns when programming the mouse. + * Added ability to change the number of rows and columns to demonstrate + * use in 43, 50 row mode etc. which is now supported in FT_MRESET() and + * FT_MINIT(). + * + * Rev 1.6 23 Sep 1991 01:14:38 GLENN + * Corrected errors in syntax documention for FT_MBUTPRS() and FT_MDBLCLK(), + * found by Nantucket's Steve Silverwood. + * + * Rev 1.5 17 Aug 1991 15:34:52 GLENN + * Don Caton fixed some spelling errors in the doc + * + * Rev 1.4 15 Aug 1991 23:06:24 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.3 17 Jul 1991 22:28:40 GLENN + * Leo fixed a potential bug in ft_mcursor(). + * + * Rev 1.2 27 May 1991 13:40:30 GLENN + * Leo Letendre sent me a revision of MOUSE1.PRG where he built in support + * for a three-button mouse, and revised the "double click" detection + * algorithm. + * + * Brought in compliance with new ft_int86(). + * + * Rev 1.1 11 May 1991 00:16:48 GLENN + * ft_mgetpos() had a bug where the x and y coordinates were reversed. + * Changed x coordinate to aRegs[3] and y coordinate to aRegs[4], just + * like in ft_msetpos(). + * + * Rev 1.0 01 Apr 1991 01:01:48 GLENN + * Nanforum Toolkit + * + */ + + +// The original mouse routines were written by Robert diFalco but +// Leo Letendre has made such major additions and modifications +// and fixes that I've given him sole credit. -- G. Scott + + +#include "FTINT86.CH" + +static aReg[10] +static lCrsState:=.F. +static lMinit:=.F. + +#ifdef FT_TEST + + FUNCTION MAIN(nRow,nCol) + +* Pass valid row and column values for different video modes to change modes + + local nX, nY, cSavClr + local cSavScr := savescreen( 0, 0, maxrow(), maxcol() ) + local nXm, nYm + local nSaveRow:=MAXROW()+1, nSaveCol:=MAXCOL()+1 + local nMinor, nType, nIRQ + local aType:={"Bus","Serial","InPort","PS/2","HP"} + local nHoriz, nVert, nDouble + local nTime + + IF nRow=NIL + nRow=MAXROW()+1 + ELSE + nRow=VAL(nRow) + ENDIF + + IF nCol=NIL + nCol=MAXCOL()+1 + ELSE + nCol=VAL(nCol) + ENDIF + + IF .NOT.SETMODE(nRow,nCol) + @maxrow(),0 SAY "Mode Change unsuccessful:"+STR(nRow,2,0)+" by"; + +STR(nCol,3,0) + RETURN NIL + ENDIF + + if empty( FT_MINIT() ) + @ maxrow(), 0 say "Mouse driver is not installed!" + SETMODE(nSaveRow,nSaveCol) + return "" + endif + + * ..... Set up the screen + cSavClr := setcolor( "w/n" ) + @ 0,0,maxrow(),maxcol() box "같같같같�" + + setcolor( "GR+/RB" ) + scroll( 7,2,19,63,0 ) + @ 7,2 to 20,63 + + @ 17, 10 to 19, 40 double + + setcolor( "N/W" ) + @ 18, 11 say " Double Click here to Quit " + + setcolor( "GR+/RB" ) + + * ..... Start the demo + + @MAXROW(),0 SAY "Driver version: "+; + ALLTRIM(STR(FT_MVERSION(@nMinor,@nType,@nIRQ),2,0))+"."+; + ALLTRIM(STR(nMinor,2,0)) + @ ROW(),COL() SAY " "+aType[nType]+" mouse using IRQ "+STR(nIRQ,1,0) + + FT_MGETSENS(@nHoriz,@nVert,@nDouble) // Get the current sensitivities + FT_MSETSENS(70,70,60) // Bump up the sensitivity of the mouse + + FT_MSHOWCRS() + FT_MSETCOORD(10,20) // just an arbitrary place for demo + +* put the unchanging stuff + + devpos( 9, 10 ) + devout( "FT_MMICKEYS :" ) + + devpos( 10, 10 ) + devout( "FT_MGETPOS :" ) + + devpos( 11, 10 ) + devout( "FT_MGETX :" ) + + devpos( 12, 10 ) + devout( "FT_MGETY :") + + devpos( 13, 10 ) + devout( "FT_MGETCOORD:" ) + + devpos( 14, 10 ) + devout( "FT_MBUTPRS :" ) + + devpos( 16, 10 ) + devout( "FT_MBUTREL :" ) + + nX := nY := 1 + do while .t. + +* If we are not moving then wait for movement. +* This whole demo is a bit artificial in its requirements when compared +* to a "normal" CLIPPER program so some of these examples are a bit out of +* the ordinary. + + DO WHILE nX=0.AND.nY=0 + FT_MMICKEYS( @nX, @nY ) + ENDDO +* tell the mouse driver where updates will be taking place so it can hide +* the cursor when necessary. + + FT_MCONOFF( 9, 23, 16, 53 ) + nTime=-1 + + devpos( 9, 23 ) + devout( nX ) + devout( nY ) + + devpos( 10, 23 ) + DEVOUT( FT_MGETPOS( @nX, @nY ) ) + devout( nX ) + devout( nY ) + + devpos( 11, 23 ) + DEVOUT( FT_MGETX() ) + + devpos( 12, 23 ) + DEVOUT( FT_MGETY() ) + + devpos( 13, 23 ) + devout( FT_MGETCOORD( @nX, @nY ) ) + devout ( nX ) + devout ( nY ) + + nX:=nY:=0 + devpos( 14, 23 ) + DEVOUT( FT_MBUTPRS(1) ) + DEVOUT( FT_MBUTPRS(0,, nX, nY) ) + devpos( 15, 23 ) + +* show only the last Press since it flashes by so quickly + + IF nX!=0.OR.nY!=0 + devout( nX ) + devout( nY ) + endif + + nX:=nY:=0 + devpos( 16, 23 ) + devout( FT_MBUTREL(0,, @nX, @nY) ) + +* show only the last release since it flashes by so quickly + + if nX!=0.OR.nY!=0 + devout( nX ) + devout( nY ) + endif + +* Restore the cursor if it has been hidden + + FT_MSHOWCRS() + + if FT_MINREGION( 18, 11, 18, 39 ) + +* Change the type of cursor when in the box. Just slightly different than the +* normal. The character is shown in high intensity. + + FT_MDEFCRS(0,32767,32512) + if FT_MDBLCLK(2,0,0.8) + exit + endif + endif + + if FT_MINREGION( 18, 11, 18, 39 ) + +* Change the type of cursor when in the box. Just slightly different than the +* normal. The character is shown in high intensity. + + FT_MDEFCRS(0,32767,32512) + else + +* Put the cursor back to normal mode + + FT_MDEFCRS(0,30719,30464) + endif + + FT_MMICKEYS( @nX, @nY ) + enddo + + FT_MHIDECRS() + + SETMODE(nSaveRow,nSaveCol) + setcolor( cSavClr ) + restscreen( 0, 0, maxrow(), maxcol(), cSavScr ) + devpos( maxrow(), 0 ) + +// Reset sensitivity + + FT_MSETSENS(nHoriz, nVert, nDouble) + + RETURN nil + + +#endif + + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MINIT() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Initialize the mouse driver, vars and return status of mouse + * $SYNTAX$ + * FT_MINIT() -> lMouseStatus + * $ARGUMENTS$ + * NONE + * $RETURNS$ + * An logical representing the mouse status (.F. == mouse not installed) + * $DESCRIPTION$ + * Initializes the mouse drive, associated variables and returns mouse + * status. It checks to see if the mouse has been previously initialized + * and if so it does not reinitialize. The row and column limits of mouse + * movement is set to the maximum for the current video mode. + * Use FT_MSHOWCRS() to display the mouse cursor. + * $EXAMPLES$ + * IF .NOT. FT_MINIT() + * ? "No mouse driver is installed" + * ENDIF + * $SEEALSO$ + * FT_MRESET() + * $END$ + */ + +FUNCTION FT_MINIT() + +* If not previously initialized then try + + IF !lMinit + lMinit=(FT_MRESET()!=0) + ELSE +* Reset maximum x and y limits + + FT_MYLIMIT(0,8*MAXROW()) + FT_MXLIMIT(0,8*MAXCOL()) + ENDIF + + +RETURN lMinit + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MRESET() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Reset mouse driver and return status of mouse + * $SYNTAX$ + * FT_MRESET() -> nMouseStatus + * $ARGUMENTS$ + * NONE + * $RETURNS$ + * An integer representing the mouse status (0 == mouse not installed) + * $DESCRIPTION$ + * Resets the mouse driver and returns mouse status. Use FT_MSHOWCRS() + * to display the mouse cursor. The mouse is set to allow it to cover the + * complete screen (as defined by MAXCOL() and MAXROW()). This is necessary + * because at least some versions of the mouse drivers do not operate + * according to the documentation when confronted with a 43 or 50 line + * screen. + * + * Normally, FT_MINIT() should be used to initialize the mouse since it + * will not reinitialize if already done. + * $EXAMPLES$ + * IF Empty( FT_MRESET() ) + * ? "No mouse driver is installed" + * ENDIF + * $SEEALSO$ + * FT_MINIT() FT_MSHOWCRS() + * $END$ + */ + +FUNCTION FT_MRESET() + + aReg[AX] := 0 // set mouse function call 0 + FT_INT86( 51, aReg ) // execute mouse interrupt + lCrsState=.F. // Cursor is off after reset + +* Reset maximum x and y limits + + FT_MYLIMIT(0,8*MAXROW()) + FT_MXLIMIT(0,8*MAXCOL()) + +RETURN aReg[AX] // return status code + + +/* $DOC$ + * $FUNCNAME$ + * FT_MCURSOR() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Set the mouse cursor + * $SYNTAX$ + * FT_MCURSOR( [ ] ) -> lCursorState + * $ARGUMENTS$ + * is a logical indicating whether to set the mouse cursor on. + * .T. - set mouse cursor on + * .F. - set mouse cursor off + * If omitted, no change is made to cursor state + * $RETURNS$ + * A logical indicating the previous mouse cursor state. + * $DESCRIPTION$ + * This function works like most Clipper state functions. If no value + * is sent to FT_MCURSOR() it will return the state of the mouse cursor. + * $EXAMPLES$ + * IF !( FT_MCURSOR() ) + * FT_MCURSOR( .T. ) + * ENDIF + * $END$ + */ + +FUNCTION FT_MCURSOR( lState ) + local lSavState := lCrsState + + if VALTYPE(lState)="L" + if ( lCrsState := lState ) + FT_MSHOWCRS() + else + FT_MHIDECRS() + endif + ENDIF + +RETURN lSavState + + +/* $DOC$ + * $FUNCNAME$ + * FT_MSHOWCRS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Increment internal cursor flag and display mouse cursor + * $SYNTAX$ + * FT_MSHOWCRS() -> NIL + * $ARGUMENTS$ + * NONE + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Displays the mouse cursor. Make sure to turn the mouse cursor off + * when redrawing screens. The mouse cursor dutifully saves the screen + * under it, so if you draw over the mouse cursor it will create a "hole" + * in your screen when you move the mouse cursor. + * + * Note: A call to FT_MHIDECRS() decrements a mouse driver variable + * which indicates whether the cursor is shown. The cursor is visible + * only when the variable = 0. Thus multiple calls to FT_MHIDECRS() + * require an equal number of calls to FT_MSHOWCRS() before the cursor + * will again be visible. Once the variable is 0 calls to FT_MSHOWCRS() + * does not increment the variable above 0. + * $EXAMPLES$ + * IF Empty( FT_MRESET() ) + * FT_MSHOWCRS() + * ENDIF + * $SEEALSO$ + * FT_MHIDECRS() FT_MCONOFF() + * $END$ + */ + +FUNCTION FT_MSHOWCRS() + + aReg[AX] := 1 // set mouse function call 1 + FT_INT86( 51, aReg ) // execute mouse interrupt + lCrsState := .t. + +RETURN NIL // no output from function + + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MHIDECRS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Decrement internal mouse cursor flag and hide mouse cursor + * $SYNTAX$ + * FT_MHIDECRS() -> NIL + * $ARGUMENTS$ + * NONE + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Hides the mouse cursor. Make sure to turn the mouse cursor off when + * redrawing screens. The mouse cursor dutifully saves the screen + * under it, so if you draw over the mouse cursor it will create a + * "hole" in your screen when you move the mouse cursor. + * + * Note: A call to FT_MHIDECRS() decrements a mouse driver variable + * which indicates whether the cursor is shown. The cursor is visible + * only when the variable = 0. Thus multiple calls to FT_MHIDECRS() + * require an equal number of calls to FT_MSHOWCRS() before the cursor + * will again be visible. Once the variable is 0 calls to FT_MSHOWCRS() + * does not increment the varaible above 0. + * $EXAMPLES$ + * FT_MHIDECRS() + * @ 10, 10 to 20, 20 + * FT_MSHOWCRS() + * $SEEALSO$ + * FT_MSHOWCRS() FT_MCONOFF() + * $END$ + */ + + + +FUNCTION FT_MHIDECRS() // decrement internal cursor flag and hide cursor + + aReg[AX] := 2 // set mouse function call 2 + FT_INT86( 51, aReg ) // execute mouse interrupt + lCrsState := .f. +RETURN NIL // no output from function + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MGETPOS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get mouse cursor position and button status + * $SYNTAX$ + * FT_MGETPOS( @, @ ) -> nButtonStatus + * $ARGUMENTS$ + * is a variable that will receive the mouse X position in virtual + * screen coordinates. It must be passed by reference. + * + * is a variable that will receive the mouse Y position in virtual + * screen coordinates. It must be passed by reference. + * $RETURNS$ + * an integer representing button status + * + * - 0 for no button pressed + * - 1 for left pressed + * - 2 for right pressed + * - 3 for left and right pressed + * - 4 for middle pressed + * - 5 for left and middle pressed + * - 6 for right and middle pressed + * - 7 for all three buttons pressed + * $DESCRIPTION$ + * Loads cursor position into x and y coordinates passed by reference and + * returns the button status. The coordinate system in text mode has + * eight virtual coordinates per character cell. Thus x=16 means that you + * are in the Row 2. The values returned by this routine when in text mode + * and with mouse driver versions 6 and above are multiples of 8. We have + * experience with drivers prior to that version + * $EXAMPLES$ + * LOCAL nX, nY + * LOCAL nButton := FT_MGETPOS( @nX, @nY ) + * ? "Mouse Row :", nX + * ? "Mouse Column :", nY + * ? "Button Status:", nButton + * $SEEALSO$ + * FT_MGETCOORD() FT_MSETPOS() FT_MDEFCRS() FT_MGETX() FT_MGETY() + * $END$ + */ + + + + +FUNCTION FT_MGETPOS( nX, nY ) + + nX := if( nX == NIL, 0, nX ) + nY := if( nY == NIL, 0, nY ) + + aReg[AX] := 3 // set mouse function call 3 + FT_INT86( 51, aReg ) // execute mouse interrupt + nX := aReg[DX] // store new x-coordinate + nY := aReg[CX] // store new y-coordinate + +RETURN aReg[BX] // return button status + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MGETCOORD() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get mouse cursor position (text coord.) and button status + * $SYNTAX$ + * FT_MGETPOS( @, @ ) -> nButtonStatus + * $ARGUMENTS$ + * is a variable that will receive the mouse X position in text + * screen coordinates. It must be passed by reference. + * + * is a variable that will receive the mouse Y position in text + * screen coordinates. It must be passed by reference. + * $RETURNS$ + * an integer representing button status + * + * - 0 for no button pressed + * - 1 for left pressed + * - 2 for right pressed + * - 3 for left and right pressed + * - 4 for middle pressed + * - 5 for left and middle pressed + * - 6 for right and middle pressed + * - 7 for all three buttons pressed + * $DESCRIPTION$ + * Loads cursor position into x and y coordinates passed by reference and + * returns the button status. + * $EXAMPLES$ + * LOCAL nX, nY + * LOCAL nButton := FT_MGETCOORD( @nX, @nY ) + * ? "Mouse Row :", nX + * ? "Mouse Column :", nY + * ? "Button Status:", nButton + * $SEEALSO$ + * FT_MGETPOS() FT_MSETPOS() FT_MDEFCRS() FT_MGETX() FT_MGETY() + * $END$ + */ + +FUNCTION FT_MGETCOORD( nX, nY ) + +* Duplicated code from FT_MGETPOS() for speed reasons + + nX := if( nX == NIL, 0, nX ) + nY := if( nY == NIL, 0, nY ) + + aReg[AX] := 3 // set mouse function call 3 + FT_INT86( 51, aReg ) // execute mouse interrupt + nX := INT(aReg[DX]/8) // store new x-coordinate + nY := INT(aReg[CX]/8) // store new y-coordinate + +RETURN aReg[BX] // return button status + + +/* $DOC$ + * $FUNCNAME$ + * FT_MGETX() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get mouse cursor row position + * $SYNTAX$ + * FT_MGETX() -> nRowPos + * $ARGUMENTS$ + * NONE + * $RETURNS$ + * which is the row position of mouse in virtual screen + * coordinates. + * $DESCRIPTION$ + * Retrieves mouse's row position in virtual screen coordinates. The + * values returned are multiples of 8 when in text mode and with at least + * Microsoft drivers 6 and above. + * $EXAMPLES$ + * ? FT_MGETX() + * $SEEALSO$ + * FT_MGETCOORD() FT_MDEFCRS() FT_MGETPOS() FT_MGETY() + * $END$ + */ + +FUNCTION FT_MGETX() + +* Duplicated code from FT_MGETPOS() for speed reasons + + aReg[AX] := 3 // set mouse function call 3 + FT_INT86( 51, aReg ) // execute mouse interrupt + +RETURN( INT(aReg[DX]/8) ) // return x-coordinate + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MGETY() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get mouse cursor column position + * $SYNTAX$ + * FT_MGETY() -> nColPos + * $ARGUMENTS$ + * NONE + * $RETURNS$ + * Column position of mouse in virtual screen coordinates + * $DESCRIPTION$ + * Retrieves mouse's column position in virtual screen coordinates. The + * values returned are multiples of 8 when in text mode and with at least + * Microsoft drivers 6 and above. + * $EXAMPLES$ + * ? FT_MGETY() + * $SEEALSO$ + * FT_MGETCOORD() FT_MDEFCRS() FT_MGETPOS() FT_MGETX() + * $END$ + */ + +FUNCTION FT_MGETY() + +* Duplicated code from FT_MGETPOS() for speed reasons + + aReg[AX] := 3 // set mouse function call 3 + FT_INT86( 51, aReg ) // execute mouse interrupt + +RETURN( INT(aReg[CX]/8)) // return y-coordinate + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MSETPOS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Position the mouse cursor using virtual screen coordinates + * $SYNTAX$ + * FT_MSETPOS( , ) -> NIL + * $ARGUMENTS$ + * is the desired mouse row. + * + * is the desired mouse column. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Positions mouse cursor on screen. The virtual coordinate system in text + * mode has eight virtual coordinates per character cell. Thus x=16 means + * that you are in the Row 2. + * $EXAMPLES$ + * FT_MSETPOS( 10, 20 ) // position mouse cursor at row 10, col 20 + * // in virtual screen coordinates + * $SEEALSO$ + * FT_MGETPOS() FT_MGETCOORD() FT_MSETCOORD() FT_MGETX() FT_MGETY() + * $END$ + */ + +FUNCTION FT_MSETPOS( nX, nY ) // set mouse cursor location + + aReg[AX] := 4 // set mouse function call 4 + aReg[CX] := nY // assign new x-coordinate + aReg[DX] := nX // assign new y-coordinate + FT_INT86( 51, aReg ) // execute mouse interrupt + +RETURN NIL // no function output + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MSETCOORD() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Position the mouse cursor using text screen coordinates + * $SYNTAX$ + * FT_MSETPOS( , ) -> NIL + * $ARGUMENTS$ + * is the desired mouse row. + * + * is the desired mouse column. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Positions mouse cursor on screen using text (normal row and column) + * coordinates. + * $EXAMPLES$ + * FT_MSETCOORD( 10, 20 ) // position mouse cursor at row 10, col 20 + * // in text screen coordinates + * $SEEALSO$ + * FT_MGETPOS() FT_MGETCOORD() FT_MSETPOS() FT_MDEFCRS() FT_MGETX() FT_MGETY() + * $END$ + */ + +FUNCTION FT_MSETCOORD( nX, nY ) // set mouse cursor location + + aReg[AX] := 4 // set mouse function call 4 + aReg[CX] := nY*8 // assign new x-coordinate + aReg[DX] := nX*8 // assign new y-coordinate + FT_INT86( 51, aReg ) // execute mouse interrupt + +RETURN NIL // no function output + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MXLIMIT() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Set vertical bounds of mouse using virtual screen coord. + * $SYNTAX$ + * FT_MXLIMIT( , ) -> NIL + * $ARGUMENTS$ + * is the top row limit. + * + * is the bottom row limit. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Set maximum vertical bounds of mouse using virtual screen coordinates. + * $EXAMPLES$ + * FT_MXLIMIT( 10, 20 ) + * $SEEALSO$ + * FT_MYLIMIT() FT_MINREGION() + * $END$ + */ + +FUNCTION FT_MXLIMIT( nXMin, nXMax ) // set vertical minimum and maximum coordinates + + aReg[AX] = 7 // set mouse function call 7 + aReg[CX] = nXMin // load vertical minimum parameter + aReg[DX] = nXMax // load vertical maximum parameter + FT_INT86( 51, aReg ) // execute mouse interrupt + +RETURN NIL + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MYLIMIT() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Set horiz. bounds of mouse using virtual screen coordinates + * $SYNTAX$ + * FT_MYLIMIT( , ) -> NIL + * $ARGUMENTS$ + * is the left column limit. + * + * is the right column limit. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Set maximum horizontal bounds of mouse using virtual screen coordinates. + * $EXAMPLES$ + * FT_MYLIMIT( 10, 20 ) + * $SEEALSO$ + * FT_MXLIMIT() FT_MINREGION() + * $END$ + */ + +FUNCTION FT_MYLIMIT( nYMin, nYMax ) // set horizontal minimum and maximum coordinates + + aReg[AX] = 8 // set mouse function call 8 + aReg[CX] = nYMin // load horz minimum parameter + aReg[DX] = nYMax // load horz maximum parameter + FT_INT86( 51, aReg ) // execute mouse interrupt + +RETURN NIL // no function output + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MBUTPRS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Retrieve button press status + * $SYNTAX$ + * FT_MBUTPRS( [, @nButPrs [, @nX [, @nY] ] ] ) -> nButStatus + * $ARGUMENTS$ + * is the mouse button number: + * + * 0 - Left Button + * 1 - Right Button + * 2 - Middle Button [if applicable] + * + * is the number of times the specified button was pressed + * since the last call to this routine. PASSED BY REFERENCE. + * is the X position of the cursor when the last press occurred. + * PASSED BY REFERENCE. + * is the Y position of the cursor when the last press occurred. + * PASSED BY REFERENCE. + * + * $RETURNS$ + * An integer representing the button status: + * + * 0 - no buttons pressed + * 1 - left button pressed + * 2 - right button pressed + * 3 - left and right pressed + * 4 - middle pressed + * 5 - left and middle pressed + * 6 - middle and right buttons pressed + * 7 - all 3 buttons pressed + * $DESCRIPTION$ + * Retrieves the mouse button status and the position of the cursor when + * a button was last pressed. + * $EXAMPLES$ + * IF Empty( FT_MBUTPRS(1) ) + * ? "No Item selected" + * ENDIF + * $SEEALSO$ + * FT_MBUTREL() FT_MDBLCLK() + * $END$ + */ + +FUNCTION FT_MBUTPRS( nButton, nButPrs, nX, nY ) // get button press information + + aReg[AX] := 5 // set mouse function call 5 + aReg[BX] := nButton // pass parameter for left or right button + FT_INT86( 51, aReg ) // execute mouse interrupt + nButPrs := aReg[BX] // store updated press count + nX := aReg[DX] // x-coordinate at last press + nY := aReg[CX] // y-coordinate at last press + +RETURN aReg[AX] // return button status + + + +/* $DOC$ + * $FUNCNAME$ + * FT_MBUTREL() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Get mouse button release information + * $SYNTAX$ + * FT_MBUTREL( nButton [, @nButRel [, @nX [, @nY] ] ]) -> nBStat + * $ARGUMENTS$ + * is the mouse button number + * 0 - Left Button + * 1 - Right Button + * 2 - Middle Button [if applicable] + * + * is the number of times the specified button was released + * since the last call to this routine. PASSED BY REFERENCE. + * + * is the X position of the cursor when the last release occurred. + * PASSED BY REFERENCE. + * + * is the Y position of the cursor when the last release occurred. + * PASSED BY REFERENCE. + * $RETURNS$ + * - an integer representing button release status + * 0 - None + * 1 - Left + * 2 - Right + * 3 - Middle + * $DESCRIPTION$ + * This function returns the release status of the mouse buttons and the + * coordinates of the last release. + * $EXAMPLES$ + * IF( FT_MBUTREL( 0 ) == 1 ) + * ? "Left button released" + * ENDIF + * $SEEALSO$ + * FT_MBUTPRS() FT_MDBLCLK() + * $END$ + */ + + + +FUNCTION FT_MBUTREL( nButton, nButRel, nX, nY ) // get button release information + + aReg[AX] := 6 // set mouse function call 6 + aReg[BX] := nButton // pass parameter for left or right button + FT_INT86( 51, aReg ) // execute mouse interrupt + nButRel := aReg[BX] // store updated release count + nX := aReg[DX] // x-coordinate at last release + nY := aReg[CX] // y-coordinate at last release + +RETURN aReg[AX] // return button status + + +/* + * $DOC$ + * $FUNCNAME$ + * FT_MDEFCRS() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Define the mouse cursor + * $SYNTAX$ + * FT_MDEFCRS( , , ) -> NIL + * $ARGUMENTS$ + * is the cursor type. A value of 0 indicates the software cursor + * (the default) and a value of 1 indicates the hardware cursor. + * + * is the screen mask for the software cursor or the first scan + * line of the hardware cursor. See the description for more + * information. + * + * is the cursor mask for the software cursor of the last scan + * line of the hardware cursor. See the description for more + * information. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * In text mode the mouse cursor can either be a software generated or + * the actual hardware cursor. This routine allows one choose between them. + * The software cursor is the default and its effect on the character it + * covers is determined by the screen mask and the cursor mask. Both of + * these masks are 16 bit values (which in Clipper are passed as standard + * numerical values). The 16 bit masks are arranged in a manner identical + * to the way information is stored for each character cell on the screen. + * The low order 8 bits represent the actual character displayed while the + * high order bits represent the display atributes such as blinking, + * intensity and forground and background colors. The mask is represented in + * the diagram below: + * + * Bit: �15 �14 12�11 �10 8�7 0� + * Function:쿫link 쿫ackground쿶ntensity쿯oreground쿬haracter� + * + * Blinking and high intensity are on when the bit is 1. The background and + * foreground indicate which colors are used for each. The software mouse + * cursor uses these two values by taking the mask from the screen cell it + * is on and performing a logical AND on each bit with the screen mask + * value. The result is then logically XOR'ed with the cursor mask value. + * Thus to keep the character the same but invert the foreground and + * background colors the following values would be used: + * + * Bit: �15 �14 12�11 �10 8�7 0� + * Function:쿫link 쿫ackground쿶ntensity쿯oreground쿬haracter� + * screen: � 0 � 111 � 0 � 111 �11111111 � =30719 + * cursor: � 0 � 111 � 0 � 111 �00000000 � =30464 + * + * The hardware cursor is the text cursor provided by the video board. One + * specifies the range of scan lines which are on using and + * . The range of values is dependant upon the type of monitor. + * The first scan line is 0. + * $END$ + */ + /* +FUNCTION FT_MDEFCRS( nCurType, nScrMask, nCurMask ) // define text cursor type and masks + + aReg[AX] = 10 // set mouse function call 10 + aReg[BX] = nCurType // load cursor type parameter + aReg[CX] = nScrMask // load screen mask value + aReg[DX] = nCurMask // load cursor mask value + FT_INT86( 51, aReg ) // execute mouse interrupt + +RETURN NIL // no function output + +*/