Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/modtop.for
There are no other files named modtop.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 ========================================================================
integer function modtop ( oto , nto )
integer oto ( 6 ) , nto ( 6 )
integer rc ( 45 )
integer sp ( 10 )
integer itoc , t
integer ri , si
si = 1
sp ( 1 ) = 0
ri = 3
rc ( 1 ) = 116
rc ( 2 ) = 40
if(.not.( nto ( 1 ) .ne. oto ( 1 ) ))goto 23000
rc ( ri ) = 97
ri = ri + 1
rc ( ri ) = 48 + nto ( 1 )
ri = ri + 1
23000 continue
if(.not.( nto ( 6 ) .ne. oto ( 6 ) ))goto 23002
if(.not.( ri .gt. 3 ))goto 23004
rc ( ri ) = 44
ri = ri + 1
23004 continue
rc ( ri ) = 100
ri = ri + 1
ri = ri + itoc ( nto ( 6 ) , rc ( ri ) , 6 )
23002 continue
if(.not.( nto ( 4 ) .ne. oto ( 4 ) .or. nto ( 2 ) .ne. oto ( 2 ) .
*or. nto ( 3 ) .ne. oto ( 3 ) .or. nto ( 6 ) .ne. oto ( 6 ) ))goto
* 23006
if(.not.( ri .gt. 3 ))goto 23008
rc ( ri ) = 44
ri = ri + 1
23008 continue
if(.not.( nto ( 4 ) .eq. 0 ))goto 23010
C text spacing...
rc ( ri ) = 115
ri = ri + 1
ri = ri + itoc ( nto ( 2 ) , rc ( ri ) , 4 )
rc ( ri ) = 44
ri = ri + 1
rc ( ri ) = 104
ri = ri + 1
ri = ri + itoc ( nto ( 3 ) , rc ( ri ) , 4 )
goto 23011
23010 continue
C mosaic spacing...
if(.not.( ri .gt. 3 ))goto 23012
rc ( ri ) = 44
ri = ri + 1
23012 continue
rc ( ri ) = 115
ri = ri + 1
rc ( ri ) = 91
ri = ri + 1
t = 8 * nto ( 2 )
ri = ri + itoc ( t , rc ( ri ) , 4 )
sp ( si ) = 91
si = si + 1
si = si + itoc ( t , sp ( si ) , 4 )
sp ( si ) = 93
si = si + 1
sp ( si ) = 0
rc ( ri ) = 44
ri = ri + 1
t = 10 * nto ( 3 )
ri = ri + itoc ( t , rc ( ri ) , 4 )
rc ( ri ) = 93
ri = ri + 1
rc ( ri ) = 44
ri = ri + 1
rc ( ri ) = 109
ri = ri + 1
rc ( ri ) = 91
ri = ri + 1
ri = ri + itoc ( nto ( 2 ) , rc ( ri ) , 4 )
rc ( ri ) = 44
ri = ri + 1
ri = ri + itoc ( nto ( 3 ) , rc ( ri ) , 4 )
rc ( ri ) = 93
ri = ri + 1
23011 continue
23006 continue
if(.not.( nto ( 5 ) .ne. oto ( 5 ) ))goto 23014
if(.not.( ri .gt. 3 ))goto 23016
rc ( ri ) = 44
ri = ri + 1
23016 continue
rc ( ri ) = 105
ri = ri + 1
ri = ri + itoc ( nto ( 5 ) , rc ( ri ) , 6 )
23014 continue
rc ( ri ) = 41
ri = ri + 1
continue
si = 1
23018 if(.not.(sp(si).ne.0))goto 23020
rc ( ri ) = sp ( si )
ri = ri + 1
23019 si=si+1
goto 23018
23020 continue
rc ( ri ) = 0
if(.not.( ri .lt. 5 ))goto 23021
return
23021 continue
call putc ( 10 )
call putcha ( rc )
modtop = ri
return
end