Trailing-Edge
-
PDP-10 Archives
-
BB-K829A-BM_1981
-
sources/gs.for
There are no other files named gs.for in the archive.
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gs> String-manipulation routines
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C operating system dependent switches
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 string index storage
C important string indices (see gs module)
C cdisp - function codes
C coord - axis codes
C cpystr - option codes
C da1 - function codes
C da2 - function codes
C dcs - function codes
C ffopen - modes
C frtyp - record types
C (careful - used in computed goto's)
C ftran - function codes
C undo - function codes
C utty - function codes
C codes returned by keypad function
C character types
C composites
C CTKEY = CTALPHA + CTNUM + CTHYPH
C CTFILE = CTALPHA + CTNUM + CTDOT + CTSLASH + CTCOLON
C colors - temporarily all white
C screen dimensions (pixels)
C displays in area 3
C must match showtab in gm
C maximum mosaic dimensions
C dimensions of mosaic display window
C quan to subtract from char to get fmat/fmatc subscript
C lowest, highest, number of characters in VK100 font
C number of loadable fonts in VK100
C character definitions
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C character definitions
C Important strings
C SNNUL: null string #@1x
C SNINP: Terminal input string - 100 characters
C @2 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
C SNPOS: Position graphics cursor #@3 p[%d,%d]
C SNQCH: Quoted character returned by qchar #@4 xxx
C SNFIL: Filename string
C @5 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
C SNUST: Utility area, used for building strings - 100 characters
C @6 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
C SNREG: Memory for ReGIS command - 100 characters
C @7 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
C SNCKY: Main command keyword table (defined in module gm)
C SNFNM: Font name - 10 characters (NOT the same as font file name!)
C @9 xxxxxxxxxx
C cpystr - copy string into SNUST
C uptr points to destination, updated to point to char after string
C sno: string number of source string
C opt: sum of CPINIT reset uptr to iuptr before copying
C CPNUL put null at end of string
subroutine cpystr ( sno , opt )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
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 string vector - ALL strings live here
C subscript is string #, contains index into sv
integer sp
if(.not.( iand ( opt , 512 ) .ne. 0 ))goto 23000
uptr = iuptr
23000 continue
sp = sx ( sno )
C get pointer to source string
continue
23002 if(.not.( . true . ))goto 23003
ch = sv ( sp )
C get char
sp = sp + 1
if(.not.( ch .eq. 0 ))goto 23004
goto 23003
C end of string
23004 continue
call putu ( ch )
C transfer to SNUST
goto 23002
23003 continue
if(.not.( iand ( opt , 256 ) .ne. 0 ))goto 23006
call putu ( 0 )
23006 continue
C tie it off if requested
end
C gsc - get next string character and increment pointer
integer function gsc ( ptr )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
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 string vector - ALL strings live here
C subscript is string #, contains index into sv
gsc = sv ( ptr )
ptr = ptr + 1
end
C gscq - get character from quoted string; if "" is seen, one "
C is returned; if "x (where x != ") is seen, 0 is returned
C ptr: sv index, incremented appropriately
integer function gscq ( ptr )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
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 string vector - ALL strings live here
C subscript is string #, contains index into sv
gscq = gsc ( ptr )
if(.not.( gscq .eq. 34 ))goto 23008
C got a quote?
gscq = gsc ( ptr )
C yes, have to look at next char
if(.not.( gscq .ne. 34 ))goto 23010
gscq = 0
23010 continue
C non-quote, end of string
23008 continue
end
C The pr<n> routines print a string with argument substitution.
C The number of substitutions is n (e.g., pr2 provides 2 sub's).
C The first argument in the call is the string index of the
C formatting string, which contains text. Substitutions occur
C when a percent sign appears in the formatting string. The
C character following the % indicates the type:
C
C c - single character
C d - decimal number
C s - string
subroutine pr0 ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
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 string vector - ALL strings live here
C subscript is string #, contains index into sv
sx1 = sx ( sno )
continue
23012 if(.not.( . true . ))goto 23013
ch = gsc ( sx1 )
if(.not.( ch .eq. 0 ))goto 23014
return
23014 continue
call putc ( ch )
goto 23012
23013 continue
end
subroutine pr1 ( sno , a1 )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
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 string vector - ALL strings live here
C subscript is string #, contains index into sv
sx1 = sx ( sno )
continue
23016 if(.not.( . true . ))goto 23017
ch = gsc ( sx1 )
if(.not.( ch .eq. 0 ))goto 23018
return
23018 continue
if(.not.( ch .eq. 37 ))goto 23020
call prarg ( gsc ( sx1 ) , a1 )
goto 23021
23020 continue
call putc ( ch )
23021 continue
goto 23016
23017 continue
end
subroutine pr2 ( sno , a1 , a2 )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
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 string vector - ALL strings live here
C subscript is string #, contains index into sv
sx1 = sx ( sno )
a0 = a1
continue
23022 if(.not.( . true . ))goto 23023
ch = gsc ( sx1 )
if(.not.( ch .eq. 0 ))goto 23024
return
23024 continue
if(.not.( ch .eq. 37 ))goto 23026
call prarg ( gsc ( sx1 ) , a0 )
a0 = a2
goto 23027
23026 continue
call putc ( ch )
23027 continue
goto 23022
23023 continue
end
subroutine pr4 ( sno , a1 , a2 , a3 , a4 )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
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 string vector - ALL strings live here
C subscript is string #, contains index into sv
sx1 = sx ( sno )
b1 = a1
b2 = a2
b3 = a3
continue
23028 if(.not.( . true . ))goto 23029
ch = gsc ( sx1 )
if(.not.( ch .eq. 0 ))goto 23030
return
23030 continue
if(.not.( ch .eq. 37 ))goto 23032
call prarg ( gsc ( sx1 ) , b1 )
b1 = b2
b2 = b3
b3 = a4
goto 23033
23032 continue
call putc ( ch )
23033 continue
goto 23028
23029 continue
end
subroutine prarg ( typ , arg )
implicit integer ( a - z )
if(.not.( typ .eq. 99 ))goto 23034
call putc ( arg )
return
23034 continue
if(.not.( typ .eq. 100 ))goto 23036
call putdec ( arg , 0 , 0 )
return
23036 continue
if(.not.( typ .eq. 115 ))goto 23038
call pr0 ( arg )
return
23038 continue
end
C putdec - write decimal number to terminal
C num: number
C fsize: field size (0 if variable)
C signf: 1 to get + sign on positive numbers
subroutine putdec ( num , fsize , signf )
implicit integer ( a - z )
dimension dstr ( 7 )
n = iabs ( num )
continue
i = 1
23040 if(.not.(i.le.7))goto 23042
dstr ( i ) = 32
23041 i=i+1
goto 23040
23042 continue
dx = 8
continue
23043 continue
dx = dx - 1
dstr ( dx ) = mod ( n , 10 ) + 48
n = n / 10
23044 if(.not.( n .eq. 0 ))goto 23043
23045 continue
if(.not.( num .lt. 0 .or. signf .eq. 1 ))goto 23046
dx = dx - 1
if(.not.( num .ge. 0 ))goto 23048
dstr ( dx ) = 43
goto 23049
23048 continue
dstr ( dx ) = 45
23049 continue
23046 continue
if(.not.( fsize .gt. 0 ))goto 23050
dx = 8 - fsize
23050 continue
continue
i = dx
23052 if(.not.(i.le.7))goto 23054
call putc ( dstr ( i ) )
23053 i=i+1
goto 23052
23054 continue
end
C putu - add character to SNUST and increment uptr
subroutine putu ( ch )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
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 string vector - ALL strings live here
C subscript is string #, contains index into sv
sv ( uptr ) = ch
uptr = uptr + 1
end
C putuq - like putu, except if char is ", it puts 2 of them
subroutine putuq ( ch )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
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 string vector - ALL strings live here
C subscript is string #, contains index into sv
sv ( uptr ) = ch
uptr = uptr + 1
if(.not.( ch .eq. 34 ))goto 23055
sv ( uptr ) = 34
uptr = uptr + 1
23055 continue
end