SUBROUTINE Q.ATKEYCODE(action, key, sac, keyvalue)
*****************************************************************************
* Author : BSS
* Created: 18 Apr 2015
* Updated: 18 Apr 2015
* Version: 1.0.2
* Desc   : Convert a key to a keycode or vice-versa.
*
* Copyright 2015 Rush Flat Software
* See licence conditions in: BP.Q licence.txt
*
* Pass:
*  action    - C - return code for passed key
*              K - return key for passed code
* Pass/Return:
*   key      - key
*   sac      - Shift Alt Ctrl - use first letter of each key
*   keyvalue - AT keycode
*
* ------------------------------------------------------------------------- *
*
$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
keyvalues = '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 keyvalues
*
* Interpret the passed values
*
action = UPCASE(action[1, 1])
BEGIN CASE
  CASE (action EQ 'C')
    GOSUB getcode
  CASE (action EQ 'K')
    GOSUB getkey
END CASE

RETURN
*
* ------------------------------------------------------------------------- *
*
getcode:
*
* Generate the modified keycode. This is the keycode used to query AccuTerm
* or set the key to a new value.
*
keyvalue = ''

key = UPCASE(key)
sac = UPCASE(sac)
shift = (INDEX(sac, 'S', 1) GT 0)
alt = (INDEX(sac, 'A', 1) GT 0)
ctrl = (INDEX(sac, 'C', 1) GT 0)

LOCATE key IN keys SETTING kpos ELSE RETURN

keyvalue = keyvalues<kpos>
IF (DBG EQ QB.USER_ID) THEN CRT 'Key code for ':key:' is ':keyvalue

IF (shift) THEN keyvalue += 1000
IF (ctrl) THEN keyvalue += 2000
IF (alt) THEN keyvalue += 4000
defkeyvalue = keyvalue + 20000

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

RETURN
*
* ------------------------------------------------------------------------- *
*
getkey:
*
key = ''
sac = ''
IF NOT(keyvalue) THEN RETURN

kvalue = keyvalue
IF (kvalue GE 4000) THEN
  sac := 'A'
  kvalue -= 4000
END
IF (kvalue GE 2000) THEN
  sac := 'C'
  kvalue -= 2000
END
IF (kvalue GE 1000) THEN
  sac := 'S'
  kvalue -= 1000
END

LOCATE kvalue IN keyvalues SETTING kpos THEN
  key = keys<kpos>
END ELSE
  sac = ''
END

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