Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/gelio.for
There are no other files named gelio.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 getgel ( fnam , loc )
integer fnam ( 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 loc
integer inpfil
C string badfil Cannot open file:
integer badfil ( 19 )
data badfil ( 1 ) , badfil ( 2 ) , badfil ( 3 ) , badfil ( 4 ) , b
*adfil ( 5 ) / 67 , 97 , 110 , 110 , 111 /
data badfil ( 6 ) , badfil ( 7 ) , badfil ( 8 ) , badfil ( 9 ) , b
*adfil ( 10 ) / 116 , 32 , 111 , 112 , 101 /
data badfil ( 11 ) , badfil ( 12 ) , badfil ( 13 ) , badfil ( 14 )
* , badfil ( 15 ) / 110 , 32 , 102 , 105 , 108 /
data badfil ( 16 ) , badfil ( 17 ) , badfil ( 18 ) , badfil ( 19 )
* / 101 , 58 , 32 , 0 /
getgel = 0
call fspec ( fnam , pictyp )
C construct filespec in pathn
if(.not.( inpfil ( 0 ) .eq. - 1 ))goto 23000
call uprmt ( badfil )
C open failed, tell user
call err ( pathn )
C show filespec
return
23000 continue
call inrgis ( loc )
call clsinp
return
end
integer function putgel ( fnam , lo , hi )
integer fnam ( 1 )
integer cx , cy , relflg , sx , sy
common / compos / cx , cy
common / comrel / relflg
common / comsav / sx , sy
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 lo , hi
integer outfil
C string badfil Cannot open file:
C string nofil File name not specified
integer badfil ( 19 )
integer nofil ( 24 )
data badfil ( 1 ) , badfil ( 2 ) , badfil ( 3 ) , badfil ( 4 ) , b
*adfil ( 5 ) / 67 , 97 , 110 , 110 , 111 /
data badfil ( 6 ) , badfil ( 7 ) , badfil ( 8 ) , badfil ( 9 ) , b
*adfil ( 10 ) / 116 , 32 , 111 , 112 , 101 /
data badfil ( 11 ) , badfil ( 12 ) , badfil ( 13 ) , badfil ( 14 )
* , badfil ( 15 ) / 110 , 32 , 102 , 105 , 108 /
data badfil ( 16 ) , badfil ( 17 ) , badfil ( 18 ) , badfil ( 19 )
* / 101 , 58 , 32 , 0 /
data nofil ( 1 ) , nofil ( 2 ) , nofil ( 3 ) , nofil ( 4 ) , nofil
* ( 5 ) / 70 , 105 , 108 , 101 , 32 /
data nofil ( 6 ) , nofil ( 7 ) , nofil ( 8 ) , nofil ( 9 ) , nofil
* ( 10 ) / 110 , 97 , 109 , 101 , 32 /
data nofil ( 11 ) , nofil ( 12 ) , nofil ( 13 ) , nofil ( 14 ) , n
*ofil ( 15 ) / 110 , 111 , 116 , 32 , 115 /
data nofil ( 16 ) , nofil ( 17 ) , nofil ( 18 ) , nofil ( 19 ) , n
*ofil ( 20 ) / 112 , 101 , 99 , 105 , 102 /
data nofil ( 21 ) , nofil ( 22 ) , nofil ( 23 ) , nofil ( 24 ) / 1
*05 , 101 , 100 , 0 /
putgel = 0
if(.not.( fnam ( 1 ) .eq. 0 ))goto 23002
call err ( nofil )
C complain if no file name
return
23002 continue
if(.not.( relflg .eq. 0 ))goto 23004
call fspec ( fnam , pictyp )
C construct filespec in pathn
goto 23005
23004 continue
call fspec ( fnam , rpftyp )
23005 continue
C different type for rel file
if(.not.( outfil ( 0 ) .ne. - 1 ))goto 23006
C successfully opened for write
C call putwop #(these now done by "drwgel" always)
C call puttop
call drwgel ( lo , hi , 0 )
call putc ( 10 )
call clsout
goto 23007
23006 continue
C open failed
call uprmt ( badfil )
call err ( pathn )
C show filespec
return
23007 continue
return
end
integer function catfil ( noargs )
integer noargs
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 inpfil , getc
integer c
C include logcom
C LOGSTAR 'catfil>'
C call putarg(pathn)
if(.not.( inpfil ( 0 ) .eq. - 1 ))goto 23008
call err ( pathn )
goto 23009
23008 continue
continue
23010 if(.not.( getc ( c ) .ne. ( - 1 ) ))goto 23011
call putc ( c )
C while (getc(c) != Eof) call putc(c | \200) #lets ESC's through on RSTS
goto 23010
23011 continue
call clsinp
23009 continue
catfil = 0
return
end
integer function ldfont ( num , fname )
integer fname ( 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 num
C string opn \nl(a
C string cls )\n
C string fnterr font number
integer opn ( 5 )
integer cls ( 3 )
integer fnterr ( 12 )
data opn ( 1 ) , opn ( 2 ) , opn ( 3 ) , opn ( 4 ) , opn ( 5 ) / 1
*0 , 108 , 40 , 97 , 0 /
data cls ( 1 ) , cls ( 2 ) , cls ( 3 ) / 41 , 10 , 0 /
data fnterr ( 1 ) , fnterr ( 2 ) , fnterr ( 3 ) , fnterr ( 4 ) , f
*nterr ( 5 ) / 102 , 111 , 110 , 116 , 32 /
data fnterr ( 6 ) , fnterr ( 7 ) , fnterr ( 8 ) , fnterr ( 9 ) , f
*nterr ( 10 ) / 110 , 117 , 109 , 98 , 101 /
data fnterr ( 11 ) , fnterr ( 12 ) / 114 , 0 /
ldfont = 0
if(.not.( num .lt. 1 .or. num .gt. 3 ))goto 23012
call err ( fnterr )
return
23012 continue
call putcha ( opn )
call putdec ( num )
call putcha ( cls )
call fspec ( fname , fnttyp )
call catfil ( 0 )
return
end
integer function helper ( file )
integer file ( 1 )
integer curdx , curdy , smalld , larged
integer scf , lorng , hirng
integer cname ( 75 )
common / keypad / curdx , curdy , smalld , larged , scf , lorng ,
*hirng , cname
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 inpfil , inch , getc
integer l , skip
integer c
integer key
C string eohelp No more help!\n
integer eohelp ( 15 )
data eohelp ( 1 ) , eohelp ( 2 ) , eohelp ( 3 ) , eohelp ( 4 ) , e
*ohelp ( 5 ) / 78 , 111 , 32 , 109 , 111 /
data eohelp ( 6 ) , eohelp ( 7 ) , eohelp ( 8 ) , eohelp ( 9 ) , e
*ohelp ( 10 ) / 114 , 101 , 32 , 104 , 101 /
data eohelp ( 11 ) , eohelp ( 12 ) , eohelp ( 13 ) , eohelp ( 14 )
* , eohelp ( 15 ) / 108 , 112 , 33 , 10 , 0 /
helper = ( - 1 )
key = 277
call scrlup
call unrgis
continue
skip = 0
23014 if(.not.(key.eq.277))goto 23016
call helpfl ( file )
if(.not.( inpfil ( 0 ) .eq. ( - 1 ) ))goto 23017
call err ( pathn )
call regis
call scrldn
return
23017 continue
continue
l = 0
23019 if(.not.(l.lt.skip))goto 23021
if(.not.( getc ( c ) .eq. ( - 1 ) ))goto 23022
call putcha ( eohelp )
skip = - 1
goto 23021
23022 continue
if(.not.( c .eq. 10 ))goto 23024
l = l + 1
23024 continue
23020 goto 23019
23021 continue
call home
call clreol
if(.not.( c .ne. ( - 1 ) ))goto 23026
continue
23028 continue
if(.not.( getc ( c ) .eq. ( - 1 ) ))goto 23031
call putcha ( eohelp )
skip = - 1
goto 23030
23031 continue
call putc ( c )
if(.not.( c .eq. 10 ))goto 23033
goto 23030
23033 continue
23029 goto 23028
23030 continue
23026 continue
call clsinp
key = inch ( c )
23015 skip=skip+1
goto 23014
23016 continue
call regis
call scrldn
helper = 0
return
end