SUBROUTINE Q.ATKEYDEF(action, key, sac, keyvalue)
*****************************************************************************
* Author : BSS
* Created: 28 Oct 2008
* Updated: 15 Sep 2023
* Version: 1.0.5
* Desc   : Get or Set a keyvalue from the AccuTerm keyboard.
*
* Copyright 2008-14 Rush Flat Software
* See licence conditions in: BP.Q licence.txt
*
*
* Accuterm can be queried to return the values programmed into the keyboard.
* In practice, it appears that it only returns values if they are different
* from the default value.
*
* Therefore, this routine reverts to a lookup table if the query itself does
* not return a value. Note that this lookup table is INCOMPLETE. It has only
* been filled in the meet the immediate requirements, but will need to be
* extended if other key combinations or other terminal emulations are required.
*
* The 2K2 manual notes that (keycode + 20000) returns the default value - but
* this doesn't appear in the AT7 manual, and it doesn't appear to return any
* value.
*
* History:
* Sep 2023 - Add PuTTY to the list of named terminal types (as default.ansi).
* Jan 2022 - Update name of subroutine to run script.
* Oct 2019 - Update check for terminal types.
* Apr 2015 - Allow default keys to be specified in action. Check for AccuTerm.
*            Move calculation of key code value to separate subroutine.
* May 2014 - Add default keys based on term type.
*
* ------------------------------------------------------------------------- *
*
$INCLUDE Q.INCLUDES QB.COMMON.H

EQUATE DBG TO 'SPEIRSBX'
*
* Define the basic keys and their keycodes
*
keys = 'F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12,BS,TAB,PGUP,PGDN,END,HOME,LEFT,UP,RIGHT,DOWN,INS,DEL,KPDENTER'
CONVERT ',' TO @AM IN keys
keycodes = '112,113,114,115,116,117,118,119,120,121,122,123,8,9,33,34,35,36,37,38,39,40,45,46,253'
CONVERT ',' TO @AM IN keycodes
*
* Interpret the passed values
*
action = UPCASE(action)
doget = INDEX(action, 'G', 1)
dogetdefault = INDEX(action, 'D', 1)
doset = INDEX(action, 'S', 1)

IF NOT(doget) AND NOT(dogetdefault) AND NOT(doset) THEN doget = @TRUE
IF (dogetdefault) THEN doget = @TRUE

key = UPCASE(key)
sac = UPCASE(sac)

CALL Q.ISACCUTERM(isaccuterm)

BEGIN CASE
  CASE (doget)
    GOSUB getkeyval
  CASE (doset)
    GOSUB setkeyval
END CASE

RETURN
*
* ------------------------------------------------------------------------- *
*
default.adds:
*
BEGIN CASE
  CASE (vkcode LT 1000)           ;* Basic key
    BEGIN CASE
      CASE (key EQ 'F1')    ; keyvalue = STX:'1':CR
      CASE (key EQ 'F2')    ; keyvalue = STX:'2':CR
      CASE (key EQ 'F3')    ; keyvalue = STX:'3':CR
      CASE (key EQ 'F4')    ; keyvalue = STX:'4':CR
      CASE (key EQ 'F5')    ; keyvalue = STX:'5':CR
      CASE (key EQ 'F6')    ; keyvalue = STX:'6':CR
      CASE (key EQ 'F7')    ; keyvalue = STX:'7':CR
      CASE (key EQ 'F8')    ; keyvalue = STX:'8':CR
      CASE (key EQ 'F9')    ; keyvalue = STX:'9':CR
      CASE (key EQ 'F10')   ; keyvalue = STX:':':CR
      CASE (key EQ 'F11')   ; keyvalue = STX:';':CR
      CASE (key EQ 'F12')   ; keyvalue = STX:'<':CR
      CASE (key EQ 'TAB')   ; keyvalue = TAB
      CASE (key EQ 'PGUP')  ; keyvalue = ESC:'J'
      CASE (key EQ 'PGDN')  ; keyvalue = ESC:'|'
      CASE (key EQ 'END')   ; keyvalue = ESC:'K'
      CASE (key EQ 'HOME')  ; keyvalue = ASC.SOH           ;* CHAR(1)   Ctrl-A
      CASE (key EQ 'LEFT')  ; keyvalue = ASC.NAK           ;* CHAR(21)  Ctrl-U
      CASE (key EQ 'UP')    ; keyvalue = ASC.SUB           ;* CHAR(26)  Ctrl-Z
      CASE (key EQ 'RIGHT') ; keyvalue = ASC.ACK           ;* CHAR(6)   Ctrl-F
      CASE (key EQ 'DOWN')  ; keyvalue = LF
      CASE (key EQ 'INS')   ; keyvalue = ESC:'q'
      CASE (key EQ 'DEL')   ; keyvalue = ESC:'W'
      CASE (key EQ 'BS')    ; keyvalue = BS
    END CASE
  CASE (vkcode LT 2000)           ;* Shift key
    BEGIN CASE
      CASE (key EQ 'F1')    ; keyvalue = STX:'!':CR
      CASE (key EQ 'F2')    ; keyvalue = STX:'"':CR
      CASE (key EQ 'F3')    ; keyvalue = STX:'#':CR
      CASE (key EQ 'F4')    ; keyvalue = STX:'$':CR
      CASE (key EQ 'F5')    ; keyvalue = STX:'%':CR
      CASE (key EQ 'F6')    ; keyvalue = STX:'&':CR
      CASE (key EQ 'F7')    ; keyvalue = STX:"'":CR
      CASE (key EQ 'F8')    ; keyvalue = STX:'(':CR
      CASE (key EQ 'F9')    ; keyvalue = STX:')':CR
      CASE (key EQ 'F10')   ; keyvalue = STX:'*':CR
      CASE (key EQ 'F11')   ; keyvalue = STX:'+':CR
      CASE (key EQ 'F12')   ; keyvalue = STX:',':CR
      CASE (key EQ 'TAB')   ; keyvalue = ESC:'O'
    END CASE
  CASE (vkcode LT 3000)           ;* Ctrl key
    BEGIN CASE
      CASE (key EQ 'DEL')   ; keyvalue = CHAR(127)
    END CASE
  CASE (vkcode LT 4000)           ;* Shift-Ctrl key
  CASE (vkcode LT 5000)           ;* Alt key
  CASE (vkcode LT 6000)           ;* Shift-Alt key
  CASE (vkcode LT 7000)           ;* Ctrl-Alt key
  CASE (vkcode LT 8000)           ;* Shift-Ctrl-Alt key
  CASE (1)
