Google
 

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