Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/gelly.for
There are no other files named gelly.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 ========================================================================
C Gelly format:
C
C Each gel begins with a code that identifies what kind of gel it is.
C The correspondence between symbolic gel names and numeric values is
C in the "geldef" file. The data that follows the code depends upon
C the type of gel:
C
C GEL DATA
C --- ----
C Garbgel String terminated by Eos
C Eogel Nothing
C OpenLines X, Y, n, X1, Y1, X2, Y2, ... , Xn, Yn
C ClosedLines X, Y, n, X1, Y1, X2, Y2, ... , Xn, Yn
C OpenCurves X, Y, n, X1, Y1, X2, Y2, ... , Xn, Yn
C ClosedCurves X, Y, n, X1, Y1, X2, Y2, ... , Xn, Yn
C Boxgel X, Y, width, height
C Circlgel X, Y, circumference X, circumference Y, degrees-of-arc
C Textgel X, Y, String terminated by Eos
C Erasegel Nothing
C Labelgel String terminated by Eos
C Opengel String terminated by Eos
C Closegel Nothing
C Markgel String terminated by Eos
C Writing option 1 integer (value depends upon option type)
C Text option 1 integer (value depends upon option type)
integer function lengel ( gp )
integer gp
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
C include logcom
integer strlen
integer typ
C string bad Bad internal data
integer bad ( 18 )
data bad ( 1 ) , bad ( 2 ) , bad ( 3 ) , bad ( 4 ) , bad ( 5 ) / 6
*6 , 97 , 100 , 32 , 105 /
data bad ( 6 ) , bad ( 7 ) , bad ( 8 ) , bad ( 9 ) , bad ( 10 ) /
*110 , 116 , 101 , 114 , 110 /
data bad ( 11 ) , bad ( 12 ) , bad ( 13 ) , bad ( 14 ) , bad ( 15
*) / 97 , 108 , 32 , 100 , 97 /
data bad ( 16 ) , bad ( 17 ) , bad ( 18 ) / 116 , 97 , 0 /
typ = gel ( gp )
if(.not.( typ .eq. ( - 1 ) .or. typ .eq. 11 .or. typ .eq. 12 .or.
*typ .eq. 14 ))goto 23000
lengel = 1 + strlen ( gel ( gp + 1 ) )
goto 23001
23000 continue
if(.not.( ( typ .gt. 127 .and. typ .le. 127 + 10 ) .or. ( typ .gt
*. 255 .and. typ .le. 255 + 6 ) ))goto 23002
lengel = 2
goto 23003
23002 continue
if(.not.( typ .eq. 10 .or. typ .eq. 13 ))goto 23004
lengel = 1
goto 23005
23004 continue
if(.not.( typ .eq. 7 ))goto 23006
lengel = 3 + strlen ( gel ( gp + 3 ) )
goto 23007
23006 continue
if(.not.( typ .eq. 6 ))goto 23008
lengel = 6
goto 23009
23008 continue
if(.not.( typ .eq. 5 ))goto 23010
lengel = 5
goto 23011
23010 continue
if(.not.( typ .ge. 1 .and. typ .le. 4 ))goto 23012
lengel = 4 + 2 * gel ( gp + 3 )
goto 23013
23012 continue
if(.not.( typ .eq. 0 ))goto 23014
lengel = 1
C many for-loops need this
goto 23015
23014 continue
call err ( bad )
lengel = 1
C get past bad gel
C LOGSTAR 'lengel--unknown geltyp', typ, gp, dotgel, dollar
23015 continue
23013 continue
23011 continue
23009 continue
23007 continue
23005 continue
23003 continue
23001 continue
return
end
integer function pregel ( gp )
integer gp
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer lengel
integer p
pregel = gp
continue
p = 1
23016 if(.not.(p.lt.gp))goto 23018
if(.not.( gel ( p ) .gt. 0 .and. gel ( p ) .le. 7 ))goto 23019
pregel = p
23019 continue
23017 p=p+lengel(p)
goto 23016
23018 continue
return
end
integer function posgel ( gp )
integer gp
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer typ
typ = gel ( gp )
if(.not.( typ .ge. 1 .and. typ .le. 7 ))goto 23021
call positn ( gel ( gp + 1 ) , gel ( gp + 2 ) )
goto 23022
23021 continue
if(.not.( typ .eq. 0 ))goto 23023
call positn ( 0 , 0 )
23023 continue
23022 continue
posgel = 0
return
end
integer function rmgel ( lo , hi )
integer lo , hi
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer pregel , lengel
integer p , rml
if(.not.( hi + lengel ( hi ) .ge. dollar ))goto 23025
dollar = lo
dotgel = pregel ( dollar )
gel ( dollar ) = 0
return
23025 continue
rml = 0
continue
p = lo
23027 if(.not.(p.le.hi))goto 23029
rml = rml + lengel ( p )
23028 p=p+lengel(p)
goto 23027
23029 continue
continue
23030 if(.not.(p.le.dollar))goto 23032
gel ( p - rml ) = gel ( p )
23031 p=p+1
goto 23030
23032 continue
dollar = dollar - rml
dotgel = lo
rmgel = 0
return
end
integer function insgel ( gp , len )
integer gp , len
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer p
C string cant no room
integer cant ( 8 )
data cant ( 1 ) , cant ( 2 ) , cant ( 3 ) , cant ( 4 ) , cant ( 5
*) / 110 , 111 , 32 , 114 , 111 /
data cant ( 6 ) , cant ( 7 ) , cant ( 8 ) / 111 , 109 , 0 /
if(.not.( dollar + len .gt. 3000 ))goto 23033
call err ( cant )
insgel = - 1
return
23033 continue
gel ( dollar ) = 0
continue
p = dollar
23035 if(.not.(p.ge.gp))goto 23037
gel ( p + len ) = gel ( p )
23036 p=p-1
goto 23035
23037 continue
dollar = dollar + len
insgel = 0
return
end
C debug
C int func dmpgel Noargs
C include chrdef
C include cgelly
C include logcom
C int i, leng, lengel, typ
C #string dmp1 ;".:
C #string dmp2 \ $:
C stringdcl dmp1 ;".:
C stringdcl dmp2 $:
C stringdata dmp1 ;".:
C stringdata dmp2 $:
C LOGIF
C { call putcha(dmp1); call putdec(dotgel)
C call putcha(dmp2); call putdec(dollar)
C for (i=1; i<=dollar; i=i+1)
C { call putc(Space); call putdec(gel(i)); }
C call putc(Quote2)
C call putc(Newline)
C }
C dmpgel = Novalue
C LOGSTAR 'DMPGEL>', dotgel, dollar
C for (i=1; i<=dollar; i=i+leng)
C { leng = lengel(i)
C typ = gel(i)
C LOGSTAR 'dmpgel+', i, leng, typ
C if (typ == Garbgel | typ == Labelgel | typ == Opengel | typ == Markgel)
C { LOGSTAR ' garb|label|open|mark'
C call putarg (gel(i+1))
C }
C else if (typ > Wopbase)
C { LOGSTAR ' wop|top', gel(i+1)
C }
C else if (typ == Erasegel | typ == Closegel)
C { LOGSTAR ' erase|close'
C }
C else if (typ == Textgel)
C { LOGSTAR ' text', gel(i+1), gel(i+2)
C call putarg (gel(i+3))
C }
C else if (typ == Circgel)
C { LOGSTAR ' circle', (gel(j),j=i+1,i+leng-1)
C }
C else if (typ == Boxgel)
C { LOGSTAR ' box', (gel(j),j=i+1,i+leng-1)
C }
C else if (typ >= Opnlin & typ <= Clscrv)
C { LOGSTAR ' opnlin-clscrv', (gel(j),j=i+1,i+leng-1)
C }
C else if (typ == Eogel)
C { LOGSTAR ' eogel'
C }
C else
C { LOGSTAR ' unrecognized gel type'
C }
C }
C return
C end
C gubed
C Garland's dmpgel routine
C #debug
C int func dmpgel Noargs
C include cgelly
C int i
C #string dmp1 ;".:
C #string dmp2 \ $:
C call putcha(dmp1); call putdec(dotgel)
C call putcha(dmp2); call putdec(dollar)
C for (i=1; i<=dollar; i=i+1)
C { call putc(Space); call putdec(gel(i)); }
C call putc(Quote2)
C dmpgel = Novalue
C return
C end
C gubed
integer function joiner ( loc )
integer loc
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer lengel
integer p
C string pgs no page
integer pgs ( 8 )
data pgs ( 1 ) , pgs ( 2 ) , pgs ( 3 ) , pgs ( 4 ) , pgs ( 5 ) / 1
*10 , 111 , 32 , 112 , 97 /
data pgs ( 6 ) , pgs ( 7 ) , pgs ( 8 ) / 103 , 101 , 0 /
p = loc
if(.not.( p .lt. 1 ))goto 23038
p = 1
23038 continue
continue
23040 if(.not.(p.lt.dollar.and.gel(p).ne.10))goto 23042
23041 p=p+lengel(p)
goto 23040
23042 continue
if(.not.( gel ( p ) .eq. 10 ))goto 23043
call rmgel ( p , p )
goto 23044
23043 continue
call err ( pgs )
23044 continue
joiner = 0
return
end