
c
c VTSTUFF.FOR is a collection of subroutines to control the vt-100 from
c FORTRAN and, when used with application programs, save the user from
c having to rewrite the similar routines for each application.
c
c vt100_clear_screen:
c vt100_locate_cursor:
c vt100_move_cursor:
c vt100_scroll_region:
c vt100_attributes_off:
c vt100_boldface_on:
c vt100_underscore_on:
c vt100_blink_on:
c vt100_reverse_video_on:
c vt100_double_width_line:
c set_graphics_mode:
c set_ASCII_mode:
c vt100_draw_box:
c vt100_read_keystroke:
c vt100_read_noecho:
c vt100_read_nowait:
c vt100_write:
c vt100_write:
c vt100_dump_buffer
c vt100_beep:
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_data
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c package wide data definitions
c Input: None
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c
c qio definition common
c
	LOGICAL qio_initialization_done
	LOGICAL keyboard_armed
	CHARACTER*100 devdsc
	INTEGER*2 iosb(4)
	INTEGER*2 ttchan
	INTEGER*4 qefn
	INTEGER*4 nowait_efn
	INTEGER*4 ef_state
	INTEGER*4 onebyte
	INTEGER*4 io_readvblk
	INTEGER*4 io_readvblk_noecho
	INTEGER*4 io_writevblk
	COMMON /qio_param/initialization_done,
     +                    keyboard_armed,
     +                    devdsc,
     +                    iosb,
     +                    ttchan,
     +                    qefn,
     +                    nowait_efn,
     +                    ef_state,
     +                    onebyte,
     +                    io_readvblk,
     +                    io_readvblk_noecho,
     +                    io_writevblk
	DATA initialization_done /.FALSE./
	DATA keyboard_armed      /.FALSE./
	DATA io_readvblk         /'31'X  /
	DATA io_readvblk_noecho  /'61'X  /	!io_readvblk .OR. IO$M_NOECHO
	DATA io_writevblk        /'30'X  /
	DATA onebyte             /1      /
	DATA nowait_efn          /33     /
	DATA qefn                /2      /

c
c
c screen buffer common
c
	BYTE      send_buffer(1500)
	INTEGER*4 send_buffer_max
	INTEGER*4 send_buffer_length
	COMMON	  /buffer_write/send_buffer_max,
     +                          send_buffer_length,
     +                          send_buffer
	DATA	  send_buffer_length/0/
	DATA      send_buffer_max/1500/