END CASE

RETURN
*
* ------------------------------------------------------------------------- *
*
default.ansi:
*
BEGIN CASE
  CASE (vkcode LT 1000)           ;* Basic key
    BEGIN CASE
      CASE (key EQ 'F1')    ; keyvalue = ESC:'OP'
      CASE (key EQ 'F2')    ; keyvalue = ESC:'OQ'
      CASE (key EQ 'F3')    ; keyvalue = ESC:'OR'
      CASE (key EQ 'F4')    ; keyvalue = ESC:'OS'
      CASE (key EQ 'F5')    ; keyvalue = ESC:'[M'
      CASE (key EQ 'F6')    ; keyvalue = ESC:'[17~'
      CASE (key EQ 'F7')    ; keyvalue = STX:'[18~'
      CASE (key EQ 'F8')    ; keyvalue = ESC:'[19~'
      CASE (key EQ 'F9')    ; keyvalue = ESC:'[20~'
      CASE (key EQ 'F10')   ; keyvalue = ESC:'[21~'
      CASE (key EQ 'F11')   ; keyvalue = ESC:'[23~'
      CASE (key EQ 'F12')   ; keyvalue = ESC:'[24~'
      CASE (key EQ 'TAB')   ; keyvalue = TAB
      CASE (key EQ 'PGUP')  ; keyvalue = ESC:'[5~'
      CASE (key EQ 'PGDN')  ; keyvalue = ESC:'[6~'
      CASE (key EQ 'END')   ; keyvalue = ESC:'[1~'
      CASE (key EQ 'HOME')  ; keyvalue = ESC:'[H'
      CASE (key EQ 'LEFT')  ; keyvalue = ESC:'[D'
      CASE (key EQ 'UP')    ; keyvalue = ESC:'[A'
      CASE (key EQ 'RIGHT') ; keyvalue = ESC:'[C'
      CASE (key EQ 'DOWN')  ; keyvalue = ESC:'[B'
      CASE (key EQ 'INS')   ; keyvalue = ESC:'[2~'
      CASE (key EQ 'DEL')   ; keyvalue = CHAR(127)
      CASE (key EQ 'BS')    ; keyvalue = BS
    END CASE
  CASE (vkcode LT 2000)           ;* Shift key
    BEGIN CASE
      CASE (key EQ 'F1')    ; keyvalue = ESC:'[51~'
      CASE (key EQ 'F2')    ; keyvalue = ESC:'[52~'
      CASE (key EQ 'F3')    ; keyvalue = ESC:'[53~'
      CASE (key EQ 'F4')    ; keyvalue = ESC:'[54~'
      CASE (key EQ 'F5')    ; keyvalue = ESC:'[55~'
      CASE (key EQ 'F6')    ; keyvalue = ESC:'[56~'
      CASE (key EQ 'F7')    ; keyvalue = ESC:'[57~'
      CASE (key EQ 'F8')    ; keyvalue = ESC:'[58~'
      CASE (key EQ 'F9')    ; keyvalue = ESC:'[59~'
      CASE (key EQ 'F10')   ; keyvalue = ESC:'[60~'
      CASE (key EQ 'F11')   ; keyvalue = ESC:'[61~'
      CASE (key EQ 'F12')   ; keyvalue = ESC:'[62~'
      CASE (key EQ 'TAB')   ; keyvalue = ESC:'[Z'
    END CASE
  CASE (vkcode LT 3000)           ;* Ctrl key
    BEGIN CASE
      CASE (key EQ 'DEL')   ; keyvalue = CHAR(127)
    END CASE
  CASE (vkcode LT 4000)           ;* Shift-Ctrl key
  CASE (vkcode LT 5000)           ;* Alt key
  CASE (vkcode LT 6000)           ;* Shift-Alt key
  CASE (vkcode LT 7000)           ;* Ctrl-Alt key
  CASE (vkcode LT 8000)           ;* Shift-Ctrl-Alt key
  CASE (1)
