From: bear@nuc.anu.edu.au (Bernhard Fabricius)
Subject: Keystrokes and cursor positions from Character cell Terminals
Reply-To: BEAR@NUC.ANU.EDU.AU
Organization: Nuclear Physics, ANU
Date: Wed, 2 Sep 92 04:00:12 GMT


Oups - I forgot to put a "Subject" on the first post - we try again...

Hi there,

in a recent post, someone asked how to obtain the X button press info from 
character cell applications. Appended to this post is a VMS_SHARE file that
contains a subroutine, QIO_KEY, which will do just that - returning a keycode
(using codes that are compatible with SMG routines), and if that key was one
of the mouse buttons, then also the cell (row/column) location of the cursor
when the key was pressed. 

The subroutine is written in FORTRAN, but it can be easily used (called) from
other languages with suitable %val() etc modifications. 

Also included is a small program, SAMPLE.FOR, which is just a test-program 
using the QIO_KEY subroutine. To use:

$ FORTRAN SAMPLE
$ FORTRAN QIO_KEY
$ LINK SAMPLE, QIO_KEY
$ RUN SAMPLE

Have fun. Comments, suggestions and bug reports to the author please!

Cheers

Bernhard
--------------------------------------------------------------------------------
Dr Bernhard Fabricius              |
Academic VAX/VMS Support           |  "I am a Bear of Very Little Brain,
Department of Nuclear Physics      |           and long words Bother me."
Australian National University     |
                                   |                           - A.A. Milne
InterNet: BEAR@NUC.ANU.EDU.AU      |
    POSTMASTER@NUC.ANU.EDU.AU      |
