Google
 

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