END CASE

RETURN
*
* ------------------------------------------------------------------------- *
*
getdefault:
*
* These definitions have been taken from the AccuTerm manual. The manual also
* includes some other key combinations (e.g. Ctrl+F1) but these definitions do
* not appear to match those defined within AccuTerm itself. Definitions for
* these other combinations (or for other terminal types) can be added later
* as needed.
*
temp = UPCASE(@TERM.TYPE)
IF (DBG EQ QB.USER_ID) THEN CRT 'Getting default value for term ':temp
BEGIN CASE
  CASE (temp[1, 2] EQ 'VP') OR (temp[1, 9] EQ 'VIEWPOINT') OR (temp[1, 4] EQ 'ADDS')
    GOSUB default.adds

  CASE (temp[1, 2] EQ 'VT') OR (temp[1, 3] EQ 'DEC') OR (temp EQ 'PUTTY')
    GOSUB default.ansi

  CASE (1)                        ;* Some other terminal emulation
END CASE

IF (DBG EQ QB.USER_ID) AND (keyvalue NE '') THEN CRT 'Default value found'

RETURN
*
* ------------------------------------------------------------------------- *
*
getkeycode:
*
CALL Q.ATKEYCODE('C', key, sac, vkcode)

IF (DBG EQ QB.USER_ID) THEN CRT 'Modified key code is ':vkcode

RETURN
*
* ------------------------------------------------------------------------- *
*
getkeyval:
*
* This section queries AccuTerm for the key setting, and returns it as a string
* of ASCII character codes. This is done because we can't INPUT control codes.
* The ASCII values are then converted back to their normal representation for
* storage within a variable.
*
keyvalue = ''
GOSUB getkeycode
IF (vkcode EQ '') THEN RETURN

IF (dogetdefault) OR NOT(isaccuterm) THEN
  GOSUB getdefault
  RETURN
END

script = 'dim keyvalue as string'
script<-1> = 'dim keyasc as string'
script<-1> = 'dim i as integer'
script<-1> = 'dim lenval as integer'
script<-1> = 'keyvalue = InitSession.Fkeys(':vkcode:')'
script<-1> = 'keyasc = ""'
script<-1> = 'lenval = len(keyvalue)'
script<-1> = 'if lenval > 0 then'
script<-1> = '  for i = 1 to lenval'
script<-1> = '    keyasc = keyasc & cstr(asc(mid$(keyvalue,i,1))) & " "'
script<-1> = '  next i'
script<-1> = 'end if'
script<-1> = 'InitSession.Output keyasc & vbCr'

keyasc = ''
CALL Q.RUNSCRIPT(script, err)
ECHO OFF
INPUT keyasc:
ECHO ON

IF (DBG EQ QB.USER_ID) THEN CRT 'ASCII code returned by AccuTerm: ':keyasc

dc = DCOUNT(keyasc, ' ')
FOR ii = 1 TO dc
  thisval = FIELD(keyasc, ' ', ii)
  IF (thisval GT 0) THEN
    keyvalue := CHAR(thisval)
  END
NEXT ii
*
* Get a default value if nothing has been returned by the query.
*
IF (keyvalue EQ '') THEN GOSUB getdefault

RETURN
*
* ------------------------------------------------------------------------- *
*
setkeyval:
*
* Assign the passed keyvalue to the specified key.
*
IF NOT(isaccuterm) THEN RETURN

GOSUB getkeycode
IF (vkcode EQ '') THEN RETURN

property = 'Fkeys(':vkcode:')'
CALL Q.ATPROPERTY('S', property, keyvalue)

RETURN
*
* ------------------------------------------------------------------------- *
*
END