SUBROUTINE ANY_KEY( TEXT_KEY, META_KEY ) ! Copyright 1994-2021 Marcus Rhodes ! This program is free software; You can redistribute it and/or ! modify it under the terms of the GNU general public license ! version 3 as published by the Free Software Foundation. ! Modified: 03/03/2021 21:39:08 by Marcus ! Platform: Any Pick; Any OS; Any Emulator; Any Emulation ! Function: Returns the next key from our input buffer, or, if empty, ! directly from the keyboard. ! See ANY_KEY_EQU for more. ! Params__ IO Typ Description____________________________________________ ! TEXT_KEY < Str If a regular key is pressed, its character is returned ! in this variable. ! META_KEY < Str If a special key (Page Up, Home, Tab, etc.) or mouse- ! button (AccuTerm only) is pressed, ANY_KEY's standard, ! replacement key-code, as defined in ANY_KEY_EQU, is ! returned in this variable. ! Syntax : CALL ANY_KEY( TEXT_KEY, META_KEY ) ! Examples: INCLUDE ANY_KEY_EQU ! LOOP ! CALL ANY_KEY( TEXT_KEY, META_KEY ) ! BEGIN CASE ! CASE META_KEY EQ KC_HOME ; GOSUB JUMP.TO.TOP ! CASE META_KEY EQ KC_END ; GOSUB JUMP.TO.END ! CASE META_KEY EQ K_PAGE_UP ; GOSUB PAGE.UP ! CASE META_KEY EQ K_PAGE_DOWN ; GOSUB PAGE.DOWN ! CASE META_KEY EQ K_UP ; GOSUB LINE.UP ! CASE META_KEY EQ K_DOWN ; GOSUB LINE.DOWN ! CASE META_KEY EQ K_HOME ; GOSUB LINE.BEG ! CASE META_KEY EQ K_END ; GOSUB LINE.END ! CASE META_KEY EQ K_BACKSPACE ; GOSUB DELETE.LFT ! CASE META_KEY EQ K_DELETE ; GOSUB DELETE.RGT ! CASE META_KEY EQ K_INSERT ; GOSUB TOGGLE.INSERT ! CASE META_KEY EQ K_ESC ; EXIT ! CASE TEXT_KEY NE '' ; GOSUB ADD.TO.TEXT ! END CASE ! REPEAT ! Upcoming: Complete/Improve jBase compatibility. ! Done! 07/26/2020 13:53:03 by Marcus ! Upcoming: This is an event-loop that only checks for a single event: A ! key-press. It can/should check for more than that, like, ! say, a message, but not too often, say every 3-30 seconds. ! Upcoming: Check for AccuTerm if/when ANY_KEY_TRM has not been executed, ! but a non-DEC terminal is specified by Pick (SYSTEM(7)) or an ! AccuTerm mouse code-string is received. Aaaannd, if AccuTerm ! is, in fact, found to be in use, and it hasn't already been ! done, program all the dead keys for that terminal so the user ! has a better experience. ! Done. See: ANY_KEY_ATW ! Move the TYPE_ONE emulation mode check ANY_KEY_ATW so it's ! only run once, and where it really belongs: With the rest of ! the AccuTerm-specific stuff. ! Done. 03/03/2021 21:39:08 by Marcus ! Upcoming: Improve UV compatibility. UV not only lacks an IN(PUT)/FOR, ! as well as any way to work around it within Basic, but its ! INPUTIF doesn't return ^H/Backspace, at least not on the AIX ! installation currently available to me, so that leaves only ! KEYIN() and SYSTEM(14) to work with. ! Upcoming: Improve/correct 2nd mouse-click detection. This is going to ! require solving the UV problem of lacking a timeout. Why? ! Because, if the input won't timeout, then we could end up ! stopping everything, waiting for a 2nd click that may never ! come, frustrating the user. ! Upcoming: Code to accommodate ISO-8859-1 character set. ! Change is the only constant. -- Heraclitus ! Project : https://github.com/MarcusAureliusRhodes/AnyKey ! Old name: ANY_KEY_GET ! New name: ANY_KEY ! Catalog : ANY_KEY EQU IDENTITY TO 'ANY_KEY' EQU CR TO CHAR( 13 ) EQU ESC TO CHAR( 27 ) INCLUDE ANY_KEY_EQU IF IDENTITY THEN GOSUB PROVE.NOT.PHANTOM IF ALLSWELL THEN GOSUB CATCH.1ST.KEY IF ALLSWELL THEN GOSUB CATCH.ANY.MORE RETURN PROVE.NOT.PHANTOM: IF KEYB_TYP EQ 'ZZZ' THEN ALLSWELL = 0 TEXT_KEY = '' META_KEY = K_ESCAPE END ELSE ALLSWELL = 1 END RETURN CATCH.1ST.KEY: ECHO OFF ! Get the next key/code, first from our buffer, then, failing that, ! directly from the keyboard, waiting for it if necessary. IF BFFR_LEN THEN CHAR_NUM = SEQ( ANY_BFFR[ 1, 1 ] ) BFFR_LEN -= 1 ANY_BFFR = ANY_BFFR[ 2, BFFR_LEN ] END ELSE STARTING = INT( TIME() ) LOOP ! Beg Pick AP ================== Generic Pick ================== IN CHAR_NUM FOR 30 THEN EXIT END ! End Pick AP ================== Generic Pick ================== ! Beg Pick D3 ============== Rocket Software's D3 ============== IN CHAR_NUM FOR 30 THEN EXIT END ! End Pick D3 ============== Rocket Software's D3 ============== ! Beg Pick IC ============== InsterSytems' Cache =============== IN CHAR_NUM FOR 30 THEN EXIT END ! End Pick IC ============== InsterSytems' Cache =============== ! Beg Pick JB ================= Zumasys' jBase ================= IN CHAR_NUM FOR 30 THEN EXIT END ! End Pick JB ================= Zumasys' jBase ================= ! Beg Pick NR ============== Northgate's Reality =============== IN CHAR_NUM FOR 30 THEN EXIT END ! End Pick NR ============== Northgate's Reality =============== ! Beg Pick ON ===== Onware Software Corporations's Onware ====== IN CHAR_NUM FOR 30 THEN EXIT END ! End Pick ON ===== Onware Software Corporations's Onware ====== ! Beg Pick QM ================ Zumasys' OpenQM ================= IN CHAR_NUM FOR 30 THEN EXIT END ! End Pick QM ================ Zumasys' OpenQM ================= ! Beg Pick UD =========== Rocket Software's UniData ============ INPUTIF THE_CHAR, 1 : THEN IF THE_CHAR EQ '' THEN CHAR_NUM = 13 THE_CHAR = CHAR( 13 ) END ELSE CHAR_NUM = SEQ( THE_CHAR ) END ANY_BFFR := THE_CHAR EXIT END ELSE SLEEP 1 END ! End Pick UD =========== Rocket Software's UniData ============ ! Beg Pick UV =========== Rocket Software's UniVerse =========== CHAR_NUM = SEQ( KEYIN() ) EXIT ;! There's no good way to keep repeating this. Rethink! ! End Pick UV =========== Rocket Software's UniVerse =========== ! Beg Pick VU ============= ViaSystems' UniVision ============== IN CHAR_NUM FOR 30 THEN EXIT END ! End Pick VU ============= ViaSystems' UniVision ============== IF ( INT( TIME() ) - STARTING ) GE 3 THEN ! CALL EMV_MSG_GET ;! Check our messages every three seconds. END REPEAT END CRT_CODE = CHAR_NUM 'R%3' RETURN CATCH.ANY.MORE: ! If that was a regular key, then return it as is, otherwise, append ! up to 15 more key codes to the buffer. (Because AccuTerm mouse keys ! can generate code-strings as long as 16 chars.) ! Some systems prefix mouse-codes with _/char(95) requiring a bit more ! complication in this IF/THEN. If you're not on one of those ! systems, and worry about speed, then uncomment the next line, and ! comment-out the line after it. ! And, now, it turns out that there's a terminal that used 4 as the ! first character of its Shift+Insert string. RGLR_KEY = 31 LT CHAR_NUM AND CHAR_NUM LT 52 RGLR_KEY += 52 LT CHAR_NUM AND CHAR_NUM LT 95 RGLR_KEY += 95 LT CHAR_NUM AND CHAR_NUM LT 127 IF RGLR_KEY THEN TEXT_KEY = CHAR( CHAR_NUM ) META_KEY = '' END ELSE ! First, prepend it back in the buffer, ... ANY_BFFR = CHAR( CHAR_NUM ) : ANY_BFFR BFFR_LEN += 1 ! ... then add up to 15 more codes, if available. ! Beg Pick JB ================== Zumasys' jBase =================== LOOP WHILE BFFR_LEN LT 16 DO IN CHAR_NUM FOR 1 THEN ANY_BFFR := CHAR( CHAR_NUM ) BFFR_LEN += 1 CRT_CODE := CHAR_NUM 'R%3' KEY_IN_Q = 1 END ELSE EXIT END REPEAT ! End Pick JB ================== Zumasys' jBase =================== ! Beg Pick QM ================== Zumasys' OpenQM ================== IF CHAR_NUM EQ 194 THEN ! Either a character follows Shift+Space on Gnome/Mate terminal ! that OpenQM is unable to pull from the type-ahead buffer, or ! it leaves a flag set even after IN/FOR causing INPUT var,-1: ! to think there's still a character in the buffer when there ! isn't. Either way, this is a bug, and it requires working ! around. INPUT KEY_IN_Q, -1 : END LOOP INPUT KEY_IN_Q, -1 : WHILE KEY_IN_Q AND BFFR_LEN LT 16 DO IN CHAR_NUM ANY_BFFR := CHAR( CHAR_NUM ) BFFR_LEN += 1 CRT_CODE := CHAR_NUM 'R%3' REPEAT ! End Pick QM ================== Zumasys' OpenQM ================== ! Beg Pick UD ============= Rocket Software's UniData ============= LOOP WHILE BFFR_LEN LT 16 DO INPUTIF CHAR_NUM, 1 THEN ANY_BFFR := CHAR( CHAR_NUM ) BFFR_LEN += 1 CRT_CODE := CHAR_NUM 'R%3' KEY_IN_Q = 1 END ELSE EXIT END REPEAT ! End Pick UD ============= Rocket Software's UniData ============= ! Beg Pick UV ============ Rocket Software's UniVerse ============= LOOP WHILE BFFR_LEN LT 16 DO INPUTIF THE_CHAR, 1 THEN IF THE_CHAR EQ '' THEN THE_CHAR = CHAR( 13 ) CHAR_NUM = 13 END ELSE CHAR_NUM = SEQ( THE_CHAR ) END ANY_BFFR := THE_CHAR BFFR_LEN += 1 CRT_CODE := CHAR_NUM 'R%3' KEY_IN_Q = 1 END ELSE KEY_IN_Q = 0 EXIT END REPEAT ! End Pick UV ============ Rocket Software's UniVerse ============= ! Search the array for this key, starting with a maximum of 16 ! chars, working our way down to a single char, until a match is ! found. CODE_MAX = LEN( ANY_BFFR[ 1, 16 ] ) IF CODE_MAX EQ 1 AND ANY_BFFR EQ '_' THEN ! This is where we take care of any 'normal' chars that may also ! prefix special keys, but not this time. (Normal = 31 BFFR_LEN -= CODE_LEN ANY_BFFR = ANY_BFFR[ CODE_LEN + 1, BFFR_LEN ] ! GOSUB REMAP.THE.KEYS ! GOSUB ERASE.ANY.DUPES ! Handle any mouse clicks. BEGIN CASE CASE META_KEY EQ KM_L1 ; GOSUB FETCH.1ST.CLICK CASE META_KEY EQ KM_R1 ; GOSUB FETCH.1ST.CLICK ! CASE META_KEY EQ KM_L2 ; GOSUB FETCH.COORDINATES ! CASE META_KEY EQ KM_R2 ; GOSUB FETCH.COORDINATES ! CASE META_KEY EQ KC_Q ; CALL ANY_KEY_BLD END CASE END NEXT CODE_LEN ! What do we do with an unrecognized code-sequence? Confuse the ! user with it, of course! But at least reformat it first. IF META_KEY EQ '' THEN FOR CODE_IDX = 1 TO BFFR_LEN THE_CHAR = ANY_BFFR[ CODE_IDX, 1 ] CHAR_NUM = SEQ( THE_CHAR ) BEGIN CASE CASE CHAR_NUM LT 32 ; META_KEY := '^' : CHAR( CHAR_NUM + 64 ) CASE CHAR_NUM GT 126 ; META_KEY := '{' : CHAR_NUM 'R%3}' CASE 1 ; META_KEY := THE_CHAR END CASE NEXT CODE_IDX BFFR_LEN = 0 ANY_BFFR = '' END END END ECHO ON RETURN REMAP.THE.KEYS: ! This is where we make any necessary/possible adjustments to the old- ! to-new key mapping. What's that? If, for example, a VTxxx terminal ! returns code 027091051126, then that's unambiguously a delete key, ! which, in turn, means that, if we later on see code 127, it can only ! be the backspace key, and not the delete key, so that code's ! replacement string can be switched from that for delete to that for ! backspace. ! The user may see some confusing behavior if they press, in this ! case, the backspace key first, and it deletes, but they'll also see ! that behavior correct itself as soon as they press the delete key, ! which they're likely to do, just to see if they've been swapped. ! It's a pretty small price to pay to avoid having to disrupt the ! screen in order to detect the emulator and emulation settings, which ! is why it would be a good idea to add ANY_KEY_INI to the user's ! login script. ! The new, more specific keyboard designators my have obviated this. BEGIN CASE CASE KEY_FLGS[ 1, 1 ] ;! Do nothing! CASE KEY_FLGS[ 2, 1 ] AND THE_CODE EQ ESC : '[4~' ;! 027091049126 must be Home instead of End. OLD_CODE = ESC : '[1~' NEW_CODE = K_HOME FLAG_POS = 2 GOSUB REMAP.THE.KEY CASE KEY_FLGS[ 3, 1 ] AND THE_CODE EQ ESC : '[3~' ;! 127 must be Backspace instead of Delete. OLD_CODE = CHAR( 127 ) NEW_CODE = K_BACKSPACE FLAG_POS = 3 GOSUB REMAP.THE.KEY ! Disabled because it wreaks havoc with all the rest of the map. ! If char(127) is backspace, then ^H must be Ctrl+Backspace. ! OLD_CODE = CHAR( 8 ) ! NEW_CODE = KC_BACKSPACE ! GOSUB REMAP.THE.KEY CASE KEY_FLGS[ 3, 1 ] AND THE_CODE EQ ESC : 'W' ;! 127 must be Ctrl+Backspace instead of Delete. OLD_CODE = CHAR( 127 ) NEW_CODE = KC_BACKSPACE FLAG_POS = 3 GOSUB REMAP.THE.KEY CASE KEY_FLGS[ 4, 1 ] AND THE_CODE EQ ESC : '[13^' ;! 027091050053126~ must be Shift+F3 instead of Ctrl+F3. OLD_CODE = ESC : '[25~' NEW_CODE = KS_F03 FLAG_POS = 4 GOSUB REMAP.THE.KEY CASE KEY_FLGS[ 5, 1 ] AND THE_CODE EQ CHAR( 21 ) ;! 008 must be Backspace instead of Left. OLD_CODE = CHAR( 8 ) NEW_CODE = K_BACKSPACE FLAG_POS = 5 GOSUB REMAP.THE.KEY END CASE RETURN REMAP.THE.KEY: LOCATE OLD_CODE IN OLD_KEYS SETTING SWAP_IDX THEN NEW_KEYS< SWAP_IDX > = NEW_CODE KEY_FLGS = KEY_FLGS[ 1, FLAG_POS ] : '0' : KEY_FLGS[ ( 5 - FLAG_POS ) ] KEY_FLGS = ( KEY_FLGS[ 4 ] EQ '0000' ) : KEY_FLGS[ 4 ] IF KEYB_DBG THEN CRT 'KEY_FLGS = ' : KEY_FLGS : ' ' : END END RETURN ERASE.ANY.DUPES: ! I need to get a little smarter about this. The KEY_FLGS just isn't ! enough. Perhaps counting the special keys used, too? Or time ! passed? ! Our table compiles all known (to me at this time) code-sequences for ! about 400, unique key(-combination)s. This works out to about 3, ! different, possible code-sequences for each of those 400 keys, ! resulting in a table containing over 900 code-sequences, and their ! corresponding 'new' sequences. That's not too big, but it could/- ! should be smaller/faster. So, as long as the table is still over ! 400 keys (and who really needs that many?), we'll keep removing any ! duplicate keys. There are, for example, currently a dozen different ! code-sequences all equating to F1. Once the user presses their F1 ! key, then we'll know which one of those dozen we need to keep, and ! which we can remove, shrinking the table, and accelerating future ! searches. IF KTBL_LEN GT 400 THEN ! First, get the current key out of the way. DEL OLD_KEYS< CODE_IDX > DEL NEW_KEYS< CODE_IDX > ! Now, find and remove any other instances of the current key. LOOP LOCATE META_KEY IN NEW_KEYS SETTING CODE_IDX THEN DEL OLD_KEYS< CODE_IDX > DEL NEW_KEYS< CODE_IDX > KTBL_LEN -= 1 END ELSE EXIT END REPEAT ! Now reinsert the current key, but at the top of the table. Why? ! Because any key the user presses is likely to be pressed again, ! maybe even the very next key. OLD_KEYS = THE_CODE : @AM : OLD_KEYS NEW_KEYS = META_KEY : @AM : NEW_KEYS END ! Caution! This interferes with the key remapping. Maybe there's a ! way to reconcile the two by only erasing the dupes on terms that ! don't need to remap, and only on terms that do need remapping after ! remapping. Which terms are affected? RETURN FETCH.1ST.CLICK: GOSUB FETCH.COORDINATES META_KEY = META_KEY : @AM : SCREEN_X : @AM : SCREEN_Y ! Wait a quarter of a second ... ! Beg Pick AP ===================== Generic Pick ===================== TIME_BEG = SYSTEM( 12 ) LOOP TELAPSED = SYSTEM( 12 ) - TIME_BEG UNTIL TELAPSED GT 250 DO REPEAT ! End Pick AP ===================== Generic Pick ===================== ! Beg Pick D3 ================= Rocket Software's D3 ================= TIME_BEG = SYSTEM( 12 ) LOOP TELAPSED = SYSTEM( 12 ) - TIME_BEG UNTIL TELAPSED GT 250 DO REPEAT ! End Pick D3 ================= Rocket Software's D3 ================= ! Beg Pick IC ================= InsterSytems' Cache ================== TIME_BEG = SYSTEM( 12 ) LOOP TELAPSED = SYSTEM( 12 ) - TIME_BEG UNTIL TELAPSED GT 250 DO REPEAT ! End Pick IC ================= InsterSytems' Cache ================== ! Beg Pick JB ==================== Zumasys' jBase ==================== TIME_BEG = SYSTEM( 12 ) LOOP TELAPSED = SYSTEM( 12 ) - TIME_BEG UNTIL TELAPSED GT 250 DO REPEAT ! End Pick JB ==================== Zumasys' jBase ==================== ! Beg Pick NR ================= Northgate's Reality ================== TIME_BEG = SYSTEM( 12 ) LOOP TELAPSED = SYSTEM( 12 ) - TIME_BEG UNTIL TELAPSED GT 25 DO REPEAT ! End Pick NR ================= Northgate's Reality ================== ! Beg Pick ON ======== Onware Software Corporations's Onware ========= TIME_BEG = SYSTEM( 12 ) LOOP TELAPSED = SYSTEM( 12 ) - TIME_BEG UNTIL TELAPSED GT 250 DO REPEAT ! End Pick ON ======== Onware Software Corporations's Onware ========= ! Beg Pick QM ================= Ladybridge's OpenQM ================== TIME_BEG = SYSTEM( 1020 ) LOOP TELAPSED = SYSTEM( 1020 ) - TIME_BEG UNTIL TELAPSED GT 250 DO REPEAT INPUT KEY_IN_Q, -1 ;! Anything in the buffer? ! End Pick QM ================= Ladybridge's OpenQM ================== ! Beg Pick UD ============== Rocket Software's UniData =============== TIME_BEG = SYSTEM( 12 ) LOOP TELAPSED = SYSTEM( 12 ) - TIME_BEG UNTIL TELAPSED GT 250 DO REPEAT ! End Pick UD ============== Rocket Software's UniData =============== ! Beg Pick UV ============== Rocket Software's UniVerse ============== ! Set $OPTIONS to TIME.MILLISECOND TIME_BEG = SYSTEM( 12 ) * 10 LOOP TELAPSED = ( SYSTEM( 12 ) * 10 ) - TIME_BEG UNTIL TELAPSED GT 5 DO REPEAT ! End Pick UV ============== Rocket Software's UniVerse ============== ! Beg Pick VU ================ ViaSystems' UniVision ================= TIME_BEG = SYSTEM( 12 ) LOOP TELAPSED = SYSTEM( 12 ) - TIME_BEG UNTIL TELAPSED GT 250 DO REPEAT ! End Pick VU ================ ViaSystems' UniVision ================= ! ... then see if there's another mouse-click. IF BFFR_LEN THEN CALL ANY_KEY( SOME_KEY, DBL_CHCK ) META_KEY = DBL_CHCK : @AM : SCREEN_X : @AM : SCREEN_Y END RETURN FETCH.COORDINATES: BEGIN CASE CASE TYPE_ONE CHAR_END = ';' ; GOSUB FETCH.COORDINATE ; SCREEN_Y = COORDINT - 1 CHAR_END = 'R' ; GOSUB FETCH.COORDINATE ; SCREEN_X = COORDINT - 1 CASE KEYB_TYP EQ 'BBS' CHAR_END = ';' ; GOSUB FETCH.COORDINATE ; SCREEN_Y = COORDINT - 1 CHAR_END = 'x' ; GOSUB FETCH.COORDINATE ; SCREEN_X = COORDINT - 1 CASE 1 CHAR_END = '.' ; GOSUB FETCH.COORDINATE ; SCREEN_X = COORDINT CHAR_END = CR ; GOSUB FETCH.COORDINATE ; SCREEN_Y = COORDINT END CASE RETURN FETCH.COORDINATE: COORDINT = '' LOOP CRDT_CHR = ANY_BFFR[ 1, 1 ] BFFR_LEN -= 1 ANY_BFFR = ANY_BFFR[ 2, BFFR_LEN ] UNTIL CRDT_CHR EQ CHAR_END OR BFFR_LEN LT 1 DO COORDINT := CRDT_CHR REPEAT RETURN