Google
 

Trailing-Edge - PDP-10 Archives - BB-K818A-BM_1981 - sources/path.for
There are no other files named path.for in the archive.
C path> Construct filespecs
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 ========================================================================
C This module attempts to consolidate all the code that has to deal with
C building filespecs, as the format of a filespec varies from system to system.
C Completely-built filespecs are stored in the character-vector "pathn",
C which lives in the cpath COMMON block.
C 
C The typical approach to file access is:
C 	1.  Call a routine in this module to build a filespec in pathn.
C 	2.  Call a routine (e.g., inpfil) that needs a filespec.  This
C 	    routine will expect to find the filepsec in pathn.
C To define a new file type:
C 	1.  Add a character variable to cpath
C 	2.  Initialize it in the following block data subprogram
      block data
      integer pathn ( 50 )
C inpfil, outfil expect to find pathname here
      integer bkgdnm ( 50 )
C filepsec of "background" file
      common / cpath / pathn , bkgdnm
C 3 characters plus Eos
      integer fnttyp ( 4 ) , pictyp ( 4 ) , rpftyp ( 4 )
      common / ctypes / fnttyp , pictyp , rpftyp
      data fnttyp ( 1 ) , fnttyp ( 2 ) , fnttyp ( 3 ) , fnttyp ( 4 ) / 7
     *0 , 78 , 84 , 0 /
      data pictyp ( 1 ) , pictyp ( 2 ) , pictyp ( 3 ) , pictyp ( 4 ) / 8
     *0 , 73 , 67 , 0 /
      data rpftyp ( 1 ) , rpftyp ( 2 ) , rpftyp ( 3 ) , rpftyp ( 4 ) / 8
     *2 , 80 , 70 , 0 /
      data bkgdnm ( 1 ) / 0 /
      end
C fspec - build filespec in pathn; if the filename doesn't already have a
C 	 type, the caller-supplied type is added
      integer function fspec ( fnam , ftyp )
      integer fnam ( 1 ) , ftyp ( 1 )
      integer pathn ( 50 )
C inpfil, outfil expect to find pathname here
      integer bkgdnm ( 50 )
C filepsec of "background" file
      common / cpath / pathn , bkgdnm
C 3 characters plus Eos
      integer fnttyp ( 4 ) , pictyp ( 4 ) , rpftyp ( 4 )
      common / ctypes / fnttyp , pictyp , rpftyp
      integer anglef , c , i
      logical typef
      fspec = 0
      call cpystr ( fnam , pathn )
C copy name to pathn
      typef = . false .
C no type seen yet
      i = 0
      continue
23000 continue
      i = i + 1
      c = pathn ( i )
      if(.not.( c .eq. 0 ))goto 23003
      goto 23002
C if dot appears between < > or [ ], ignore it
23003 continue
      if(.not.( c .eq. 60 ))goto 23005
      anglef = anglef + 1
23005 continue
      if(.not.( c .eq. 62 ))goto 23007
      anglef = anglef - 1
23007 continue
      if(.not.( c .eq. 91 ))goto 23009
      anglef = anglef + 1
23009 continue
      if(.not.( c .eq. 93 ))goto 23011
      anglef = anglef - 1
23011 continue
      if(.not.( c .eq. 46 .and. anglef .eq. 0 ))goto 23013
      typef = . true .
23013 continue
C type is there
23001 goto 23000
23002 continue
      if(.not.( typef .or. i .eq. 1 ))goto 23015
      return
23015 continue
C typeless filename given?
      pathn ( i ) = 46
C yes, add a dot
      call cpystr ( ftyp , pathn ( i + 1 ) )
C append the type supplied by caller
      end
C helpfl - build filespec for one of the various help text files
      integer function helpfl ( nam )
      integer nam ( 1 )
      integer pathn ( 50 )
C inpfil, outfil expect to find pathname here
      integer bkgdnm ( 50 )
C filepsec of "background" file
      common / cpath / pathn , bkgdnm
C 3 characters plus Eos
      integer fnttyp ( 4 ) , pictyp ( 4 ) , rpftyp ( 4 )
      common / ctypes / fnttyp , pictyp , rpftyp
      integer cpystr , i
      integer prefix(7)
C 		stringdcl  prefix GGLIB:GE
C 	stringdcl  prefix GGLIB:GE
C string hlptyp .hlp
      integer hlptyp ( 5 )
      data hlptyp ( 1 ) , hlptyp ( 2 ) , hlptyp ( 3 ) , hlptyp ( 4 ) , h
     *lptyp ( 5 ) / 46 , 104 , 108 , 112 , 0 /
      data prefix /72,76,80,58,71,69,0/
C 		stringdata prefix GGLIB:GE
C 	stringdata prefix GGLIB:GE
      helpfl = 0
      i = cpystr ( prefix , pathn )
      i = cpystr ( nam , pathn ( i ) ) + i - 1
C now the file name
      i = cpystr ( hlptyp , pathn ( i ) )
C and the type
      end