Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/marks.for
There are no other files named marks.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 lookup ( nam )
integer nam ( 1 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer lengel , eqstr
integer p , typ
lookup = 0
continue
p = 1
23000 if(.not.(p.lt.dollar))goto 23002
typ = gel ( p )
if(.not.( typ .eq. 11 .or. typ .eq. 12 .or. typ .eq. 14 ))goto 230
*03
if(.not.( eqstr ( nam , gel ( p + 1 ) ) .ne. 0 ))goto 23005
lookup = p
return
23005 continue
23003 continue
23001 p=p+lengel(p)
goto 23000
23002 continue
return
end
integer function admark ( gtyp , nam , lo , hi )
integer gtyp , lo , hi
integer nam ( 1 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer strlen , insgel , lengel
integer phi
C string nonam no name
integer nonam ( 8 )
data nonam ( 1 ) , nonam ( 2 ) , nonam ( 3 ) , nonam ( 4 ) , nonam
* ( 5 ) / 110 , 111 , 32 , 110 , 97 /
data nonam ( 6 ) , nonam ( 7 ) , nonam ( 8 ) / 109 , 101 , 0 /
admark = 0
if(.not.( nam ( 1 ) .eq. 0 ))goto 23007
call err ( nonam )
return
23007 continue
if(.not.( gtyp .eq. 12 ))goto 23009
phi = hi
if(.not.( gel ( phi ) .ne. 0 ))goto 23011
phi = phi + lengel ( phi )
23011 continue
if(.not.( insgel ( phi , 1 ) .lt. 0 ))goto 23013
return
23013 continue
gel ( phi ) = 13
23009 continue
if(.not.( insgel ( lo , 1 + strlen ( nam ) ) .lt. 0 ))goto 23015
return
23015 continue
gel ( lo ) = gtyp
call cpystr ( nam , gel ( lo + 1 ) )
return
end
integer function mmatch ( gp )
integer gp
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer lengel
integer p , level
mmatch = gp
if(.not.( gel ( gp ) .ne. 12 ))goto 23017
return
23017 continue
p = gp + lengel ( gp )
continue
level = 1
23019 if(.not.(p.lt.dollar.and.level.gt.0))goto 23021
if(.not.( gel ( p ) .eq. 12 ))goto 23022
level = level + 1
goto 23023
23022 continue
if(.not.( gel ( p ) .eq. 13 ))goto 23024
level = level - 1
23024 continue
23023 continue
23020 p=p+lengel(p)
goto 23019
23021 continue
mmatch = p
return
end