c
c
c character definition common
c
	END

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_clear_screen(vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only
c Input: None
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command escape sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(4)
	DATA escape_sequence/"33,"133,"62,"112/
c
c
c                       executable
c
	vt100_status = .TRUE.
	CALL vt100_write(escape_sequence,4,vt100_status)
	RETURN
1	FORMAT('+',4A1,$)
	END
c
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_locate_cursor(x_position,y_position,vt100_status)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, locate the cursor and return x and y 
c coordinates
c Input: None
c Output x_position, y_position
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command escape sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(4)
	BYTE position_report(8)
	BYTE array_pointer
	BYTE x_position
	BYTE y_position
	DATA escape_sequence/"33,"133,"66,"156/
c
c
c                       executable
c
	vt100_status = .TRUE.
	CALL vt100_write(escape_sequence,4,vt100_status)
	i = 1
100	CONTINUE	
		CALL vt100_read_noecho(position_report(i),vt100_status)
		IF (position_report(i) .EQ. "122) THEN 
			GOTO 200
		ENDIF
		i = i + 1
		GOTO 100
200	CONTINUE
c
c	
c convert first parameter from ASCII to integer.
c
	y_position = position_report(3) - "60
	array_pointer = 4
	IF ( position_report(array_pointer) .NE. "73) THEN
		y_position = (y_position * 10) + 
     &		             (position_report(array_pointer) - "60) 
		array_pointer = 5
	ENDIF
	array_pointer = array_pointer + 1
c
c
c convert second parameter from ASCII to integer.
c
	x_position = position_report(array_pointer) - "60
	array_pointer = array_pointer + 1
	IF ( position_report(array_pointer) .NE. "122) THEN
		x_position = (x_position * 10) + 
     &		             (position_report(array_pointer) - "60) 
	ENDIF
	RETURN
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_move_cursor(x_position,y_position,vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, range check input then move cursor
c Input: x and y coordinate to move the cursor to.
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(6)
	BYTE x_position,y_position
	BYTE expanded_escape_sequence(10)
	INTEGER*4 expanded_length
	DATA escape_sequence/"33,"133,"60,"73,"60,"110/
c
c
c                       executable
c
	vt100_status = .TRUE.
	IF  ( (x_position .LT. 0 ) .OR.
     &        (x_position .GT. 80) .OR.
     &        (y_position .LT. 0 ) .OR.
     &        (y_position .GT. 24) ) THEN
		vt100_status = .FALSE.
	ELSE
		CALL expand(escape_sequence,x_position,y_position,
     &                      expanded_escape_sequence,expanded_length)
		CALL vt100_write(expanded_escape_sequence,expanded_length,
     &			vt100_status)
	ENDIF		
	RETURN
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_scroll_region(region_top,region_bottom,vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, range check input then move set scrolling
c region.
c Input: top and bottom of scrolling region.
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(6)
	BYTE region_top,region_bottom
	BYTE expanded_escape_sequence(10)
	INTEGER*4 expanded_length
	DATA escape_sequence/"33,"133,"60,"73,"24,"162/
c
c
c                       executable
c
	vt100_status = .TRUE.
	IF  ( (region_top    .LT. 0 ) .OR.
     &        (region_top    .GT. 80) .OR.
     &        (region_bottom .GT. 0 ) .OR.
     &        (region_bottom .GT. 24) .OR.
     &        (region_top .GE. region_bottom) ) THEN
		vt100_status = .FALSE.
	ELSE
		CALL expand(escape_sequence,region_top,region_bottom,
     &                      expanded_escape_sequence,expanded_length)
		CALL vt100_write(expanded_escape_sequence,expanded_length,
     &			vt100_status)
	ENDIF		
	RETURN
1	FORMAT('+',6A1,$)
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE expand(escape_sequence,input_x,input_y,
     &                    expanded_escape_sequence,expanded_length)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c Internal Use, convert bytes (used by program) to ASCII (used by VT100)
c expanding escape sequence to the correct number of bytes to allow two
c digit parameters for things like move cursor and set scrolling region.
c Input: two input bytes.
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	BYTE input_y,input_x
	BYTE ones,tens,ten_subtract
	INTEGER*4 expanded_length
	BYTE expanded_escape_sequence(10)
	BYTE escape_sequence(6)
	INTEGER*2 loop_index
c
c
c                       executable
c
	expanded_escape_sequence(1) = "33
	expanded_escape_sequence(2) = "133
	expanded_length = 3
	IF (input_y .GT. 9) THEN
		tens = input_y / 10
		tens_subtract = tens * 10
		ones = input_y - tens_subtract
		expanded_escape_sequence(expanded_length) = tens + "60
		expanded_length = expanded_length + 1
		expanded_escape_sequence(expanded_length) = ones + "60
		expanded_length = expanded_length + 1
	ELSE			
		expanded_escape_sequence(expanded_length) = input_y + "60
		expanded_length = expanded_length + 1
	ENDIF
	expanded_escape_sequence(expanded_length) = "73
	expanded_length = expanded_length + 1
	IF (input_x .GT. 9) THEN
		tens = input_x / 10
		tens_subtract = tens * 10
		ones = input_x - tens_subtract
		expanded_escape_sequence(expanded_length) = tens + "60
		expanded_length = expanded_length + 1
		expanded_escape_sequence(expanded_length) = ones + "60
		expanded_length = expanded_length + 1
	ELSE			
		expanded_escape_sequence(expanded_length) = input_x + "60
		expanded_length = expanded_length + 1
	ENDIF
	expanded_escape_sequence(expanded_length) = escape_sequence(6)

	RETURN
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_attributes_off(vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, get rid of all character attributes such
C as boldface.
c Input: None
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(4)
	DATA escape_sequence/"33,"133,"60,"155/
c
c
c                       executable
c
	vt100_status = .TRUE.
	CALL vt100_write(escape_sequence,4,vt100_status)
	RETURN
1	FORMAT('+',4A1,$)
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_boldface_on(vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, turn on boldface
C as boldface.
c Input: None
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(4)
	DATA escape_sequence/"33,"133,"61,"155/
c
c
c                       executable
c
	vt100_status = .TRUE.
	CALL vt100_write(escape_sequence,4,vt100_status)
	RETURN
1	FORMAT('+',4A1,$)
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_underscore_on(vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, turn on underscore
C as boldface.
c Input: None
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(4)
	DATA escape_sequence/"33,"133,"64,"155/
c
c
c                       executable
c
	vt100_status = .TRUE.
	CALL vt100_write(escape_sequence,4,vt100_status)
	RETURN
1	FORMAT('+',4A1,$)
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_blink_on(vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, turn on blink
c Input: None
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(4)
	DATA escape_sequence/"33,"133,"65,"155/
c
c
c                       executable
c
	vt100_status = .TRUE.
	CALL vt100_write(escape_sequence,4,vt100_status)
	RETURN
1	FORMAT('+',4A1,$)
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_reverse_video_on(vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, turn on reverse video
c Input: None
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(4)
	DATA escape_sequence/"33,"133,"67,"155/
c
c
c                       executable
c
	vt100_status = .TRUE.
	CALL vt100_write(escape_sequence,4,vt100_status)
	RETURN
1	FORMAT('+',4A1,$)
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_double_width_line(vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, turn on reverse video
c Input: None
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(3)
	DATA escape_sequence/"33,"43,"66/
c
c
c                       executable
c
	vt100_status = .TRUE.
	CALL vt100_write(escape_sequence,3,vt100_status)
	RETURN
1	FORMAT('+',3A1,$)
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE set_graphics_mode(vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, activate special graphics characters
c Input: None
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(3)
	DATA escape_sequence/"33,"50,"60/
c
c
c                       executable
c
	vt100_status = .TRUE.
	CALL vt100_write(escape_sequence,3,vt100_status)
	RETURN
1	FORMAT('+',3A1,$)
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE set_ASCII_mode(vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, activate special graphics characters
c Input: None
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status
	BYTE escape_sequence(3)
	DATA escape_sequence/"33,"50,"102/
c
c
c                       executable
c
	vt100_status = .TRUE.
	CALL vt100_write(escape_sequence,3,vt100_status)
	RETURN
1	FORMAT('+',3A1,$)
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_draw_box(ul_x,ul_y,lr_x,lr_y,vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 draw a box
c Input: screen coordinates of upper left and lower right corners of the
c box.
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status,status
	BYTE ul_corner,ll_corner,ur_corner,lr_corner,vertical,horizontal,blank
	BYTE ul_x,ul_y,lr_x,lr_y
	BYTE horizontal_line(82)
	INTEGER*4 horizontal_line_length
	INTEGER*2 loop_index
	PARAMETER (ul_corner = "154)
	PARAMETER (ll_corner = "155)
	PARAMETER (ur_corner = "153)
	PARAMETER (lr_corner = "152)
	PARAMETER (vertical  = "170)
	PARAMETER (horizontal= "161)
	PARAMETER (blank     = "040)
	DATA horizontal_line/"161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161,"161,"161,"161,
     &                       "161,"161/
c
c
c                       executable
c
	vt100_status = .TRUE.
	IF ( (ul_x .LT.  0) .OR.
     &       (ul_y .LT.  0) .OR.
     &       (ul_x .GT. 80) .OR.
     &       (ul_y .GT. 24) .OR.
     &       (lr_x .LT.  0) .OR.
     &       (lr_y .LT.  0) .OR.
     &       (lr_x .GT. 80) .OR.
     &       (lr_y .GT. 24) .OR.
     &       (ul_x .GE. lr_x) .OR.
     &       (ul_y .GE. lr_y) ) THEN
		vt100_status = .FALSE.
	ELSE
c
c
c set graphics mode
c
		CALL VT100_dump_buffer
		CALL set_graphics_mode(status)
c
c
c draw verticals
c
		loop_index = ul_y+1
		DO WHILE (loop_index .LT. lr_y) 
			CALL vt100_fill_buffer(ul_x,loop_index,vertical,1,status)
			CALL vt100_fill_buffer(lr_x,loop_index,vertical,1,status)
			loop_index = loop_index + 1
		ENDDO			
c
c
c draw horizontals
c
		horizontal_line_length = lr_x - ul_x
		CALL vt100_fill_buffer(ul_x,ul_y,horizontal_line,
     &		                       horizontal_line_length,status)
		CALL vt100_fill_buffer(ul_x,lr_y,horizontal_line,
     &		                       horizontal_line_length,status)
c
c
c draw the four corners last rather than calculating corrections into all
c of the vertical line stuff.
c
		CALL vt100_fill_buffer(ul_x,ul_y,ul_corner,1,status)
		CALL vt100_fill_buffer(ul_x,lr_y,ll_corner,1,status)
		CALL vt100_fill_buffer(lr_x,ul_y,ur_corner,1,status)
		CALL vt100_fill_buffer(lr_x,lr_y,lr_corner,1,status)
	ENDIF
	CALL VT100_dump_buffer
	CALL set_ASCII_mode(status)
	RETURN
1	FORMAT('+',A1,$)
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_read_keystroke(keystroke,vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 read keystroke - does a qio read to the user terminal to get a
c single keystroke and waits until one is received
c Input: none
c Output: a byte containing the ASCII code for the character typed
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define system services used
c
	INTEGER*4 RETURN
	INTEGER*4 SYS$TRNLOG
	INTEGER*4 SYS$ASSIGN
	INTEGER*4 SYS$QIOW
	INTEGER*4 SYS$CANCEL
c
c
c system service call parameters
c
	INTEGER*4 keystroke
c
c
c local data
c
	LOGICAL vt100_status
c
c
c terminal package common
c
	LOGICAL qio_initialization_done
	LOGICAL keyboard_armed
	CHARACTER*100 devdsc
	INTEGER*2 iosb(4)
	INTEGER*2 ttchan
	INTEGER*4 qefn
	INTEGER*4 nowait_efn
	INTEGER*4 ef_state
	INTEGER*4 onebyte
	INTEGER*4 io_readvblk
	INTEGER*4 io_readvblk_noecho
	INTEGER*4 io_writevblk
	COMMON /qio_param/initialization_done,
     +                    keyboard_armed,
     +                    devdsc,
     +                    iosb,
     +                    ttchan,
     +                    qefn,
     +                    nowait_efn,
     +                    ef_state,
     +                    onebyte,
     +                    io_readvblk,
     +                    io_readvblk_noecho,
     +                    io_writevblk
c
c
c                       executable
c
c on the first call, initialize by assigning channel to users terminal
c
	IF (.NOT. initialization_done) THEN
		RETURN=SYS$TRNLOG('SYS$INPUT',,devdsc,,, )
		IF (.NOT. return) THEN
			vt100_status = .FALSE.
		ENDIF	
		RETURN=SYS$ASSIGN( devdsc,ttchan,, )
		IF (.NOT. return) THEN
			vt100_status = .FALSE.
		ENDIF	
		initialization_done = .TRUE.
	ENDIF
	IF (keyboard_armed) THEN
		RETURN = SYS$CANCEL(ttchan)
		keyboard_armed = .FALSE.
	ENDIF
c
c
c issue the qio and wait for a keystroke
c
	RETURN=SYS$QIOW( %VAL(QEFN),            !EFN
     +                   %VAL(ttchan),		!CHAN
     +                   %VAL(io_readvblk),	!FUNC
     +                   IOSB,			!IOSB
     +                   ,,			!ASTADR,ASTPARM
     +                   KEYSTROKE,		!P1
     +                   %VAL(onebyte),		!P2
     +                   ,,,)			!P3,P4,P5
	IF(.NOT. return) THEN
		vt100_status = .FALSE.
	ENDIF
	RETURN
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_read_noecho(keystroke,vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 read keystroke - does a qio read to the user terminal to get a
c single keystroke and waits until one is received
c Input: none
c Output: a byte containing the ASCII code for the character typed
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define system services used
c
	INTEGER*4 RETURN
	INTEGER*4 SYS$TRNLOG
	INTEGER*4 SYS$ASSIGN
	INTEGER*4 SYS$QIOW
	INTEGER*4 SYS$CANCEL
c
c
c system service call parameters
c
	INTEGER*4 KEYSTROKE
c
c
c local data
c
	LOGICAL vt100_status
c
c
c terminal package common
c
	LOGICAL qio_initialization_done
	LOGICAL keyboard_armed
	CHARACTER*100 devdsc
	INTEGER*2 iosb(4)
	INTEGER*2 ttchan
	INTEGER*4 qefn
	INTEGER*4 nowait_efn
	INTEGER*4 ef_state
	INTEGER*4 onebyte
	INTEGER*4 io_readvblk
	INTEGER*4 io_readvblk_noecho
	INTEGER*4 io_writevblk
	COMMON /qio_param/initialization_done,
     +                    keyboard_armed,
     +                    devdsc,
     +                    iosb,
     +                    ttchan,
     +                    qefn,
     +                    nowait_efn,
     +                    ef_state,
     +                    onebyte,
     +                    io_readvblk,
     +                    io_readvblk_noecho,
     +                    io_writevblk
c
c
c                       executable
c
c on the first call, initialize by assigning channel to users terminal
c
	IF (.NOT. initialization_done) THEN
		RETURN=SYS$TRNLOG('SYS$INPUT',,devdsc,,, )
		IF (.NOT. return) THEN
			vt100_status = .FALSE.
		ENDIF	
		RETURN=SYS$ASSIGN( devdsc,ttchan,, )
		IF (.NOT. return) THEN
			vt100_status = .FALSE.
		ENDIF	
		initialization_done = .TRUE.
	ENDIF
	IF (keyboard_armed) THEN
		RETURN = SYS$CANCEL(ttchan)
		keyboard_armed = .FALSE.
	ENDIF
c
c
c issue the qio and wait for a keystroke
c
	RETURN=SYS$QIOW( %VAL(QEFN),            !EFN
     +                   %VAL(ttchan),		!CHAN
     +                   %VAL(io_readvblk_noecho),!FUNC
     +                   IOSB,			!IOSB
     +                   ,,			!ASTADR,ASTPARM
     +                   KEYSTROKE,		!P1
     +                   %VAL(onebyte),		!P2
     +                   ,,,)			!P3,P4,P5
	IF(.NOT. return) THEN
		vt100_status = .FALSE.
	ENDIF
	RETURN
	END

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_read_nowait(keystroke,
     +                               keystroke_returned,
     +                               more_keystrokes,
     +                               vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 read keystroke - does a qio read to the user terminal to get a
c keystroke
c Input: none
c Output: a byte containing the ASCII code for the character typed
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define system services used
c
	INTEGER*4 RETURN
	INTEGER*4 SYS$TRNLOG
	INTEGER*4 SYS$ASSIGN
	INTEGER*4 SYS$QIO
	INTEGER*4 SYS$READEF
c
c
c system service call parameters
c
	INTEGER*4 KEYSTROKE
c
c
c local data
c
	LOGICAL first
	DATA first/.TRUE./
	LOGICAL vt100_status
	LOGICAL more_keystrokes
	LOGICAL keystroke_returned
	INTEGER*4 load_pointer
	DATA load_pointer/1/
	INTEGER*4 unload_pointer
	DATA unload_pointer/1/
	INTEGER*4 list_max
	DATA list_max/100/
	INTEGER*4 keystroke_list(100)
c
c
c terminal package common
c
	LOGICAL qio_initialization_done
	LOGICAL keyboard_armed
	CHARACTER*100 devdsc
	INTEGER*2 iosb(4)
	INTEGER*2 ttchan
	INTEGER*4 qefn
	INTEGER*4 nowait_efn
	INTEGER*4 ef_state
	INTEGER*4 onebyte
	INTEGER*4 io_readvblk
	INTEGER*4 io_readvblk_noecho
	INTEGER*4 io_writevblk
	COMMON /qio_param/initialization_done,
     +                    keyboard_armed,
     +                    devdsc,
     +                    iosb,
     +                    ttchan,
     +                    qefn,
     +                    nowait_efn,
     +                    ef_state,
     +                    onebyte,
     +                    io_readvblk,
     +                    io_readvblk_noecho,
     +                    io_writevblk
c
c
c                       executable
c
	vt100_status = .TRUE.
c
c
c if not already done initialize by assigning channel to users terminal 
c
	IF (.NOT. initialization_done) THEN
		RETURN=SYS$TRNLOG('SYS$INPUT',,devdsc,,, )
		IF (.NOT. return) THEN
			vt100_status = .FALSE.
		ENDIF	
		RETURN=SYS$ASSIGN( devdsc,ttchan,, )
		IF (.NOT. return) THEN
			vt100_status = .FALSE.
		ENDIF	
		initialization_done = .TRUE.
	ENDIF
c
c
c if first call, initialize keystroke list and issue the first qio to get
c things started.
c
	IF (keyboard_armed .NE. .TRUE.) THEN
		DO i = 1,list_max
			keystroke_list(i) = 0
		ENDDO
		RETURN=SYS$QIO ( %VAL(nowait_efn),      !EFN
     + 		                 %VAL(ttchan),		!CHAN
     +		                 %VAL(io_readvblk_noecho),!FUNC
     +		                 IOSB,			!IOSB
     +		                 ,,			!ASTADR,ASTPARM
     +		                 keystroke_list(load_pointer),!P1
     +		                 %VAL(onebyte),		!P2
     +				  ,,,)			!P3,P4,P5
		keyboard_armed = .TRUE.
	ENDIF
c
c
c once all is running, post keystroke to the list and reissue the qio to
c read the next keystroke.
c
	RETURN=SYS$READEF( %VAL(nowait_efn),state)
	DO WHILE (return .EQ. 9)
		load_pointer = load_pointer + 1
		IF (load_pointer .GT. list_max) THEN
			load_pointer = 1
		ENDIF
		RETURN=SYS$QIO ( %VAL(nowait_efn),      !EFN
     + 		                 %VAL(ttchan),		!CHAN
     +		                 %VAL(io_readvblk_noecho),!FUNC
     +		                 IOSB,			!IOSB
     +		                 ,,			!ASTADR,ASTPARM
     +		                 keystroke_list(load_pointer),!P1
     +		                 %VAL(onebyte),		!P2
     +				  ,,,)			!P3,P4,P5
		RETURN=SYS$READEF( %VAL(nowait_efn),state)
	ENDDO
c
c
c if there are keystrokes in the list, return the next one to the user
c and return status information.
c
	keystroke_returned = .FALSE.
	more_keystrokes    = .FALSE.
	keystroke = keystroke_list(unload_pointer)
	IF (keystroke .NE. 0) THEN
		keystroke_list(unload_pointer) = 0
		unload_pointer = unload_pointer + 1
		IF (unload_pointer .GT. list_max) THEN
			unload_pointer = 1
		ENDIF
		keystroke_returned = .TRUE.
		IF (load_pointer .NE. unload_pointer) THEN
			more_keystrokes = .TRUE.
		ENDIF
	ENDIF
	RETURN
	END

c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_write(buffer,buffer_length,vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 read keystroke - write a buffer to the screen
c Input: buffer and its length
c Output: buffer to screen
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define system services used
c
	INTEGER*4 RETURN
	INTEGER*4 SYS$TRNLOG
	INTEGER*4 SYS$ASSIGN
	INTEGER*4 SYS$QIOW
c
c
c local data
c
	LOGICAL vt100_status
c
c
c terminal package common
c
	LOGICAL qio_initialization_done
	LOGICAL keyboard_armed
	CHARACTER*100 devdsc
	INTEGER*2 iosb(4)
	INTEGER*2 ttchan
	INTEGER*4 qefn
	INTEGER*4 nowait_efn
	INTEGER*4 ef_state
	INTEGER*4 onebyte
	INTEGER*4 io_readvblk
	INTEGER*4 io_readvblk_noecho
	INTEGER*4 io_writevblk
	COMMON /qio_param/initialization_done,
     +                    keyboard_armed,
     +                    devdsc,
     +                    iosb,
     +                    ttchan,
     +                    qefn,
     +                    nowait_efn,
     +                    ef_state,
     +                    onebyte,
     +                    io_readvblk,
     +                    io_readvblk_noecho,
     +                    io_writevblk
c
c
c                       executable
c
c on the first call, initialize by assigning channel to users terminal
c
	IF (.NOT. initialization_done) THEN
		RETURN=SYS$TRNLOG('SYS$OUTPUT',,devdsc,,, )
		IF (.NOT. return) THEN
			vt100_status = .FALSE.
		ENDIF	
		RETURN=SYS$ASSIGN( devdsc,ttchan,, )
		IF (.NOT. return) THEN
			vt100_status = .FALSE.
		ENDIF	
		initialization_done = .TRUE.
	ENDIF
c
c
c issue the qio and wait for completion
c
	RETURN=SYS$QIOW( %VAL(QEFN),            !EFN
     +                   %VAL(ttchan),		!CHAN
     +                   %VAL(io_writevblk),	!FUNC
     +                   IOSB,			!IOSB
     +                   ,,			!ASTADR,ASTPARM
     +                   BUFFER,		!P1
     +                   %VAL(BUFFER_LENGTH),	!P2
     +                   ,,,)			!P3,P4,P5
	IF(.NOT. return) THEN
		vt100_status = .FALSE.
	ENDIF
	RETURN
	END
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_fill_buffer(x_position,y_position,in_string,
     &                               in_string_length,vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 fill buffer - buffer up screen data to then send in a single QIO
c for greater speed than sending screen data in multiple QIOS.
c Input:  data from application.
c Output: none
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
	LOGICAL   VT100_status
	BYTE      IN_STRING(200)
	BYTE escape_sequence(6)
	INTEGER*4 in_string_length
	INTEGER*4 loop_index
	BYTE x_position,y_position
	BYTE expanded_escape_sequence(10)
	INTEGER*4 expanded_length
	DATA escape_sequence/"33,"133,"60,"73,"60,"110/
c
c
c send buffer common
c
	BYTE      send_buffer(1500)
	INTEGER*4 send_buffer_max
	INTEGER*4 send_buffer_length
	COMMON	  /buffer_write/send_buffer_max,
     +                          send_buffer_length,
     +                          send_buffer
c
c                       executable
c
c
	vt100_status = .TRUE.
c
c
c insure against buffer overruns by dumping everthing buffered so far to
c the screen if adding the next buffer will exceed buffer size.
c
	IF ((in_string_length + send_buffer_length) .GE.
     &                       (send_buffer_max)) THEN
		CALL vt100_dump_buffer
	ENDIF
c
c
c range check on cursor position
c
	IF  ( ( x_position .LT. 0 ) .OR.
     &        ((x_position + in_string_length -1) .GT. 80) .OR.
     &        ( y_position .LT. 0 ) .OR.
     &        ( y_position .GT. 24) ) THEN
		vt100_status = .FALSE.
	ELSE
		CALL expand(escape_sequence,x_position,y_position,
     &                      expanded_escape_sequence,expanded_length)
		DO loop_index = 1, expanded_length
			send_buffer_length = send_buffer_length + 1
			send_buffer(send_buffer_length) = 
     &				expanded_escape_sequence(loop_index)
		ENDDO
		DO loop_index = 1, in_string_length
			send_buffer_length = send_buffer_length + 1
			send_buffer(send_buffer_length) = in_string(loop_index)
		ENDDO
	ENDIF
	RETURN
	END
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_dump_buffer
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 dump buffer - dump the buffer created by VT100_fill_buffer to the
c screen.
c Input:  none
c Output: buffer to VT100_write.
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
	LOGICAL   VT100_status
c
c
c screen buffer common
c
	BYTE      send_buffer(2000)
	INTEGER*4 send_buffer_max
	INTEGER*4 send_buffer_length
	COMMON	  /buffer_write/send_buffer_max,
     +                          send_buffer_length,
     +                          send_buffer
c
c                       executable
c
	IF (send_buffer_length .GT. 0) THEN
		CALL vt100_write(send_buffer,send_buffer_length,vt100_status)
	ENDIF
	send_buffer_length = 0
	RETURN
	END
c
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	SUBROUTINE vt100_beep(vt100_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c VT100 screen manipulation only, activate special graphics characters
c Input: None
c Output None 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                     data definition
c
c define VT100 command sequence
c
	LOGICAL vt100_status
	BYTE    beep_character
	PARAMETER (beep_character = "7)
c
c
c                       executable
c
	vt100_status = .TRUE.
	CALL vt100_write(beep_character,1,vt100_status)
	RETURN
	END

