Trailing-Edge
-
PDP-10 Archives
-
BB-K840A-BM_1981
-
sources/ss.for
There are no other files named ss.for in the archive.
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C ss> String-manipulation routines
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 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 SNTFL: Tray filespec
C @5 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
C SNUST: Utility area, used for building strings - 250 characters
C @6 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx^
C xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx^
C xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
C SNREG: Memory for ReGIS command - 100 characters
C @7 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
C SNCKY: Main command keyword table (defined in module gm)
C SNSFL: Slide filespec
C @9 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
C SNOBJ: Object name
C @10 xxxxxxxxxx
C SNTAG1, SNTAG2: tags
C @11 xxxxxxxxxx
C @12 xxxxxxxxxx
C SNTRX, SNSLX: tray and slide file types, currently null
C @13 .sho
C @14 .pic
C SNRREG: Reset VK100 ReGIS attributes to default values
C @15 w(p(m2)1m1i7va0n0)
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
C cmpstr - compare two strings
C s1,s2: string numbers of strings to compare
C returns: 0 strings are equal, else 1
integer function cmpstr ( s1 , s2 )
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 p1 , p2
integer c
p1 = sx ( s1 )
p2 = sx ( s2 )
C get pointers to strings
cmpstr = 1
C assume not equal
continue
23000 continue
c = sv ( p1 )
C get char from string 1
if(.not.( c .ne. sv ( p2 ) ))goto 23003
return
23003 continue
C return if not equal
p1 = p1 + 1
p2 = p2 + 1
C step to next character
23001 if(.not.( c .eq. 0 ))goto 23000
23002 continue
C stop loop at eos
cmpstr = 0
C congrats, you win
end
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 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
if(.not.( iand ( opt , 512 ) .ne. 0 ))goto 23005
uptr = iuptr
23005 continue
sp = sx ( sno )
C get pointer to source string
continue
23007 if(.not.( . true . ))goto 23008
ch = sv ( sp )
C get char
sp = sp + 1
if(.not.( ch .eq. 0 ))goto 23009
goto 23008
C end of string
23009 continue
call putu ( ch )
C transfer to SNUST
goto 23007
23008 continue
if(.not.( iand ( opt , 256 ) .ne. 0 ))goto 23011
call putu ( 0 )
23011 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 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
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 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
gscq = gsc ( ptr )
if(.not.( gscq .eq. 34 ))goto 23013
C got a quote?
gscq = gsc ( ptr )
C yes, have to look at next char
if(.not.( gscq .ne. 34 ))goto 23015
gscq = 0
23015 continue
C non-quote, end of string
23013 continue
end
subroutine pr0 ( 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
sx1 = sx ( sno )
continue
23017 if(.not.( . true . ))goto 23018
ch = gsc ( sx1 )
if(.not.( ch .eq. 0 ))goto 23019
return
23019 continue
call putc ( ch )
goto 23017
23018 continue
end
subroutine pr1 ( sno , a1 )
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
sx1 = sx ( sno )
continue
23021 if(.not.( . true . ))goto 23022
ch = gsc ( sx1 )
if(.not.( ch .eq. 0 ))goto 23023
return
23023 continue
if(.not.( ch .eq. 37 ))goto 23025
call prarg ( gsc ( sx1 ) , a1 )
goto 23026
23025 continue
call putc ( ch )
23026 continue
goto 23021
23022 continue
end
subroutine pr2 ( sno , a1 , a2 )
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
sx1 = sx ( sno )
a0 = a1
continue
23027 if(.not.( . true . ))goto 23028
ch = gsc ( sx1 )
if(.not.( ch .eq. 0 ))goto 23029
return
23029 continue
if(.not.( ch .eq. 37 ))goto 23031
call prarg ( gsc ( sx1 ) , a0 )
a0 = a2
goto 23032
23031 continue
call putc ( ch )
23032 continue
goto 23027
23028 continue
end
subroutine pr4 ( sno , a1 , a2 , a3 , a4 )
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
sx1 = sx ( sno )
b1 = a1
b2 = a2
b3 = a3
continue
23033 if(.not.( . true . ))goto 23034
ch = gsc ( sx1 )
if(.not.( ch .eq. 0 ))goto 23035
return
23035 continue
if(.not.( ch .eq. 37 ))goto 23037
call prarg ( gsc ( sx1 ) , b1 )
b1 = b2
b2 = b3
b3 = a4
goto 23038
23037 continue
call putc ( ch )
23038 continue
goto 23033
23034 continue
end
subroutine prarg ( typ , arg )
implicit integer ( a - z )
if(.not.( typ .eq. 99 ))goto 23039
call putc ( arg )
return
23039 continue
if(.not.( typ .eq. 100 ))goto 23041
call putdec ( arg , 0 , 0 )
return
23041 continue
if(.not.( typ .eq. 115 ))goto 23043
call pr0 ( arg )
return
23043 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
23045 if(.not.(i.le.7))goto 23047
dstr ( i ) = 32
23046 i=i+1
goto 23045
23047 continue
dx = 8
continue
23048 continue
dx = dx - 1
dstr ( dx ) = mod ( n , 10 ) + 48
n = n / 10
23049 if(.not.( n .eq. 0 ))goto 23048
23050 continue
if(.not.( num .lt. 0 .or. signf .eq. 1 ))goto 23051
dx = dx - 1
if(.not.( num .ge. 0 ))goto 23053
dstr ( dx ) = 43
goto 23054
23053 continue
dstr ( dx ) = 45
23054 continue
23051 continue
if(.not.( fsize .gt. 0 ))goto 23055
dx = 8 - fsize
23055 continue
continue
i = dx
23057 if(.not.(i.le.7))goto 23059
call putc ( dstr ( i ) )
23058 i=i+1
goto 23057
23059 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 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
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 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
sv ( uptr ) = ch
uptr = uptr + 1
if(.not.( ch .eq. 34 ))goto 23060
sv ( uptr ) = 34
uptr = uptr + 1
23060 continue
end