$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On  2-SEP-1992 12:54:48.83   By Bernhard Fabricius 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. SAMPLE.FOR;2
$!       2. QIO_KEY.FOR;5
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X`09options /EXTEND_SOURCE
X`09program SAMPLE
X
Xc`09Simple program to test the QIO_KEY subroutine
X
X`09integer*4`09key, row, col, chan /0/
X`09character*15`09keyname
X
X10`09continue
X`09call qio_key(key,row,col,chan)
X`09call smg$keycode_to_name(key, keyname)
X`09if(key.ge.320)then
X`09  type *,key,': ',keyname,' at ',row,col
X`09else
X`09  type *,key,': ',keyname
X`09end if
X`09if(key.ne.127)go to 10`09!Finish when <X`5D (delete) is hit
X
X`09write(6,20)char(27)//'>'//char(155)//'0;0'//char(39)//'z'
X20`09format(x,a8,'Terminal reset to NUMERIC mode, locator request cancelled'
V)
X
X`09status=sys$dassgn(%val(chan))
X
X`09end
$ CALL UNPACK SAMPLE.FOR;2 427699687
$ create 'f'
X`09options    /EXTEND_SOURCE
X`09subroutine QIO_KEY(key,row,col,chan)
X
Xc`09Return a SMG compatible key code and the screen position of the cursor i
Vf either of the mouse buttons were pressed.
Xc
Xc`09Method: Do a QIOW read with a buffer size of 1 to force all keys to term
Vinate. Enable escape termination too and
Xc`09set up a suitably big overflow buffer to catch the escape sequences. Swi
Vtch off echo and filtering and use a`20
Xc`09prompt string that explicitly enables and requests a one-shot locator po
Vsition or a keycode in application keypad`20
Xc`09mode (to get correct key numbers for the extended keyboard).
Xc
Xc`09Programmed to work with all scan-codes from LK201 keyboards in all VT200
V/VT300 modes.
Xc
Xc`09Still to do: Extra PC and UNIX (LK421) keyboard codes - if you really mu
Vst...
Xc
Xc`09Transparently compatible with both 7-bit and 8-bit controls and both "no
Vrmal" and "application" cursor key mode.
Xc
Xc`09Tested with DECterm in VT300-7bit and VT300-8bit modes.
Xc`09Tested with VT220 and VT240 in VT200-7bit and VT200-8bit modes.
Xc
Xc`09Should work with VWS (UIS).
Xc`09Could possibly work with VT300-series (with and without the mouse) and V
VT420.
Xc
Xc`09Error conditions: Failure to ASSIGN a channel to TT or doing a QIOW will
V halt the code.
Xc`09Unknown codes and sequences (whatever they might be) will be returned as
V key 0 at position (0,0).
Xc
Xc`09Terminal state on call: No assumptions made other than VT200 or better.
Xc`09Terminal state on completion: Will be in APPLICATION mode (<esc>=) - set
V to NUMERIC with <esc>>
Xc
Xc`09Locator state on call: No assumptions made (any position, any number of
V buttons).
Xc`09Locator state on completion: May have a pending locator request. Cancel
V with <csi>0;0'z
Xc
Xc`09Written by Bernhard Fabricius, Department of Nuclear Physics, Australian
V National University, September 1992
Xc`09This code may be freely copied, modified and distributed. If you have so
Vme good additions or find bugs then
Xc`09please let me know via e-mail to BEAR@NUC.ANU.EDU.AU.
Xc
Xc
Xc`09Parameter`09Type`09`09Access`09`09Function
Xc`09------------------------------------------------------------------------
V------------------------------------------------
Xc`09KEY`09`09Integer*4`09Write only`09Key (SMG code) pressed during QIO (inc
Vluding L/C/R mouse buttons)
Xc`09ROW`09`09Integer*4`09Write only`09Row of cursor position if mouse was pr
Vessed
Xc`09COL`09`09Integer*4`09Write only`09Column of cursor position if mouse was
V pressed
Xc`09CHAN`09`09Integer*4`09Read/Write`09On call: If 0: a channel to "TT" will
V be assigned (first time)
Xc`09`09`09`09`09`09`09`09 If <> 0: no change (use previously assigned channe
Vl)
Xc`09`09`09`09`09`09`09On return: The channel to "TT" (only done first time)
X
X`09implicit`09none
X
X`09include`09`09'($trmdef)'`09`09`09!Need the extended mode codes by name
X`09byte`09`09bbuf(1:32)
X`09character*32`09sbuf
X`09equivalence`09(bbuf(1),sbuf(1:1))
X`09character*2`09terminal/'TT'/
X`09integer*4`09status, sys$assign, sys$dassgn, sys$qiow, iofunc
X`09integer*4`09key, row, col, l, k, i, chan
X`09external`09io$_readvblk, io$m_noecho, io$m_extend, io$m_escape
X
X`09structure`09/itemlist/
X`09  integer*2`09buffer_length
X`09  integer*2`09item_code
X`09  integer*4`09buffer
X`09  integer*4`09stop/0/
X`09end structure
X`09record`09`09/itemlist/itml(1:3)
X`09integer*4`09itmsize
X
X`09structure`09/statusblock/
X`09  integer*2`09status
X`09  integer*2`09offset
X`09  byte`09`09term_char
X`09  byte`09`09reserved
X`09  byte`09`09term_length
X`09  byte`09`09cp_eol
X`09end structure
X`09record`09`09/statusblock/iosb`09
X
X`09integer*2       tilde(1:34)/34*0/
X`09integer*2`09o_low(108:121)/14*0/
X
Xc       Editing keys              E1  E2  E3  E4  E5  E6
Xc       <esc>`5Bi`7E keys              1   2   3   4   5   6
X`09data`09(tilde(i),i=1,6)/311,312,313,314,315,316/
X
Xc       Top row function keys      F6  F7  F8  F9 F10     F11 F12 F13 F14
V    HELP  DO     F17 F18 F19 F20
Xc       <esc>`5Bi`7E keys              17  18  19  20  21   -  23  24  25  2
V6   -  28  29   -  31  32  33  34
X`09data`09(tilde(i),i=17,34)/25,287,288,289,290,000,291,292,293,294,000,295,
V296,000,297,298,299,300/
X
Xc       Keypad keys                    ,   -   .       0   1   2   3   4   5
V   6   7   8   9
Xc       <esc>Oi  keys                  l   m   n   -   p   q   r   s   t   u
V   v   w   x   y
X`09data`09(o_low(i),i=108,121)/272,271,273,000,260,261,262,263,264,265,266,2
V67,268,269/
X
X`09character*12`09mouse`09`09!enable and request one-shot locator position i
Vn cell units using application keypad mode
X`09mouse(1:12)=char(155)//'2;2'//char(39)//'z'//char(155)//'1'//char(39)//'`
V7B'//char(27)//'='
X
X`09if(chan.eq.0)then`09`09`09`09`09`09!No channel specified -
X`09  status = sys$assign(terminal,chan,,)`09`09`09`09!get one
X`09  if(.not.status) call lib$stop(%val(status))
X`09end if
X
X`09itml(1).buffer_length = 0
X`09itml(1).item_code = trm$_modifiers`09`09`09`09!Modify to include
X`09itml(1).buffer = trm$m_tm_noecho.or.trm$m_tm_escape.or.trm$m_tm_nofiltr`0
V9`09!no echo, no filter, escape terminate
X`09itml(2).buffer_length = 0
X`09itml(2).item_code = trm$_esctrmovr`09`09`09`09!Allow an escape overflow b
Vuffer
X`09itml(2).buffer = 31`09`09`09`09`09`09!of 31 characters (buffer is 32 char
Vacters in all)
X`09itml(3).buffer_length = 12`09`09`09`09`09
X`09itml(3).item_code = trm$_prompt`09`09`09`09`09!Allow prompt of 12 charact
Vers
X`09itml(3).buffer = %loc(mouse)`09`09`09`09`09!use mouse request string
X
X`09itmsize = 36`09`09`09`09`09`09`09!There are 36 bytes in the item list
X
X`09iofunc = %loc(io$_readvblk).or.%loc(io$m_extend)`09`09!Read virtual block
V in extended mode
X
Xc`09`5Befn`5D, chan, func, iosb, `5Bastadr`5D, `5Bastprm`5D, p1, p2, `5Bp3`5
VD, `5Bp4`5D, p5, p6
X`09status = sys$qiow( , %val(chan), %val(iofunc), iosb, , , bbuf, %val(32),
V , ,itml ,%val(itmsize))
X`09if(.not.status) call lib$stop(%val(status))
X
X`09row=0`09`09`09`09`09`09`09`09!Row is 0
X`09col=0`09`09`09`09`09`09`09`09!Column is 0
X`09key=0`09`09`09`09`09`09`09`09!Key is 0
X`09if(iosb.offset.eq.1.or.iosb.term_length.eq.1)then`09`09!ASCII char or con
Vtrol char
X`09  key=zext(bbuf(1))`09`09`09`09`09`09!Use as read (but zero-extended for
V ISO-Latin1)
X`09  return
X`09else`09`09`09`09`09`09`09`09!Some escape sequence
X`09  l=iosb.term_length`09`09`09`09`09`09!Length thereof
X`09  if(iosb.term_char.eq.-101.or.iosb.term_char.eq.-113)then`09!<csi> (155)
V or <ss3> (143): 8-bit escape
X`09    do k=l,2,-1`09`09`09`09`09`09`09!Shuffle along
X`09      bbuf(k+1)=bbuf(k)`09`09`09`09`09`09!Move to the right
X`09    end do
X`09    bbuf(2)=91`09`09`09`09`09`09`09!Add `5B in position 2 (never mind 1)
X`09    l=l+1`09`09`09`09`09`09`09!Update length
X`09  end if
X`09  if(sbuf(l:l).eq.'`7E')then`09`09`09`09`09!<esc>`5Bk`7E
X`09    read(sbuf(3:l-1),*,err=100)k`09`09`09`09!Try to read
X`09    if(k.gt.34.or.k.lt.1)go to 100`09`09`09`09!Must be 1<k<34
X`09    key=tilde(k)`09`09`09`09`09`09!read back SMG code from array
X100`09    continue
X`09    return
X`09  else if(l.eq.3.and.(sbuf(2:2).eq.'O'.or.sbuf(2:2).eq.'`5B'))then
Xc`09    Codes of the type <esc>Ok or <esc>`5Bk (either Cursor Key Mode)
X`09    k=ichar(sbuf(3:3))`09`09`09`09`09`09!get the character
X`09    if(k.ge.108.and.k.le.121)then`09`09`09`09!lowercase l to y
X`09      key=o_low(k)`09`09`09`09`09`09!read back SMG code from array
X`09      return
X`09    end if`09`09`09`09`09`09`09!Deal with the UPPERCASE codes by brute fo
Vrce
X`09    if(k.eq.65)key=274`09`09`09`09`09`09!A: Up
X`09    if(k.eq.66)key=275`09`09`09`09`09`09!B: Down
X`09    if(k.eq.67)key=277`09`09`09`09`09`09!C: Right
X`09    if(k.eq.68)key=276`09`09`09`09`09`09!D: Left
X`09    if(k.eq.77)key=270`09`09`09`09`09`09!M: Enter
X`09    if(k.eq.80)key=256`09`09`09`09`09`09!P: PF1
X`09    if(k.eq.81)key=257`09`09`09`09`09`09!Q: PF2
X`09    if(k.eq.82)key=258`09`09`09`09`09`09!R: PF3
X`09    if(k.eq.83)key=259`09`09`09`09`09`09!S: PF4
X`09    return
X`09  else if(sbuf(l-1:l).eq.'&w')then`09`09`09`09!<esc>`5BPe;Pb;Pr;Pc;Pp&w -
V mouse codes
X`09    do k=3,l-2
X`09      if(bbuf(k).eq.59)bbuf(k)=44`09`09`09`09!Replace ; with , to enable
V read
X`09    end do
X`09    read(sbuf(3:l-2),*,err=200)k,i,row,col`09`09`09!Read 4 integers (Pb i
Vs not used, ignore Pp if given)
X`09    key=320+k/2`09`09`09`09`09`09`09!Pe is 2, 4 or 6 for LEFT, MIDDLE and
V RIGHT respectively`20
X200`09    continue`09`09`09`09`09`09`09!The corresponding SMG codes are 321,
V 322 or 323.
X`09    return
X`09  else if(l.eq.2.and.bbuf(2).eq.27)then`09`09`09`09!Final possibility: <e
Vsc> (`5E`5B) itself is <esc><esc>
X`09    key=27
X`09  end if
X`09end if
X
X`09end
$ CALL UNPACK QIO_KEY.FOR;5 1963641118
$ v=f$verify(v)
$ EXIT

Newsgroups: comp.os.vms