Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/addend.for
There are no other files named addend.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 adnotz ( cmd , wop , prmt )
integer cmd , prmt ( 1 )
integer wop ( 10 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
C RSTSONLY define Maxnotz 64 # due to limited RAM on RSTS
integer notx ( 300 ) , noty ( 300 ) , nnotz
integer cpx , cpy
integer cls
common / cnotz / cpx , cpy , nnotz , notx , noty , cls
integer typ , i , j
integer ednotz , adwopt , insgel
nnotz = 0
if(.not.( ednotz ( cmd , wop , prmt ) .eq. 0 ))goto 23000
return
23000 continue
if(.not.( nnotz .le. 0 ))goto 23002
return
23002 continue
dotgel = adwopt ( dollar , wop )
if(.not.( insgel ( dotgel , 4 + 2 * ( nnotz - 1 ) ) .lt. 0 ))goto
*23004
return
23004 continue
if(.not.( cmd .eq. 118 ))goto 23006
if(.not.( cls .eq. 115 ))goto 23008
typ = 1
goto 23009
23008 continue
typ = 2
23009 continue
goto 23007
23006 continue
if(.not.( cls .eq. 115 ))goto 23010
typ = 3
goto 23011
23010 continue
typ = 4
23011 continue
23007 continue
gel ( dotgel ) = typ
gel ( dotgel + 1 ) = notx ( 1 )
gel ( dotgel + 2 ) = noty ( 1 )
gel ( dotgel + 3 ) = nnotz - 1
j = dotgel + 4
continue
i = 2
23012 if(.not.(i.le.nnotz))goto 23014
gel ( j ) = notx ( i )
gel ( j + 1 ) = noty ( i )
j = j + 2
23013 i=i+1
goto 23012
23014 continue
adnotz = 0
return
end
integer function adcirc ( wop , prmt )
integer wop ( 10 )
integer prmt ( 1 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer centx , centy , circx , circy , arc
common / ccircl / centx , centy , circx , circy , arc
integer circle , adwopt , insgel
if(.not.( circle ( wop , prmt ) .eq. 0 ))goto 23015
return
23015 continue
dotgel = adwopt ( dollar , wop )
if(.not.( insgel ( dotgel , 6 ) .lt. 0 ))goto 23017
return
23017 continue
gel ( dotgel ) = 6
gel ( dotgel + 1 ) = centx
gel ( dotgel + 2 ) = centy
gel ( dotgel + 3 ) = circx
gel ( dotgel + 4 ) = circy
gel ( dotgel + 5 ) = arc
adcirc = 0
return
end
integer function adbox ( wop , prmt )
integer wop ( 10 )
integer prmt ( 1 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer x1 , y1 , wid , hgt , pf
common / cboxes / x1 , y1 , wid , hgt , pf
integer boxes , adwopt , insgel
if(.not.( boxes ( wop , prmt ) .eq. 0 ))goto 23019
return
23019 continue
dotgel = adwopt ( dollar , wop )
if(.not.( insgel ( dotgel , 5 ) .lt. 0 ))goto 23021
return
23021 continue
gel ( dotgel ) = 5
gel ( dotgel + 1 ) = x1
gel ( dotgel + 2 ) = y1
gel ( dotgel + 3 ) = wid
gel ( dotgel + 4 ) = hgt
adbox = 0
return
end
integer function adtext ( wop , prmt )
integer wop ( 10 )
integer prmt ( 1 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
common / glopts / wrtopt , wrtcrv , wrtlin , wrtbox , wrtcir , wrt
*txt , txtopt , gwopsp , gwop , ttytop
integer wrtopt ( 10 ) , wrtcrv ( 10 ) , wrtlin ( 10 ) , wrtbox ( 1
*0 )
integer wrtcir ( 10 ) , wrttxt ( 10 ) , txtopt ( 6 ) , ttytop ( 6
*)
integer gwop ( 36 ) , gwopsp
C ^ should be Woplen*Maxwops
integer strx , stry
integer ti
C tch allocation pointer
integer tch ( 128 )
common / ctext / strx , stry , ti , tch
integer text , strlen , adwopt , adtopt , insgel
ti = 1
tch ( 1 ) = 0
if(.not.( text ( wop , prmt ) .eq. 0 ))goto 23023
return
23023 continue
if(.not.( tch ( 1 ) .eq. 0 ))goto 23025
return
23025 continue
dotgel = adwopt ( adtopt ( dollar , txtopt ) , wop )
if(.not.( insgel ( dotgel , 3 + strlen ( tch ) ) .lt. 0 ))goto 230
*27
return
23027 continue
gel ( dotgel ) = 7
gel ( dotgel + 1 ) = strx
gel ( dotgel + 2 ) = stry
call cpystr ( tch , gel ( dotgel + 3 ) )
adtext = 0
return
end
integer function adwopt ( gp , wop )
integer gp , wop ( 10 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer insgel
integer lwop ( 10 ) , ltop ( 6 ) , i
continue
i = 1
23029 if(.not.(i.le.10))goto 23031
lwop ( i ) = - 1
23030 i=i+1
goto 23029
23031 continue
adwopt = gp
call sumopt ( adwopt , lwop , ltop )
continue
i = 1
23032 if(.not.(i.le.10))goto 23034
if(.not.( lwop ( i ) .ne. wop ( i ) ))goto 23035
if(.not.( insgel ( adwopt , 2 ) .lt. 0 ))goto 23037
return
23037 continue
gel ( adwopt ) = 127 + i
gel ( adwopt + 1 ) = wop ( i )
adwopt = adwopt + 2
23035 continue
23033 i=i+1
goto 23032
23034 continue
return
end
integer function adtopt ( gp , top )
integer gp , top ( 6 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer insgel
integer lwop ( 10 ) , ltop ( 6 ) , i
continue
i = 1
23039 if(.not.(i.le.6))goto 23041
ltop ( i ) = - 1
23040 i=i+1
goto 23039
23041 continue
adtopt = gp
call sumopt ( adtopt , lwop , ltop )
continue
i = 1
23042 if(.not.(i.le.6))goto 23044
if(.not.( ltop ( i ) .ne. top ( i ) ))goto 23045
if(.not.( insgel ( adtopt , 2 ) .lt. 0 ))goto 23047
return
23047 continue
gel ( adtopt ) = 255 + i
gel ( adtopt + 1 ) = top ( i )
adtopt = adtopt + 2
23045 continue
23043 i=i+1
goto 23042
23044 continue
return
end
integer function sumopt ( gp , wop , top )
integer gp , wop ( 10 ) , top ( 6 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer lengel
integer p
continue
p = 1
23049 if(.not.(p.le.gp))goto 23051
if(.not.( gel ( p ) .gt. 255 .and. gel ( p ) .le. 255 + 6 ))goto 2
*3052
top ( gel ( p ) - 255 ) = gel ( p + 1 )
goto 23053
23052 continue
if(.not.( gel ( p ) .gt. 127 .and. gel ( p ) .le. 127 + 10 ))goto
*23054
wop ( gel ( p ) - 127 ) = gel ( p + 1 )
23054 continue
23053 continue
23050 p=p+lengel(p)
goto 23049
23051 continue
sumopt = 0
return
end