Trailing-Edge
-
PDP-10 Archives
-
BB-K840A-BM_1981
-
sources/st.for
There are no other files named st.for in the archive.
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C st> VK100 control
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C operating system dependent switches from RATLIB
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C copyright notice
C
C
C C O P Y R I G H T
C
C
C Copyright (C) 1980 by
C Digital Equipment Corporation, Maynard, Mass.
C
C
C This software is furnished under a license and may be used and
C copied only in accordance with the terms of such license and
C with the inclusion of the above copyright notice. This
C software or any other copies thereof may not be provided or
C otherwise made available to any other person. No title to and
C ownership of the software is hereby transferred.
C
C The information in this software is subject to change without
C notice and should not be construed as a commitment by Digital
C Equipment Corporation.
C
C DIGITAL assumes no responsibility for the use or reliability
C of its software on equipment that is not supplied by DIGITAL.
C
C ** Symbolic definitions **
C data types
C define character byte
C max string storage
C max number of string indices
C important string indices (see ss module)
C coord - axis codes
C cpystr - option codes
C dcs - function codes
C ffopen - modes
C ffopen - logical file numbers
C utty - function codes
C codes returned by keypad function
C parameter codes
C screen areas
C column number of text in aea 2
C character types
C composites
C CTKEY = CTALPHA + CTNUM + CTHYPH
C legal filename characters are defined in pflnm (sp module)
C colors
C maximum time between slides
C screen dimensions (pixels)
C character definitions
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C character definitions
C To simplify area and object positioning on the VK100 screen,
C this module contains definitions of points and a subroutine
C to reference them. Points are numbered according to the map below.
C
C The p0def array contains X and Y coordinates of all points.
C The coord function returns the X or Y coordinate of a point.
C Map of Points
C
C 2
C 1 ------------------------------------------------
C ! ! !
C ! ! !
C ! ! !
C ! ! !
C ! ! !
C ! ! !
C 3 ------------------------------------------------ 4
C ! 6 !
C ! !
C ------------------------------------------------ 5
block data
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C stcom>
common / stcom / p0def ( 8 , 2 ) , p1def ( 5 , 2 ) , p2def ( 1 ,
*2 ) , p3def ( 4 , 2 ) , nogrph
C x,y coordinates of points in area 0
C x,y coordinates of points in area 1
C x,y coordinates of points in area 2
C x,y coordinates of points in area 3
C if nonzero, don't send <esc>Pp sequence
data p0def ( 1 , 1 ) , p0def ( 1 , 2 ) , p0def ( 2 , 1 ) , p0def (
* 2 , 2 ) / 0 , 0 , 350 , 0 /
data p0def ( 3 , 1 ) , p0def ( 3 , 2 ) , p0def ( 4 , 1 ) , p0def (
* 4 , 2 ) / 0 , 436 , 767 , 436 /
data p0def ( 5 , 1 ) , p0def ( 5 , 2 ) , p0def ( 6 , 1 ) , p0def (
* 6 , 2 ) / 767 , 479 , 350 , 436 /
data nogrph / 0 /
end
C clr - clear area and call dcs
C area: AREAn, or 0 to do entire screen
C if area == 0, background color is set to black
C func: dcs function code
subroutine clr ( area , func )
implicit integer ( a - z )
integer cp ( 3 , 2 )
C corner points, 1st subscript is area
data cp ( 1 , 1 ) , cp ( 1 , 2 ) / 1 , 6 /
C area 1
data cp ( 2 , 1 ) , cp ( 2 , 2 ) / 2 , 4 /
C area 2
data cp ( 3 , 1 ) , cp ( 3 , 2 ) / 3 , 5 /
C area 3
call dcs ( - 3 )
C put VK100 in graphics mode
if(.not.( area .eq. 0 ))goto 23000
call pr0 ( 62 )
C @62 s(i0,e)
goto 23001
23000 continue
point1 = cp ( area , 1 )
point2 = cp ( area , 2 )
x1 = coord ( point1 , 1 )
y1 = coord ( point1 , 2 )
x2 = coord ( point2 , 1 )
y2 = coord ( point2 , 2 )
call pr4 ( 63 , x1 , y1 , y2 , x2 )
C @63 p[%d,%d]w(s1)p[,%d]v(w(e))[%d]
23001 continue
call dcs ( func )
end
C coord - return coordinate of point
integer function coord ( point , xy )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C stcom>
common / stcom / p0def ( 8 , 2 ) , p1def ( 5 , 2 ) , p2def ( 1 ,
*2 ) , p3def ( 4 , 2 ) , nogrph
C x,y coordinates of points in area 0
C x,y coordinates of points in area 1
C x,y coordinates of points in area 2
C x,y coordinates of points in area 3
C if nonzero, don't send <esc>Pp sequence
coord = p0def ( point , xy )
end
C dcs - send device control strings
subroutine dcs ( func )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C stcom>
common / stcom / p0def ( 8 , 2 ) , p1def ( 5 , 2 ) , p2def ( 1 ,
*2 ) , p3def ( 4 , 2 ) , nogrph
C x,y coordinates of points in area 0
C x,y coordinates of points in area 1
C x,y coordinates of points in area 2
C x,y coordinates of points in area 3
C if nonzero, don't send <esc>Pp sequence
dimension f2n ( 10 )
C function code to string number mapping
C CLR #@31 \033[2J
C EOL #@32 \033[K
C CMD1 #@33 \033[23;1H\033[K
C CMD2 #@34 \033[24;1H\033[K
C TANS #@35 \033<
C TRES #@36 \033[?2l
C FCIM #@37 \033[1;1H\033[K
C FCDG #@38 \033[2;1H\033[K
C MMPR #@39 \033[22;1H\n
C HCPY #@40 \033#7
data f2n ( 1 ) , f2n ( 2 ) , f2n ( 3 ) , f2n ( 4 ) , f2n ( 5 ) , f
*2n ( 6 ) / 31 , 32 , 33 , 34 , 35 , 36 /
data f2n ( 7 ) , f2n ( 8 ) , f2n ( 9 ) , f2n ( 10 ) / 37 , 38 , 39
* , 40 /
data modef / - 2 /
if(.not.( func .eq. - 4 ))goto 23002
f2n ( 5 ) = 1
f2n ( 6 ) = 1
return
23002 continue
if(.not.( func .gt. 0 ))goto 23004
if(.not.( modef .ne. - 2 ))goto 23006
call pr0 ( 101 )
modef = - 2
23006 continue
call pr0 ( f2n ( func ) )
return
23004 continue
f1 = func
C don't clobber caller's func code
if(.not.( f1 .eq. - 3 .and. nogrph .ne. 0 ))goto 23008
f1 = - 2
23008 continue
if(.not.( f1 .ne. modef ))goto 23010
if(.not.( modef .ne. - 2 ))goto 23012
call pr0 ( 101 )
23012 continue
C @101 \033\\
if(.not.( f1 .ne. - 2 ))goto 23014
ch = 112
if(.not.( f1 .ne. - 3 ))goto 23016
ch = 114
23016 continue
call pr1 ( 102 , ch )
C @102 \033P%c
23014 continue
modef = f1
23010 continue
end
C lmode - toggle stuff for reading from keypad
C argument is string to display in area 3 line 1
subroutine lmode ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C subscript is string #, contains index into sv
dimension utfn ( 2 )
data curlm , utfn ( 1 ) , utfn ( 2 ) / 0 , 5 , 4 /
if(.not.( sv ( sx ( sno ) ) .ne. 0 ))goto 23018
call dcs ( 3 )
call pr0 ( sno )
23018 continue
curlm = mod ( curlm + 1 , 2 )
C toggle
call utty ( utfn ( curlm + 1 ) )
call dcs ( - 1 )
call pr2 ( 103 , curlm , curlm )
C @103 SC%dKP%dVC1
end
C posgc - position graphics cursor with respect to point
C xoff and yoff are pixel offsets
subroutine posgc ( point , xoff , yoff )
implicit integer ( a - z )
call dcs ( - 3 )
call pr2 ( 3 , coord ( point , 1 ) + xoff , coord ( point , 2 ) +
*yoff )
end
C posgcc - like posgc, except offsets are characters */
subroutine posgcc ( point , xoff , yoff )
implicit integer ( a - z )
call posgc ( point , xoff * 9 , yoff * 20 )
end
C postc - position text-mode cursor
C pos: row * 80 + column (0 <= row <= 23, 0 <= column <= 79)
subroutine postc ( pos )
implicit integer ( a - z )
call dcs ( - 2 )
C put VK100 in text mode
call pr2 ( 60 , pos / 80 + 1 , mod ( pos , 80 ) + 1 )
C @60 \033[%d;%dH
end
C qchar - return string # of string containing quoted character
integer function qchar ( ch )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C subscript is string #, contains index into sv
i = sx ( 4 )
q = 34
if(.not.( ch .eq. 34 ))goto 23020
q = 39
23020 continue
sv ( i ) = q
sv ( i + 1 ) = ch
sv ( i + 2 ) = q
qchar = 4
end
C resett - select font and set "normal" attributes for ReGIS T command
subroutine resett ( font )
call dcs ( - 3 )
call pr1 ( 110 , font )
C @110 w(r)t(a%d,d0,s1,i0)
end
C regis - write ReGIS string
subroutine regis ( sno )
implicit integer ( a - z )
call dcs ( - 3 )
call pr0 ( sno )
call putc ( 59 )
end
C wrtch - give ReGIS T command to write character
subroutine wrtch ( ch )
implicit integer ( a - z )
call putc ( 116 )
call pr0 ( qchar ( ch ) )
end
C wrtstr - write string with ReGIS T command
subroutine wrtstr ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C subscript is string #, contains index into sv
integer sp
sp = sx ( sno )
call putc ( 116 )
call putc ( 34 )
continue
23022 if(.not.( . true . ))goto 23023
ch = sv ( sp )
sp = sp + 1
if(.not.( ch .eq. 0 ))goto 23024
goto 23023
23024 continue
call putc ( ch )
if(.not.( ch .eq. 34 ))goto 23026
call putc ( 34 )
23026 continue
goto 23022
23023 continue
call putc ( 34 )
end