$set sourceformat(variable) program-id. keypress. *author. Mike Fleming. *date-written. January 2016. special-names. crt status is ws-key-status. working-storage section. 01 ws-keypress pic x. 01 ws-interpretation pic x(15). 01 set-bit-pairs pic 9(2) comp-x value 1. 01 adis-key-control. 03 adis-key-setting pic 9(2) comp-x value 1. 03 filler pic x value "2". 03 first-adis-key pic 9(2) comp-x value 0. 03 number-of-adis-keys pic 9(2) comp-x value 26. 01 ws-detect-shift pic 9(2) comp-x value 46. 01 ws-shift-pressed pic 9(4) comp-x. 01 ws-key-status. 03 ws-key-type pic x. 88 Accept-terminated value "0". 88 User-func value "1". 88 ADIS-key value "2". 88 Data-key value "3". 03 ws-key-code-1 pic 9(2) comp-x. 88 Escape-key value zero. *> With key type 1 88 F-key values 1 through 12. 88 F1 value 1. *> With key type 1 88 F2 value 2. *> With key type 1 88 F3 value 3. *> With km 88 F4 value 4. *> With key type 1 88 F5 value 5. *> With key type 1 88 F6 value 6. *> With key type 1 88 F7 value 7. *> With key type 1 88 F8 value 8. *> With key type 1 88 F9 value 9. *> With key type 1 88 F10 value 10. *> With key type 1 88 F11 value 11. *> With key type 1 88 F12 value 12. *> With key type 1 88 Page-Up value 53 66. *> With key type 1 88 Page-Down value 54 67. *> With key type 1 * For some reason, Tarmac has non-standard mappings 66 and 67 for * paging keys which should theoretically be Alt-B and Alt-C 88 Ctrl-Page-Up value 55. *> With key type 1 88 Ctrl-Page-Down value 56. *> With key type 1 88 Enter-key value zero 2 *> With key type 2 48. *> With key type 0 88 cursor-left value 3. *> With key type 2 88 cursor-right value 4. *> With key type 2 88 cursor-up value 5. *> With key type 2 88 cursor-down value 6. *> With key type 2 88 Home-key value 7 *> With key type 2 69. *> With key type 1 88 Tab-key value 8 11. *> With key type 2 88 Backtab-key value 9 12. *> With key type 2 88 End-key value 10 *> With key type 2 72. *> With key type 1 88 Insert-key value 16. *> With key type 2 88 Delete-key value 17. *> With key type 2 * For some reason, Tarmac has non-standard mappings 69 and 72 for * Home/End keys which should theoretically be Alt-E and Alt-H 88 Ctrl-E value 22. *> With key type 2 88 Ctrl-F value 6. *> With key type 3 03 ws-key-code-2. 05 ws-key-code-2-num pic x comp-x. 01 ws-shifts. 03 ws-right-shift-ind pic x(5). 88 right-shift value "Right" false spaces. 03 ws-left-shift-ind pic x(4). 88 left-shift value "Left" false spaces. 03 ws-ctrl-ind pic x(4). 88 ctrl value "Ctrl" false spaces. 03 ws-alt-ind pic x(3). 88 alt value "Alt" false spaces. screen section. 01 ss-screen. 03 blank screen. 03 line 1. 03 col 1 value "Please depress a key [ ] Q = Quit". 03 line + 2. 03 col 1 value "Key press : ". 03 col 13 pic x from ws-keypress. 03 line + 2. 03 col 1 value "Key type : ". 03 col 13 pic x from ws-key-type. 03 line + 2. 03 col 1 value "Key code 1: ". 03 col 13 pic 9(2) from ws-key-code-1. 03 line + 2. 03 col 1 value "Key code 2: ". 03 col 13 pic x from ws-key-code-2. 03 col + 1 value "/". 03 col + 1 pic 9(2) from ws-key-code-2-num. 03 line + 2. 03 col 1 value "Shifts:". 03 col 13 from ws-right-shift-ind. 03 col + 2 from ws-left-shift-ind. 03 col + 2 from ws-ctrl-ind. 03 col + 2 from ws-alt-ind. 03 line + 2. 03 col 1 "Interpretation : ". 03 col + 1 pic x(15) from ws-interpretation. procedure division. a-control section. initialize ws-key-status call x"AF" using set-bit-pairs adis-key-control perform until exit display ss-screen accept ws-keypress at 0123 auto call x"AF" using ws-detect-shift ws-shift-pressed if ws-keypress = "q" or "Q" exit perform end-if if function mod(ws-shift-pressed 2) = 1 set right-shift to true else set right-shift to false end-if if function mod(function integer(ws-shift-pressed / 2) 2) = 1 set left-shift to true else set left-shift to false end-if if function mod(function integer(ws-shift-pressed / 4) 2) = 1 set ctrl to true else set ctrl to false end-if if function mod(function integer(ws-shift-pressed / 8) 2) = 1 set alt to true else set alt to false end-if if ws-keypress < x'20' or > x'7e' or not Accept-terminated move space to ws-keypress end-if end-perform goback. end program keypress.