SUBROUTINE ES.KEYDEFS.GET(act)
*********************************************************************
* Author : BSS
* Created: 15 Apr 2015
* Updated: 15 Feb 2022
* Version: 1.0.3
* Desc   : Get the keydefs for this terminal.
*
* Pass:
*  act - R = refresh existing definitions.
*
* History:
* Feb 2022 - Do nothing for uvcs/vbsrvr connections.
* Apr 2017 - Bug fix. Data being converted from wrong variable.
* Jan 2016 - Check for numeric values returned by script.
*
* ----------------------------------------------------------------- *
*
$INCLUDE Q.INCLUDES QB.COMMON.H
$INCLUDE Q.INCLUDES ES.KEYDEFS.H

EQUATE DBG TO 'SPEIRSBX'

IF (@TTY EQ 'phantom') THEN RETURN
IF (@TTY EQ 'uvcs') THEN RETURN
IF (@TTY EQ 'vbsrvr') THEN RETURN

act = UPCASE(act)
dorefresh = INDEX(act, 'R', 1)

IF (SHIFT.TAB NE '') AND NOT(dorefresh) THEN RETURN

CALL Q.ISACCUTERM(isat)
IF (isat) THEN
  GOSUB query
END ELSE
  GOSUB defaults
END

RETURN
*
* ----------------------------------------------------------------- *
*
defaults:
*
CALL Q.ATKEYDEF('GD', 'TAB', 'S', SHIFT.TAB)
CALL Q.ATKEYDEF('GD', 'DEL', 'C', CTRL.DELETE)
CALL Q.ATKEYDEF('GD', 'F1', '', KEY.F1)
CALL Q.ATKEYDEF('GD', 'F2', '', KEY.F2)
CALL Q.ATKEYDEF('GD', 'F3', '', KEY.F3)
CALL Q.ATKEYDEF('GD', 'F4', '', KEY.F4)
CALL Q.ATKEYDEF('GD', 'F5', '', KEY.F5)
CALL Q.ATKEYDEF('GD', 'F6', '', KEY.F6)
CALL Q.ATKEYDEF('GD', 'F7', '', KEY.F7)
CALL Q.ATKEYDEF('GD', 'F8', '', KEY.F8)
CALL Q.ATKEYDEF('GD', 'F9', '', KEY.F9)
CALL Q.ATKEYDEF('GD', 'F10', '', KEY.F10)
CALL Q.ATKEYDEF('GD', 'F11', '', KEY.F11)
CALL Q.ATKEYDEF('GD', 'F12', '', KEY.F12)

RETURN
*
* ------------------------------------------------------------------------- *
*
query:
*
* This section writes a script to query AccuTerm for all the key definitions
* that we want. This is much more efficient than calling Q.ATKEYDEF for each
* individual key.
*
keys = CONVERT(',', @AM, 'TAB,DEL,F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12')
sacs = CONVERT(',', @AM, 'S,C')
vkcodes = ''

script     = '  dim keyvalue as string'
script<-1> = '  dim keyasc as string'
script<-1> = '  keyasc = ""'

dck = DCOUNT(keys, @AM)
FOR keyno = 1 TO dck
  key = keys<keyno>
  sac = sacs<keyno>
  CALL Q.ATKEYCODE('C', key, sac, vkcode)
  script<-1> = '  Call GetAscii(':vkcode:', keyasc)'
NEXT keyno

script<-1> = '  InitSession.Output keyasc & vbCr'
script<-1> = 'End Sub'

script<-1> = 'Sub GetAscii(vkcode as Integer, keyasc as String)'
script<-1> = '  dim i as integer'
script<-1> = '  dim lenval as integer'
script<-1> = '  keyvalue = InitSession.Fkeys(vkcode)'
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> = '  keyasc = keyasc & ","'

keyasc = ''
CALL Q.RUNSCRIPT(script, err)
ECHO OFF
INPUT keyasc:
ECHO ON
*
* The script returns a string of integer ASCII values representing the code sequence
* of each key. Each keys values are delimited by commas.
*
CONVERT ',' TO @AM IN keyasc
FOR keyno = 1 TO dck
  key = keys<keyno>
  sac = sacs<keyno>
  asc = TRIM(keyasc<keyno>)
  keyvalue = ''
  IF (asc NE '') THEN
    CONVERT ' ' TO @AM IN asc
    dc = DCOUNT(asc, @AM)
    FOR ii = 1 TO dc
      thisval = asc<ii>
      IF (thisval NE '') AND NUM(thisval) THEN
        keyvalue := CHAR(thisval)      ;* Convert the ASCII values back to characters
      END
    NEXT ii
  END ELSE
*
* AccuTerm only seems to return a value above if the key has been remapped. So, if
* we don't have a value, we'll call Q.ATKEYDEF to get the default value. As this
* is all done in code (no scripting involved), this is quite quick.
*
    CALL Q.ATKEYDEF('GD', key, sac, keyvalue)
  END
*
* Now load the values into the COMMON'ed variables.
*
  BEGIN CASE
    CASE (key EQ 'TAB') AND (sac EQ 'S') ; SHIFT.TAB = keyvalue
    CASE (key EQ 'DEL') AND (sac EQ 'C') ; CTRL.DELETE = keyvalue
    CASE (key EQ 'F1') AND (sac EQ '')   ; KEY.F1 = keyvalue
    CASE (key EQ 'F2') AND (sac EQ '')   ; KEY.F2 = keyvalue
    CASE (key EQ 'F3') AND (sac EQ '')   ; KEY.F3 = keyvalue
    CASE (key EQ 'F4') AND (sac EQ '')   ; KEY.F4 = keyvalue
    CASE (key EQ 'F5') AND (sac EQ '')   ; KEY.F5 = keyvalue
    CASE (key EQ 'F6') AND (sac EQ '')   ; KEY.F6 = keyvalue
    CASE (key EQ 'F7') AND (sac EQ '')   ; KEY.F7 = keyvalue
    CASE (key EQ 'F8') AND (sac EQ '')   ; KEY.F8 = keyvalue
    CASE (key EQ 'F9') AND (sac EQ '')   ; KEY.F9 = keyvalue
    CASE (key EQ 'F10') AND (sac EQ '')  ; KEY.F10 = keyvalue
    CASE (key EQ 'F11') AND (sac EQ '')  ; KEY.F11 = keyvalue
    CASE (key EQ 'F12') AND (sac EQ '')  ; KEY.F12 = keyvalue
  END CASE
NEXT keyno

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