home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #19 / NN_1992_19.iso / spool / comp / os / vms / 14448 < prev    next >
Encoding:
Text File  |  1992-09-01  |  13.6 KB  |  362 lines
  1. Newsgroups: comp.os.vms
  2. Path: sparky!uunet!munnari.oz.au!manuel!nuc.anu.edu.au!bear
  3. From: bear@nuc.anu.edu.au (Bernhard Fabricius)
  4. Subject: Keystrokes and cursor positions from Character cell Terminals
  5. Message-ID: <1992Sep2.040012.10177@newshost.anu.edu.au>
  6. Lines: 350
  7. Sender: news@newshost.anu.edu.au
  8. Reply-To: BEAR@NUC.ANU.EDU.AU
  9. Organization: Nuclear Physics, ANU
  10. Date: Wed, 2 Sep 92 04:00:12 GMT
  11.  
  12.  
  13. Oups - I forgot to put a "Subject" on the first post - we try again...
  14.  
  15. Hi there,
  16.  
  17. in a recent post, someone asked how to obtain the X button press info from 
  18. character cell applications. Appended to this post is a VMS_SHARE file that
  19. contains a subroutine, QIO_KEY, which will do just that - returning a keycode
  20. (using codes that are compatible with SMG routines), and if that key was one
  21. of the mouse buttons, then also the cell (row/column) location of the cursor
  22. when the key was pressed. 
  23.  
  24. The subroutine is written in FORTRAN, but it can be easily used (called) from
  25. other languages with suitable %val() etc modifications. 
  26.  
  27. Also included is a small program, SAMPLE.FOR, which is just a test-program 
  28. using the QIO_KEY subroutine. To use:
  29.  
  30. $ FORTRAN SAMPLE
  31. $ FORTRAN QIO_KEY
  32. $ LINK SAMPLE, QIO_KEY
  33. $ RUN SAMPLE
  34.  
  35. Have fun. Comments, suggestions and bug reports to the author please!
  36.  
  37. Cheers
  38.  
  39. Bernhard
  40. --------------------------------------------------------------------------------
  41. Dr Bernhard Fabricius              |
  42. Academic VAX/VMS Support           |  "I am a Bear of Very Little Brain,
  43. Department of Nuclear Physics      |           and long words Bother me."
  44. Australian National University     |
  45.                                    |                           - A.A. Milne
  46. InterNet: BEAR@NUC.ANU.EDU.AU      |
  47.     POSTMASTER@NUC.ANU.EDU.AU      |
  48. $! ------------------ CUT HERE -----------------------
  49. $ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
  50. $!
  51. $! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
  52. $!   On  2-SEP-1992 12:54:48.83   By Bernhard Fabricius 
  53. $!
  54. $! This VMS_SHARE Written by:
  55. $!    Andy Harper, Kings College London UK
  56. $!
  57. $! Acknowledgements to:
  58. $!    James Gray       - Original VMS_SHARE
  59. $!    Michael Bednarek - Original Concept and implementation
  60. $!
  61. $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
  62. $! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
  63. $!
  64. $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
  65. $!       1. SAMPLE.FOR;2
  66. $!       2. QIO_KEY.FOR;5
  67. $!
  68. $set="set"
  69. $set symbol/scope=(nolocal,noglobal)
  70. $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
  71. $e="write sys$error  ""%UNPACK"", "
  72. $w="write sys$output ""%UNPACK"", "
  73. $ if f$trnlnm("SHARE_LOG") then $ w = "!"
  74. $ ve=f$getsyi("version")
  75. $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
  76. $ e "-E-OLDVER, Must run at least VMS 4.4"
  77. $ v=f$verify(v)
  78. $ exit 44
  79. $UNPACK: SUBROUTINE ! P1=filename, P2=checksum
  80. $ if f$search(P1) .eqs. "" then $ goto file_absent
  81. $ e "-W-EXISTS, File ''P1' exists. Skipped."
  82. $ delete 'f'*
  83. $ exit
  84. $file_absent:
  85. $ if f$parse(P1) .nes. "" then $ goto dirok
  86. $ dn=f$parse(P1,,,"DIRECTORY")
  87. $ w "-I-CREDIR, Creating directory ''dn'."
  88. $ create/dir 'dn'
  89. $ if $status then $ goto dirok
  90. $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
  91. $ delete 'f'*
  92. $ exit
  93. $dirok:
  94. $ w "-I-PROCESS, Processing file ''P1'."
  95. $ if .not. f$verify() then $ define/user sys$output nl:
  96. $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
  97. PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
  98. SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
  99. CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
  100. LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
  101. BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
  102. IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
  103. MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
  104. ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
  105. 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
  106. POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
  107. ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
  108. COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
  109. "output_file"));ENDPROCEDURE;Unpacker;QUIT;
  110. $ delete/nolog 'f'*
  111. $ CHECKSUM 'P1'
  112. $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
  113. $ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
  114. $ ENDSUBROUTINE
  115. $START:
  116. $ create 'f'
  117. X`09options /EXTEND_SOURCE
  118. X`09program SAMPLE
  119. X
  120. Xc`09Simple program to test the QIO_KEY subroutine
  121. X
  122. X`09integer*4`09key, row, col, chan /0/
  123. X`09character*15`09keyname
  124. X
  125. X10`09continue
  126. X`09call qio_key(key,row,col,chan)
  127. X`09call smg$keycode_to_name(key, keyname)
  128. X`09if(key.ge.320)then
  129. X`09  type *,key,': ',keyname,' at ',row,col
  130. X`09else
  131. X`09  type *,key,': ',keyname
  132. X`09end if
  133. X`09if(key.ne.127)go to 10`09!Finish when <X`5D (delete) is hit
  134. X
  135. X`09write(6,20)char(27)//'>'//char(155)//'0;0'//char(39)//'z'
  136. X20`09format(x,a8,'Terminal reset to NUMERIC mode, locator request cancelled'
  137. V)
  138. X
  139. X`09status=sys$dassgn(%val(chan))
  140. X
  141. X`09end
  142. $ CALL UNPACK SAMPLE.FOR;2 427699687
  143. $ create 'f'
  144. X`09options    /EXTEND_SOURCE
  145. X`09subroutine QIO_KEY(key,row,col,chan)
  146. X
  147. Xc`09Return a SMG compatible key code and the screen position of the cursor i
  148. Vf either of the mouse buttons were pressed.
  149. Xc
  150. Xc`09Method: Do a QIOW read with a buffer size of 1 to force all keys to term
  151. Vinate. Enable escape termination too and
  152. Xc`09set up a suitably big overflow buffer to catch the escape sequences. Swi
  153. Vtch off echo and filtering and use a`20
  154. Xc`09prompt string that explicitly enables and requests a one-shot locator po
  155. Vsition or a keycode in application keypad`20
  156. Xc`09mode (to get correct key numbers for the extended keyboard).
  157. Xc
  158. Xc`09Programmed to work with all scan-codes from LK201 keyboards in all VT200
  159. V/VT300 modes.
  160. Xc
  161. Xc`09Still to do: Extra PC and UNIX (LK421) keyboard codes - if you really mu
  162. Vst...
  163. Xc
  164. Xc`09Transparently compatible with both 7-bit and 8-bit controls and both "no
  165. Vrmal" and "application" cursor key mode.
  166. Xc
  167. Xc`09Tested with DECterm in VT300-7bit and VT300-8bit modes.
  168. Xc`09Tested with VT220 and VT240 in VT200-7bit and VT200-8bit modes.
  169. Xc
  170. Xc`09Should work with VWS (UIS).
  171. Xc`09Could possibly work with VT300-series (with and without the mouse) and V
  172. VT420.
  173. Xc
  174. Xc`09Error conditions: Failure to ASSIGN a channel to TT or doing a QIOW will
  175. V halt the code.
  176. Xc`09Unknown codes and sequences (whatever they might be) will be returned as
  177. V key 0 at position (0,0).
  178. Xc
  179. Xc`09Terminal state on call: No assumptions made other than VT200 or better.
  180. Xc`09Terminal state on completion: Will be in APPLICATION mode (<esc>=) - set
  181. V to NUMERIC with <esc>>
  182. Xc
  183. Xc`09Locator state on call: No assumptions made (any position, any number of
  184. V buttons).
  185. Xc`09Locator state on completion: May have a pending locator request. Cancel
  186. V with <csi>0;0'z
  187. Xc
  188. Xc`09Written by Bernhard Fabricius, Department of Nuclear Physics, Australian
  189. V National University, September 1992
  190. Xc`09This code may be freely copied, modified and distributed. If you have so
  191. Vme good additions or find bugs then
  192. Xc`09please let me know via e-mail to BEAR@NUC.ANU.EDU.AU.
  193. Xc
  194. Xc
  195. Xc`09Parameter`09Type`09`09Access`09`09Function
  196. Xc`09------------------------------------------------------------------------
  197. V------------------------------------------------
  198. Xc`09KEY`09`09Integer*4`09Write only`09Key (SMG code) pressed during QIO (inc
  199. Vluding L/C/R mouse buttons)
  200. Xc`09ROW`09`09Integer*4`09Write only`09Row of cursor position if mouse was pr
  201. Vessed
  202. Xc`09COL`09`09Integer*4`09Write only`09Column of cursor position if mouse was
  203. V pressed
  204. Xc`09CHAN`09`09Integer*4`09Read/Write`09On call: If 0: a channel to "TT" will
  205. V be assigned (first time)
  206. Xc`09`09`09`09`09`09`09`09 If <> 0: no change (use previously assigned channe
  207. Vl)
  208. Xc`09`09`09`09`09`09`09On return: The channel to "TT" (only done first time)
  209. X
  210. X`09implicit`09none
  211. X
  212. X`09include`09`09'($trmdef)'`09`09`09!Need the extended mode codes by name
  213. X`09byte`09`09bbuf(1:32)
  214. X`09character*32`09sbuf
  215. X`09equivalence`09(bbuf(1),sbuf(1:1))
  216. X`09character*2`09terminal/'TT'/
  217. X`09integer*4`09status, sys$assign, sys$dassgn, sys$qiow, iofunc
  218. X`09integer*4`09key, row, col, l, k, i, chan
  219. X`09external`09io$_readvblk, io$m_noecho, io$m_extend, io$m_escape
  220. X
  221. X`09structure`09/itemlist/
  222. X`09  integer*2`09buffer_length
  223. X`09  integer*2`09item_code
  224. X`09  integer*4`09buffer
  225. X`09  integer*4`09stop/0/
  226. X`09end structure
  227. X`09record`09`09/itemlist/itml(1:3)
  228. X`09integer*4`09itmsize
  229. X
  230. X`09structure`09/statusblock/
  231. X`09  integer*2`09status
  232. X`09  integer*2`09offset
  233. X`09  byte`09`09term_char
  234. X`09  byte`09`09reserved
  235. X`09  byte`09`09term_length
  236. X`09  byte`09`09cp_eol
  237. X`09end structure
  238. X`09record`09`09/statusblock/iosb`09
  239. X
  240. X`09integer*2       tilde(1:34)/34*0/
  241. X`09integer*2`09o_low(108:121)/14*0/
  242. X
  243. Xc       Editing keys              E1  E2  E3  E4  E5  E6
  244. Xc       <esc>`5Bi`7E keys              1   2   3   4   5   6
  245. X`09data`09(tilde(i),i=1,6)/311,312,313,314,315,316/
  246. X
  247. Xc       Top row function keys      F6  F7  F8  F9 F10     F11 F12 F13 F14
  248. V    HELP  DO     F17 F18 F19 F20
  249. Xc       <esc>`5Bi`7E keys              17  18  19  20  21   -  23  24  25  2
  250. V6   -  28  29   -  31  32  33  34
  251. X`09data`09(tilde(i),i=17,34)/25,287,288,289,290,000,291,292,293,294,000,295,
  252. V296,000,297,298,299,300/
  253. X
  254. Xc       Keypad keys                    ,   -   .       0   1   2   3   4   5
  255. V   6   7   8   9
  256. Xc       <esc>Oi  keys                  l   m   n   -   p   q   r   s   t   u
  257. V   v   w   x   y
  258. X`09data`09(o_low(i),i=108,121)/272,271,273,000,260,261,262,263,264,265,266,2
  259. V67,268,269/
  260. X
  261. X`09character*12`09mouse`09`09!enable and request one-shot locator position i
  262. Vn cell units using application keypad mode
  263. X`09mouse(1:12)=char(155)//'2;2'//char(39)//'z'//char(155)//'1'//char(39)//'`
  264. V7B'//char(27)//'='
  265. X
  266. X`09if(chan.eq.0)then`09`09`09`09`09`09!No channel specified -
  267. X`09  status = sys$assign(terminal,chan,,)`09`09`09`09!get one
  268. X`09  if(.not.status) call lib$stop(%val(status))
  269. X`09end if
  270. X
  271. X`09itml(1).buffer_length = 0
  272. X`09itml(1).item_code = trm$_modifiers`09`09`09`09!Modify to include
  273. X`09itml(1).buffer = trm$m_tm_noecho.or.trm$m_tm_escape.or.trm$m_tm_nofiltr`0
  274. V9`09!no echo, no filter, escape terminate
  275. X`09itml(2).buffer_length = 0
  276. X`09itml(2).item_code = trm$_esctrmovr`09`09`09`09!Allow an escape overflow b
  277. Vuffer
  278. X`09itml(2).buffer = 31`09`09`09`09`09`09!of 31 characters (buffer is 32 char
  279. Vacters in all)
  280. X`09itml(3).buffer_length = 12`09`09`09`09`09
  281. X`09itml(3).item_code = trm$_prompt`09`09`09`09`09!Allow prompt of 12 charact
  282. Vers
  283. X`09itml(3).buffer = %loc(mouse)`09`09`09`09`09!use mouse request string
  284. X
  285. X`09itmsize = 36`09`09`09`09`09`09`09!There are 36 bytes in the item list
  286. X
  287. X`09iofunc = %loc(io$_readvblk).or.%loc(io$m_extend)`09`09!Read virtual block
  288. V in extended mode
  289. X
  290. Xc`09`5Befn`5D, chan, func, iosb, `5Bastadr`5D, `5Bastprm`5D, p1, p2, `5Bp3`5
  291. VD, `5Bp4`5D, p5, p6
  292. X`09status = sys$qiow( , %val(chan), %val(iofunc), iosb, , , bbuf, %val(32),
  293. V , ,itml ,%val(itmsize))
  294. X`09if(.not.status) call lib$stop(%val(status))
  295. X
  296. X`09row=0`09`09`09`09`09`09`09`09!Row is 0
  297. X`09col=0`09`09`09`09`09`09`09`09!Column is 0
  298. X`09key=0`09`09`09`09`09`09`09`09!Key is 0
  299. X`09if(iosb.offset.eq.1.or.iosb.term_length.eq.1)then`09`09!ASCII char or con
  300. Vtrol char
  301. X`09  key=zext(bbuf(1))`09`09`09`09`09`09!Use as read (but zero-extended for
  302. V ISO-Latin1)
  303. X`09  return
  304. X`09else`09`09`09`09`09`09`09`09!Some escape sequence
  305. X`09  l=iosb.term_length`09`09`09`09`09`09!Length thereof
  306. X`09  if(iosb.term_char.eq.-101.or.iosb.term_char.eq.-113)then`09!<csi> (155)
  307. V or <ss3> (143): 8-bit escape
  308. X`09    do k=l,2,-1`09`09`09`09`09`09`09!Shuffle along
  309. X`09      bbuf(k+1)=bbuf(k)`09`09`09`09`09`09!Move to the right
  310. X`09    end do
  311. X`09    bbuf(2)=91`09`09`09`09`09`09`09!Add `5B in position 2 (never mind 1)
  312. X`09    l=l+1`09`09`09`09`09`09`09!Update length
  313. X`09  end if
  314. X`09  if(sbuf(l:l).eq.'`7E')then`09`09`09`09`09!<esc>`5Bk`7E
  315. X`09    read(sbuf(3:l-1),*,err=100)k`09`09`09`09!Try to read
  316. X`09    if(k.gt.34.or.k.lt.1)go to 100`09`09`09`09!Must be 1<k<34
  317. X`09    key=tilde(k)`09`09`09`09`09`09!read back SMG code from array
  318. X100`09    continue
  319. X`09    return
  320. X`09  else if(l.eq.3.and.(sbuf(2:2).eq.'O'.or.sbuf(2:2).eq.'`5B'))then
  321. Xc`09    Codes of the type <esc>Ok or <esc>`5Bk (either Cursor Key Mode)
  322. X`09    k=ichar(sbuf(3:3))`09`09`09`09`09`09!get the character
  323. X`09    if(k.ge.108.and.k.le.121)then`09`09`09`09!lowercase l to y
  324. X`09      key=o_low(k)`09`09`09`09`09`09!read back SMG code from array
  325. X`09      return
  326. X`09    end if`09`09`09`09`09`09`09!Deal with the UPPERCASE codes by brute fo
  327. Vrce
  328. X`09    if(k.eq.65)key=274`09`09`09`09`09`09!A: Up
  329. X`09    if(k.eq.66)key=275`09`09`09`09`09`09!B: Down
  330. X`09    if(k.eq.67)key=277`09`09`09`09`09`09!C: Right
  331. X`09    if(k.eq.68)key=276`09`09`09`09`09`09!D: Left
  332. X`09    if(k.eq.77)key=270`09`09`09`09`09`09!M: Enter
  333. X`09    if(k.eq.80)key=256`09`09`09`09`09`09!P: PF1
  334. X`09    if(k.eq.81)key=257`09`09`09`09`09`09!Q: PF2
  335. X`09    if(k.eq.82)key=258`09`09`09`09`09`09!R: PF3
  336. X`09    if(k.eq.83)key=259`09`09`09`09`09`09!S: PF4
  337. X`09    return
  338. X`09  else if(sbuf(l-1:l).eq.'&w')then`09`09`09`09!<esc>`5BPe;Pb;Pr;Pc;Pp&w -
  339. V mouse codes
  340. X`09    do k=3,l-2
  341. X`09      if(bbuf(k).eq.59)bbuf(k)=44`09`09`09`09!Replace ; with , to enable
  342. V read
  343. X`09    end do
  344. X`09    read(sbuf(3:l-2),*,err=200)k,i,row,col`09`09`09!Read 4 integers (Pb i
  345. Vs not used, ignore Pp if given)
  346. X`09    key=320+k/2`09`09`09`09`09`09`09!Pe is 2, 4 or 6 for LEFT, MIDDLE and
  347. V RIGHT respectively`20
  348. X200`09    continue`09`09`09`09`09`09`09!The corresponding SMG codes are 321,
  349. V 322 or 323.
  350. X`09    return
  351. X`09  else if(l.eq.2.and.bbuf(2).eq.27)then`09`09`09`09!Final possibility: <e
  352. Vsc> (`5E`5B) itself is <esc><esc>
  353. X`09    key=27
  354. X`09  end if
  355. X`09end if
  356. X
  357. X`09end
  358. $ CALL UNPACK QIO_KEY.FOR;5 1963641118
  359. $ v=f$verify(v)
  360. $ EXIT
  361.  
  362.