dahls%vax.elab.unit.uninett@TOR.NTA.NO (Joern Yngve Dahl-Stamnes) (06/10/88)
This is a small ex. of how to read the function keys from a terminal.
The basic routine is GET_KEY.
+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+
! The University of Trondheim ! Joern Yngve Dahl-Stamnes !
! The Norwegian Institute of Technology ! System Manager !
! Division of Physical Electronics ! !
! N 7034 Trondheim, Norway ! !
!---------------------------------------+---------------------------!
! dahls%vax.elab.unit.uninett@tor.nta.no !
!------->>>>>>>> %SYSTEM-F-NOBIT, no such bit <<<<<<<<------!
+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+
...................... Cut between dotted lines and save. .....................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.00 26-May-1988.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into onefile and
$! execute (@) that file.
$!
$! This archive was created by user DAHLS
$! on 6-APR-1866 20:07:23.77.
$!
$! It contains the following 1 file:
$! GETKEY.FOR
$!
$!=============================================================================
=
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
"VMS_SHARE V06.00 26-May-1988 requires VMS V4.4 or higher."
$ EXIT 44
$VERSION_OK:
$ GOTO START
$
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE
) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 ); IF s_x = "+" THEN r_skip
:= SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <> 0 THEN s_x := ""
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF
; IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
> 0 THEN s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = "V" THEN s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL
( 1 ); ENDIF; IF s_x = "X" THEN s_x := ""; IF i_append_line <
> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> "" THEN i_errors
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL( 1
); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH( "`"
, FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 )
; IF CURRENT_CHARACTER = "`" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) )
; COPY_TEXT( FAO( "The following !UL errors were detectedwhile unpacking !AS"
, i_errors, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors
, "SYS$COMMAND" ); ENDIF; EXIT;
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
$ RETURN
$
$START:
$ FILE_IS = "GETKEY.FOR"
$ CHECKSUM_IS = 1667153695
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XCASE-; PROG+; MARG-1,72; TAB-F; WHEN 8806 9 17:50:26; VER 44;
X
X program demo_get_key
X
X external get_key
X integer*4 get_key
X
X character*4 msg (9)
X integer*4 block
X byte argblk (37)
X
X data argblk / 09, ! no of blocks.
X & 27,79,80,00, ! PF1
X & 27,79,81,00, ! PF2
X & 27,79,82,00, ! PF3
X & 27,79,83,00, ! PF4
X & 65,00,00,00, ! A
X & 66,00,00,00, ! B
X & 67,00,00,00, ! C
X & 68,00,00,00, ! D
X & 69,88,73,84 / ! EXIT
X data msg / 'PF1 ','PF2 ','PF3 ','PF4 ',
X & 'A ','B ','C ','D ',
X & 'EXIT' /
X
X block = 0
X do while ( block .ne. 9 ) ! repeat until EXIT
X block = get_key (argblk,0)
X write (*,100) block,msg(block)
X enddo
X
X100 format (x,i3,2x,a4)
X end
X
XC=====================================================================
X function get_key ( argblk,case )
X!
X! Argblk structure (byte array):
X!
X! arg 1 : no of blocks in argument (n).
X! blokk 1 : key sequence 1 = argblk(2 : 5)
X! .
X! .
X! blokk n : key sequence n = argblk(n*4-2 : n*4+1)
X!
X! If CASE is true, lower case are trans. to upper case.
X!
X! The routine will return a pointer to the block which was satisfied.
X!
X implicit none
X
X include '($iodef)/nolist'
X include '($ssdef)/nolist'
X
X external sys$assign, sys$qiow, sys$dassgn
X integer*4 sys$assign, sys$qiow, sys$dassgn
X
X integer*4 get_key
X integer*4 ant, fcnt, fp, func, i, p, status
X integer*2 channel
X logical*1 case, key, ant_bin(4), argblk(1:*)
X
X equivalence (ant,ant_bin(1))
X
X status = sys$assign (%descr('SYS$OUTPUT'),%ref(channel),,)
X if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X
X ant = 0
X ant_bin(1) = argblk(1)
X
X p = 0
X func = io$_ttyreadall .or. io$m_noecho
X do while ( .true. )
X
X status = sys$qiow (,%val(channel),%val(func),,,,%ref(key),
X & %val(1),,,,)
X if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X if ( case .and. key .ge. 97 .and. key .le. 122 ) key = key-32
X
X fcnt = 0
X do i = 1,ant
X if ( key .eq. argblk(i*4+p-2) ) then
X if ( argblk(i*4+p-1) .eq. 0 ) then
X get_key = i
X goto 1000
X else
X fp = i
X fcnt = fcnt+1
X endif
X endif
X enddo
X if ( fcnt .gt. 0 ) then
X if ( fcnt .eq. 1 .and. p .eq. 4 ) then
X get_key = fp
X goto 1000
X elseif ( p .eq. 4 ) then
X p = 0
X endif
X p = p+1
X else
X p = 0
X endif
X enddo
X
X 1000 continue
X status = sys$dassgn (%val(channel))
X if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X
X return
X end
X
$ GOSUB UNPACK_FILE
$ EXIT