Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/comnds.for
There are no other files named comnds.for in the archive.
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
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 define char byte
C 27+128
C w(riting) opt(ion)s come groups of 8:
C (1) replace(0)/erase(1)/complement(2)/overlay(3)
C (2) negative image 0/1
C (3) pattern < 256 bit mask (e.g. 192 = P11000000)
C >= 256 canned pattern * 256 (e.g. 512 = P2)
C if value >= 256, low 8 bits are ignored
C (4) pattern multiplier, different from 6(?)
C (5) shading flag, sim pattern+ >= 10 use char
C (6) if shading != 0 this is y reference val
C (7) pixel multiplier, 1 <= value <= 10
C (8) alternating 0/1
C (9) foreground intensity, 0 <= value <= 7
C (10) background intensity, 0 <= value <= 7
C
C offsets from gwopsp...
C Inktypes...
C Inkolors...
C Text options
C RSTSONLY define Maxgels 1000 # due to limited RAM on RSTS
C drawing primitive gels...
C attribute/marker/other gels...
C writing attribute gels : Woptbase + wopindex
C similarly topts...
C maximum # of characters in a filespec
C maximum # of characters in a command line
C max length of prompt buffer
C max number of characters in file record
C size of record buffers (Fbufsz + 1)
C include logdef
C ========================================================================
C ========================================================================
C typed commands...
C > 255 for regis exec, > 127 otherwise
integer function scncmd ( lin )
integer lin ( 1 )
integer curdx , curdy , smalld , larged
integer scf , lorng , hirng
integer cname ( 75 )
common / keypad / curdx , curdy , smalld , larged , scf , lorng ,
*hirng , cname
integer scnlet , fndtok , scnrng , ctoi
integer cp , rp , cindex , erng
integer tok ( 50 )
integer cmdval ( 20 )
C slist cmdlst
C string cmdstr read *
C string + write *
C string + alter @
C string + copy @
C string + delete .,.
C string + update *
C string + group .,$
C string + move @
C string + scale @
C string + tilt @
C string + label .
C string + name .
C string + quit *
C string + verify *
C string + font 1
C string + join 1
C string + extract *
C string + background *
C elist cmdlst
integer cmdlst ( 18 )
integer cmdstr ( 150 )
data cmdstr ( 1 ) , cmdstr ( 2 ) , cmdstr ( 3 ) , cmdstr ( 4 ) , c
*mdstr ( 5 ) / 114 , 101 , 97 , 100 , 32 /
data cmdstr ( 6 ) , cmdstr ( 7 ) , cmdstr ( 8 ) , cmdstr ( 9 ) , c
*mdstr ( 10 ) / 42 , 0 , 119 , 114 , 105 /
data cmdstr ( 11 ) , cmdstr ( 12 ) , cmdstr ( 13 ) , cmdstr ( 14 )
* , cmdstr ( 15 ) / 116 , 101 , 32 , 42 , 0 /
data cmdstr ( 16 ) , cmdstr ( 17 ) , cmdstr ( 18 ) , cmdstr ( 19 )
* , cmdstr ( 20 ) / 97 , 108 , 116 , 101 , 114 /
data cmdstr ( 21 ) , cmdstr ( 22 ) , cmdstr ( 23 ) , cmdstr ( 24 )
* , cmdstr ( 25 ) / 32 , 64 , 0 , 99 , 111 /
data cmdstr ( 26 ) , cmdstr ( 27 ) , cmdstr ( 28 ) , cmdstr ( 29 )
* , cmdstr ( 30 ) / 112 , 121 , 32 , 64 , 0 /
data cmdstr ( 31 ) , cmdstr ( 32 ) , cmdstr ( 33 ) , cmdstr ( 34 )
* , cmdstr ( 35 ) / 100 , 101 , 108 , 101 , 116 /
data cmdstr ( 36 ) , cmdstr ( 37 ) , cmdstr ( 38 ) , cmdstr ( 39 )
* , cmdstr ( 40 ) / 101 , 32 , 46 , 44 , 46 /
data cmdstr ( 41 ) , cmdstr ( 42 ) , cmdstr ( 43 ) , cmdstr ( 44 )
* , cmdstr ( 45 ) / 0 , 117 , 112 , 100 , 97 /
data cmdstr ( 46 ) , cmdstr ( 47 ) , cmdstr ( 48 ) , cmdstr ( 49 )
* , cmdstr ( 50 ) / 116 , 101 , 32 , 42 , 0 /
data cmdstr ( 51 ) , cmdstr ( 52 ) , cmdstr ( 53 ) , cmdstr ( 54 )
* , cmdstr ( 55 ) / 103 , 114 , 111 , 117 , 112 /
data cmdstr ( 56 ) , cmdstr ( 57 ) , cmdstr ( 58 ) , cmdstr ( 59 )
* , cmdstr ( 60 ) / 32 , 46 , 44 , 36 , 0 /
data cmdstr ( 61 ) , cmdstr ( 62 ) , cmdstr ( 63 ) , cmdstr ( 64 )
* , cmdstr ( 65 ) / 109 , 111 , 118 , 101 , 32 /
data cmdstr ( 66 ) , cmdstr ( 67 ) , cmdstr ( 68 ) , cmdstr ( 69 )
* , cmdstr ( 70 ) / 64 , 0 , 115 , 99 , 97 /
data cmdstr ( 71 ) , cmdstr ( 72 ) , cmdstr ( 73 ) , cmdstr ( 74 )
* , cmdstr ( 75 ) / 108 , 101 , 32 , 64 , 0 /
data cmdstr ( 76 ) , cmdstr ( 77 ) , cmdstr ( 78 ) , cmdstr ( 79 )
* , cmdstr ( 80 ) / 116 , 105 , 108 , 116 , 32 /
data cmdstr ( 81 ) , cmdstr ( 82 ) , cmdstr ( 83 ) , cmdstr ( 84 )
* , cmdstr ( 85 ) / 64 , 0 , 108 , 97 , 98 /
data cmdstr ( 86 ) , cmdstr ( 87 ) , cmdstr ( 88 ) , cmdstr ( 89 )
* , cmdstr ( 90 ) / 101 , 108 , 32 , 46 , 0 /
data cmdstr ( 91 ) , cmdstr ( 92 ) , cmdstr ( 93 ) , cmdstr ( 94 )
* , cmdstr ( 95 ) / 110 , 97 , 109 , 101 , 32 /
data cmdstr ( 96 ) , cmdstr ( 97 ) , cmdstr ( 98 ) , cmdstr ( 99 )
* , cmdstr ( 100 ) / 46 , 0 , 113 , 117 , 105 /
data cmdstr ( 101 ) , cmdstr ( 102 ) , cmdstr ( 103 ) , cmdstr ( 1
*04 ) , cmdstr ( 105 ) / 116 , 32 , 42 , 0 , 118 /
data cmdstr ( 106 ) , cmdstr ( 107 ) , cmdstr ( 108 ) , cmdstr ( 1
*09 ) , cmdstr ( 110 ) / 101 , 114 , 105 , 102 , 121 /
data cmdstr ( 111 ) , cmdstr ( 112 ) , cmdstr ( 113 ) , cmdstr ( 1
*14 ) , cmdstr ( 115 ) / 32 , 42 , 0 , 102 , 111 /
data cmdstr ( 116 ) , cmdstr ( 117 ) , cmdstr ( 118 ) , cmdstr ( 1
*19 ) , cmdstr ( 120 ) / 110 , 116 , 32 , 49 , 0 /
data cmdstr ( 121 ) , cmdstr ( 122 ) , cmdstr ( 123 ) , cmdstr ( 1
*24 ) , cmdstr ( 125 ) / 106 , 111 , 105 , 110 , 32 /
data cmdstr ( 126 ) , cmdstr ( 127 ) , cmdstr ( 128 ) , cmdstr ( 1
*29 ) , cmdstr ( 130 ) / 49 , 0 , 101 , 120 , 116 /
data cmdstr ( 131 ) , cmdstr ( 132 ) , cmdstr ( 133 ) , cmdstr ( 1
*34 ) , cmdstr ( 135 ) / 114 , 97 , 99 , 116 , 32 /
data cmdstr ( 136 ) , cmdstr ( 137 ) , cmdstr ( 138 ) , cmdstr ( 1
*39 ) , cmdstr ( 140 ) / 42 , 0 , 98 , 97 , 99 /
data cmdstr ( 141 ) , cmdstr ( 142 ) , cmdstr ( 143 ) , cmdstr ( 1
*44 ) , cmdstr ( 145 ) / 107 , 103 , 114 , 111 , 117 /
data cmdstr ( 146 ) , cmdstr ( 147 ) , cmdstr ( 148 ) , cmdstr ( 1
*49 ) , cmdstr ( 150 ) / 110 , 100 , 32 , 42 , 0 /
data cmdlst ( 1 ) , cmdlst ( 2 ) , cmdlst ( 3 ) , cmdlst ( 4 ) , c
*mdlst ( 5 ) / 1 , 8 , 16 , 24 , 31 /
data cmdlst ( 6 ) , cmdlst ( 7 ) , cmdlst ( 8 ) , cmdlst ( 9 ) , c
*mdlst ( 10 ) / 42 , 51 , 61 , 68 , 76 /
data cmdlst ( 11 ) , cmdlst ( 12 ) , cmdlst ( 13 ) , cmdlst ( 14 )
* , cmdlst ( 15 ) / 83 , 91 , 98 , 105 , 114 /
data cmdlst ( 16 ) , cmdlst ( 17 ) , cmdlst ( 18 ) / 121 , 128 , 1
*38 /
data cmdval ( 1 ) / 134 /
data cmdval ( 2 ) / 133 /
data cmdval ( 3 ) / 296 /
data cmdval ( 4 ) / 302 /
data cmdval ( 5 ) / 303 /
data cmdval ( 6 ) / 300 /
data cmdval ( 7 ) / 130 /
data cmdval ( 8 ) / 299 /
data cmdval ( 9 ) / 297 /
data cmdval ( 10 ) / 298 /
data cmdval ( 11 ) / 131 /
data cmdval ( 12 ) / 132 /
data cmdval ( 13 ) / 128 /
data cmdval ( 14 ) / 136 /
data cmdval ( 15 ) / 304 /
data cmdval ( 16 ) / 137 /
data cmdval ( 17 ) / 138 /
data cmdval ( 18 ) / 139 /
cp = 1
scncmd = 129
if(.not.( scnlet ( cp , lin , tok ) .le. 0 ))goto 23000
return
23000 continue
if(.not.( tok ( 1 ) .eq. 63 ))goto 23002
scncmd = 129
return
23002 continue
cindex = fndtok ( tok , 18 , cmdlst , cmdstr )
if(.not.( cindex .le. 0 ))goto 23004
return
23004 continue
scncmd = cmdval ( cindex )
if(.not.( scncmd .eq. 304 ))goto 23006
call scntok ( cp , lin , tok )
lorng = ctoi ( tok )
hirng = lorng
call scntok ( cp , lin , cname )
return
23006 continue
if(.not.( scncmd .eq. 139 ))goto 23008
cname ( 1 ) = 0
C in case nothing found
call scntok ( cp , lin , cname )
return
23008 continue
erng = scnrng ( cp , lin , lorng , hirng )
if(.not.( erng .eq. 0 ))goto 23010
C missing only, pick up from cmdlst...
rp = cmdlst ( cindex )
call scntok ( rp , cmdstr , tok )
erng = scnrng ( rp , cmdstr , lorng , hirng )
23010 continue
if(.not.( erng .le. 0 ))goto 23012
scncmd = - 1
23012 continue
call scntok ( cp , lin , cname )
return
end
integer function fndtok ( tok , n , lst , str )
integer tok ( 1 ) , str ( 1 )
integer n , lst ( 1 )
integer i , j , k
continue
i = 1
23014 if(.not.(tok(i).ne.0))goto 23016
if(.not.( tok ( i ) .ge. 65 .and. tok ( i ) .le. 90 ))goto 23017
C then convert to lower case
tok ( i ) = tok ( i ) + 97 - 65
23017 continue
23015 i=i+1
goto 23014
23016 continue
if(.not.( tok ( 1 ) .ne. 0 ))goto 23019
C added to stop null string from matching
continue
i = 1
23021 if(.not.(i.le.n))goto 23023
j = lst ( i )
continue
k = 1
23024 if(.not.(tok(k).ne.0.and.tok(k).eq.str(j)))goto 23026
j = j + 1
23025 k=k+1
goto 23024
23026 continue
if(.not.( tok ( k ) .eq. 0 ))goto 23027
fndtok = i
return
23027 continue
23022 i=i+1
goto 23021
23023 continue
23019 continue
fndtok = - 1
return
end
integer function scntok ( i , str , token )
integer str ( 1 ) , token ( 1 )
integer i , j
continue
23029 if(.not.(str(i).ne.0.and.(str(i).eq.32.or.str(i).eq.9)))goto 23031
23030 i=i+1
goto 23029
23031 continue
if(.not.( str ( i ) .eq. 0 ))goto 23032
scntok = 0
return
23032 continue
continue
j = 1
23034 if(.not.(str(i).ne.0.and.str(i).ne.32.and.str(i).ne.9.and.str(i).n
*e.44.and.str(i).ne.10))goto 23036
token ( j ) = str ( i )
j = j + 1
23035 i=i+1
goto 23034
23036 continue
token ( j ) = 0
scntok = j
return
end
integer function scnlet ( i , str , token )
integer str ( 1 ) , token ( 1 )
integer i , j
continue
23037 if(.not.(str(i).ne.0.and.(str(i).eq.32.or.str(i).eq.9)))goto 23039
23038 i=i+1
goto 23037
23039 continue
if(.not.( ( str ( i ) .lt. 97 .or. str ( i ) .gt. 122 ) .and. ( st
*r ( i ) .lt. 65 .or. str ( i ) .gt. 90 ) ))goto 23040
scnlet = 0
return
23040 continue
continue
j = 1
23042 if(.not.(str(i).ne.0))goto 23044
if(.not.( ( str ( i ) .lt. 97 .or. str ( i ) .gt. 122 ) .and. ( st
*r ( i ) .lt. 65 .or. str ( i ) .gt. 90 ) ))goto 23045
goto 23044
23045 continue
token ( j ) = str ( i )
j = j + 1
23043 i=i+1
goto 23042
23044 continue
token ( j ) = 0
scnlet = j
return
end
integer function scnrng ( i , str , lo , hi )
integer i , lo , hi
integer str ( 1 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer scnloc , loc
scnrng = 0
loc = scnloc ( i , str )
if(.not.( loc .eq. 0 ))goto 23047
return
23047 continue
if(.not.( loc .eq. - 1 ))goto 23049
C asterisk
lo = 1
hi = dollar
scnrng = lo
return
23049 continue
if(.not.( loc .eq. - 2 ))goto 23051
C at-sign
scnrng = lo
return
23051 continue
lo = loc
if(.not.( str ( i ) .eq. 44 ))goto 23053
i = i + 1
goto 23054
23053 continue
hi = lo
scnrng = lo
return
23054 continue
loc = scnloc ( i , str )
scnrng = - 1
if(.not.( loc .le. 0 ))goto 23055
return
23055 continue
hi = loc
scnrng = lo
return
end
integer function scnloc ( i , str )
integer i
integer str ( 1 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer curdx , curdy , smalld , larged
integer scf , lorng , hirng
integer cname ( 75 )
common / keypad / curdx , curdy , smalld , larged , scf , lorng ,
*hirng , cname
integer loctok ( 15 )
integer scntok , pregel , lengel , lookup , ctoi , mmatch
integer itok , nth , p
scnloc = 0
itok = i
if(.not.( scntok ( i , str , loctok ) .le. 1 ))goto 23057
return
23057 continue
if(.not.( loctok ( 1 ) .eq. 42 ))goto 23059
scnloc = - 1
goto 23060
23059 continue
if(.not.( loctok ( 1 ) .eq. 64 ))goto 23061
scnloc = - 2
goto 23062
23061 continue
if(.not.( loctok ( 1 ) .eq. 46 ))goto 23063
scnloc = dotgel
goto 23064
23063 continue
if(.not.( loctok ( 1 ) .eq. 36 ))goto 23065
scnloc = pregel ( dollar )
goto 23066
23065 continue
if(.not.( loctok ( 1 ) .ge. 48 .and. loctok ( 1 ) .le. 57 ))goto 2
*3067
nth = ctoi ( loctok )
continue
p = 1
23069 if(.not.(p.lt.dollar))goto 23071
if(.not.( gel ( p ) .gt. 0 .and. gel ( p ) .le. 7 ))goto 23072
nth = nth - 1
if(.not.( nth .eq. 0 ))goto 23074
scnloc = p
23074 continue
23072 continue
23070 p=p+lengel(p)
goto 23069
23071 continue
if(.not.( scnloc .eq. 0 ))goto 23076
call err ( loctok )
23076 continue
goto 23068
23067 continue
if(.not.( loctok ( 1 ) .ge. 65 .and. loctok ( 1 ) .le. 90 .or. loc
*tok ( 1 ) .ge. 97 .and. loctok ( 1 ) .le. 122 ))goto 23078
scnloc = lookup ( loctok )
if(.not.( scnloc .le. 0 ))goto 23080
i = itok
goto 23081
23080 continue
if(.not.( gel ( scnloc ) .eq. 12 ))goto 23082
lorng = scnloc + lengel ( scnloc )
hirng = pregel ( mmatch ( scnloc ) )
scnloc = - 2
C as if '@'
goto 23083
23082 continue
scnloc = scnloc + lengel ( scnloc )
23083 continue
23081 continue
goto 23079
23078 continue
scnloc = - 32767 - 1
23079 continue
23068 continue
23066 continue
23064 continue
23062 continue
23060 continue
return
end