Google
 

Trailing-Edge - PDP-10 Archives - BB-K818A-BM_1981 - sources/settcp.for
There are no other files named settcp.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 setspc ( top , cdx , cdy , ldx , ldy )
      integer top ( 6 ) , cdx , cdy , ldx , ldy
      integer dx , dy
      setspc = 0
      dx = top ( 2 )
      if(.not.( dx .lt. 1 ))goto 23000
      dx = 1
23000 continue
      if(.not.( top ( 4 ) .eq. 0 ))goto 23002
      dx = 9 * dx
      goto 23003
23002 continue
      dx = 8 * dx
23003 continue
      dy = top ( 3 )
      if(.not.( dy .lt. 1 ))goto 23004
      dy = 1
23004 continue
      dy = 10 * dy
      if(.not.( top ( 6 ) .eq. 0 ))goto 23006
      cdx = dx
      cdy = 0
      ldx = 0
      ldy = dy
      goto 23007
23006 continue
      if(.not.( top ( 6 ) .eq. 45 ))goto 23008
      cdx = dx
      cdy = - dx
      ldx = dy
      ldy = dy
      goto 23009
23008 continue
      if(.not.( top ( 6 ) .eq. 90 ))goto 23010
      cdx = 0
      cdy = - dx
      ldx = dy
      ldy = 0
      goto 23011
23010 continue
      if(.not.( top ( 6 ) .eq. - 45 ))goto 23012
      cdx = dx
      cdy = dx
      ldx = - dy
      ldy = dy
      goto 23013
23012 continue
      if(.not.( top ( 6 ) .eq. - 90 ))goto 23014
      cdx = 0
      cdy = dx
      ldx = - dy
      ldy = 0
23014 continue
23013 continue
23011 continue
23009 continue
23007 continue
      return
      end
      integer function settcp ( top , str , sx , sy , si )
      integer top ( 1 ) , sx , sy , si
      integer str ( 1 )
      integer cdx , cdy , ldx , ldy
      integer x , y
      integer nlines , i
      call setspc ( top , cdx , cdy , ldx , ldy )
      x = sx
      y = sy
      nlines = 0
      continue
       i = 1
23016 if(.not.(i.lt.si.and.str(i).ne.0))goto 23018
      if(.not.( str ( i ) .eq. 8 ))goto 23019
      x = x - cdx
      y = y - cdy
      goto 23020
23019 continue
      if(.not.( str ( i ) .eq. 10 ))goto 23021
      nlines = nlines + 1
      x = sx + nlines * ldx
      y = sy + nlines * ldy
      goto 23022
23021 continue
      x = x + cdx
      y = y + cdy
23022 continue
23020 continue
23017 i=i+1
      goto 23016
23018 continue
      call positn ( x , y )
      settcp = 0
      return
      end