Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/vergel.for
There are no other files named vergel.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 vergel ( lo , hi )
integer lo , hi , ihi
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer lengel
integer gelnum , typ , p
logical nota
C include logcom
C string badmsg Bad internal data:
C string eramsg New Page.
C string garmsg Unknown/Literal:
C string boxmsg Box:
C string cirmsg Circle:
C string olnmsg Open Lines:
C string clnmsg Closed Lines:
C string ccvmsg Closed Curve:
C string ocvmsg Open Curve:
C string endmsg <End of File>
C string eoaddr :\t
integer badmsg ( 21 )
integer eramsg ( 10 )
integer garmsg ( 19 )
integer boxmsg ( 5 )
integer cirmsg ( 8 )
integer olnmsg ( 12 )
integer clnmsg ( 14 )
integer ccvmsg ( 14 )
integer ocvmsg ( 12 )
integer endmsg ( 14 )
integer eoaddr ( 3 )
data badmsg ( 1 ) , badmsg ( 2 ) , badmsg ( 3 ) , badmsg ( 4 ) , b
*admsg ( 5 ) / 66 , 97 , 100 , 32 , 105 /
data badmsg ( 6 ) , badmsg ( 7 ) , badmsg ( 8 ) , badmsg ( 9 ) , b
*admsg ( 10 ) / 110 , 116 , 101 , 114 , 110 /
data badmsg ( 11 ) , badmsg ( 12 ) , badmsg ( 13 ) , badmsg ( 14 )
* , badmsg ( 15 ) / 97 , 108 , 32 , 100 , 97 /
data badmsg ( 16 ) , badmsg ( 17 ) , badmsg ( 18 ) , badmsg ( 19 )
* , badmsg ( 20 ) / 116 , 97 , 58 , 32 , 32 /
data badmsg ( 21 ) / 0 /
data eramsg ( 1 ) , eramsg ( 2 ) , eramsg ( 3 ) , eramsg ( 4 ) , e
*ramsg ( 5 ) / 78 , 101 , 119 , 32 , 80 /
data eramsg ( 6 ) , eramsg ( 7 ) , eramsg ( 8 ) , eramsg ( 9 ) , e
*ramsg ( 10 ) / 97 , 103 , 101 , 46 , 0 /
data garmsg ( 1 ) , garmsg ( 2 ) , garmsg ( 3 ) , garmsg ( 4 ) , g
*armsg ( 5 ) / 85 , 110 , 107 , 110 , 111 /
data garmsg ( 6 ) , garmsg ( 7 ) , garmsg ( 8 ) , garmsg ( 9 ) , g
*armsg ( 10 ) / 119 , 110 , 47 , 76 , 105 /
data garmsg ( 11 ) , garmsg ( 12 ) , garmsg ( 13 ) , garmsg ( 14 )
* , garmsg ( 15 ) / 116 , 101 , 114 , 97 , 108 /
data garmsg ( 16 ) , garmsg ( 17 ) , garmsg ( 18 ) , garmsg ( 19 )
* / 58 , 32 , 32 , 0 /
data boxmsg ( 1 ) , boxmsg ( 2 ) , boxmsg ( 3 ) , boxmsg ( 4 ) , b
*oxmsg ( 5 ) / 66 , 111 , 120 , 58 , 0 /
data cirmsg ( 1 ) , cirmsg ( 2 ) , cirmsg ( 3 ) , cirmsg ( 4 ) , c
*irmsg ( 5 ) / 67 , 105 , 114 , 99 , 108 /
data cirmsg ( 6 ) , cirmsg ( 7 ) , cirmsg ( 8 ) / 101 , 58 , 0 /
data olnmsg ( 1 ) , olnmsg ( 2 ) , olnmsg ( 3 ) , olnmsg ( 4 ) , o
*lnmsg ( 5 ) / 79 , 112 , 101 , 110 , 32 /
data olnmsg ( 6 ) , olnmsg ( 7 ) , olnmsg ( 8 ) , olnmsg ( 9 ) , o
*lnmsg ( 10 ) / 76 , 105 , 110 , 101 , 115 /
data olnmsg ( 11 ) , olnmsg ( 12 ) / 58 , 0 /
data clnmsg ( 1 ) , clnmsg ( 2 ) , clnmsg ( 3 ) , clnmsg ( 4 ) , c
*lnmsg ( 5 ) / 67 , 108 , 111 , 115 , 101 /
data clnmsg ( 6 ) , clnmsg ( 7 ) , clnmsg ( 8 ) , clnmsg ( 9 ) , c
*lnmsg ( 10 ) / 100 , 32 , 76 , 105 , 110 /
data clnmsg ( 11 ) , clnmsg ( 12 ) , clnmsg ( 13 ) , clnmsg ( 14 )
* / 101 , 115 , 58 , 0 /
data ccvmsg ( 1 ) , ccvmsg ( 2 ) , ccvmsg ( 3 ) , ccvmsg ( 4 ) , c
*cvmsg ( 5 ) / 67 , 108 , 111 , 115 , 101 /
data ccvmsg ( 6 ) , ccvmsg ( 7 ) , ccvmsg ( 8 ) , ccvmsg ( 9 ) , c
*cvmsg ( 10 ) / 100 , 32 , 67 , 117 , 114 /
data ccvmsg ( 11 ) , ccvmsg ( 12 ) , ccvmsg ( 13 ) , ccvmsg ( 14 )
* / 118 , 101 , 58 , 0 /
data ocvmsg ( 1 ) , ocvmsg ( 2 ) , ocvmsg ( 3 ) , ocvmsg ( 4 ) , o
*cvmsg ( 5 ) / 79 , 112 , 101 , 110 , 32 /
data ocvmsg ( 6 ) , ocvmsg ( 7 ) , ocvmsg ( 8 ) , ocvmsg ( 9 ) , o
*cvmsg ( 10 ) / 67 , 117 , 114 , 118 , 101 /
data ocvmsg ( 11 ) , ocvmsg ( 12 ) / 58 , 0 /
data endmsg ( 1 ) , endmsg ( 2 ) , endmsg ( 3 ) , endmsg ( 4 ) , e
*ndmsg ( 5 ) / 60 , 69 , 110 , 100 , 32 /
data endmsg ( 6 ) , endmsg ( 7 ) , endmsg ( 8 ) , endmsg ( 9 ) , e
*ndmsg ( 10 ) / 111 , 102 , 32 , 70 , 105 /
data endmsg ( 11 ) , endmsg ( 12 ) , endmsg ( 13 ) , endmsg ( 14 )
* / 108 , 101 , 62 , 0 /
data eoaddr ( 1 ) , eoaddr ( 2 ) , eoaddr ( 3 ) / 58 , 9 , 0 /
if(.not.( hi + lengel ( hi ) .eq. dollar ))goto 23000
ihi = dollar
goto 23001
23000 continue
ihi = hi
C LOGSTAR 'vergel>', lo, hi, ihi
C call dmpgel
23001 continue
vergel = 0
gelnum = 1
continue
p = 1
23002 if(.not.(p.lt.lo))goto 23004
if(.not.( gel ( p ) .le. 7 .and. gel ( p ) .gt. 0 ))goto 23005
gelnum = gelnum + 1
23005 continue
23003 p=p+lengel(p)
goto 23002
23004 continue
continue
23007 if(.not.(p.le.ihi))goto 23009
typ = gel ( p )
call putdec ( p )
call clreol
call putcha ( eoaddr )
if(.not.( typ .gt. 0 .and. typ .le. 7 ))goto 23010
call putdec ( gelnum )
gelnum = gelnum + 1
23010 continue
nota = . false .
if(.not.( typ .eq. 14 ))goto 23012
call vermrk ( 59 , gel ( p + 1 ) )
goto 23013
23012 continue
if(.not.( typ .eq. 11 ))goto 23014
call vermrk ( 58 , gel ( p + 1 ) )
goto 23015
23014 continue
if(.not.( typ .eq. 12 ))goto 23016
call vermrk ( 123 , gel ( p + 1 ) )
goto 23017
23016 continue
if(.not.( typ .eq. 13 ))goto 23018
call vermrk ( 125 , 0 )
goto 23019
23018 continue
nota = . true .
23019 continue
23017 continue
23015 continue
23013 continue
C remember if "none of the above"
call putc ( 9 )
if(.not.( typ .gt. 255 .and. typ .le. 255 + 6 ))goto 23020
call vertxt ( typ - 255 , gel ( p + 1 ) )
goto 23021
23020 continue
if(.not.( typ .gt. 127 .and. typ .le. 127 + 10 ))goto 23022
call verwrt ( typ - 127 , gel ( p + 1 ) )
goto 23023
23022 continue
if(.not.( typ .eq. 7 ))goto 23024
call vertex ( gel ( p + 1 ) , gel ( p + 2 ) , gel ( p + 3 ) )
goto 23025
23024 continue
if(.not.( typ .eq. 6 ))goto 23026
call verpos ( cirmsg , gel ( p + 1 ) , gel ( p + 2 ) )
goto 23027
23026 continue
if(.not.( typ .eq. 5 ))goto 23028
call verpos ( boxmsg , gel ( p + 1 ) , gel ( p + 2 ) )
goto 23029
23028 continue
if(.not.( typ .eq. 1 ))goto 23030
call verpos ( olnmsg , gel ( p + 1 ) , gel ( p + 2 ) )
goto 23031
23030 continue
if(.not.( typ .eq. 2 ))goto 23032
call verpos ( clnmsg , gel ( p + 1 ) , gel ( p + 2 ) )
goto 23033
23032 continue
if(.not.( typ .eq. 4 ))goto 23034
call verpos ( ccvmsg , gel ( p + 1 ) , gel ( p + 2 ) )
goto 23035
23034 continue
if(.not.( typ .eq. 3 ))goto 23036
call verpos ( ocvmsg , gel ( p + 1 ) , gel ( p + 2 ) )
goto 23037
23036 continue
if(.not.( typ .eq. 10 ))goto 23038
call putcha ( eramsg )
goto 23039
23038 continue
if(.not.( typ .eq. ( - 1 ) ))goto 23040
call putcha ( garmsg )
call putcha ( gel ( p + 1 ) )
goto 23041
23040 continue
if(.not.( typ .eq. 0 ))goto 23042
call putcha ( endmsg )
goto 23043
23042 continue
if(.not.( nota ))goto 23044
call putcha ( badmsg )
call putdec ( typ )
23044 continue
23043 continue
23041 continue
23039 continue
23037 continue
23035 continue
23033 continue
23031 continue
23029 continue
23027 continue
23025 continue
23023 continue
23021 continue
call putc ( 10 )
23008 p=p+lengel(p)
goto 23007
23009 continue
return
end
integer function verpos ( s , x , y )
integer s ( 1 )
integer x , y
call putcha ( s )
call putc ( 32 )
call putpos ( x , y )
call putc ( 46 )
verpos = 0
return
end
integer function vertex ( x , y , s )
integer x , y , s ( 1 )
C string msg Text:
integer msg ( 6 )
data msg ( 1 ) , msg ( 2 ) , msg ( 3 ) , msg ( 4 ) , msg ( 5 ) / 8
*4 , 101 , 120 , 116 , 58 /
data msg ( 6 ) / 0 /
call putcha ( msg )
call putc ( 32 )
call putpos ( x , y )
call putc ( 32 )
call putc ( 34 )
call putcha ( s )
call putc ( 34 )
call putc ( 46 )
vertex = 0
return
end
integer function vermrk ( c , s )
integer c , s ( 1 )
call putc ( 34 )
call putc ( c )
call putcha ( s )
call putc ( 34 )
vermrk = 0
return
end
integer function vertxt ( index , value )
integer index , value
C string msg Text Option (
C string m2 ) =
C slist txtlab
C string txtcha font
C string + width
C string + height
C string + spacing
C string + italic angle
C string + slope angle
C elist txtlab
integer txtlab ( 6 )
integer msg ( 14 )
integer m2 ( 5 )
integer txtcha ( 51 )
data msg ( 1 ) , msg ( 2 ) , msg ( 3 ) , msg ( 4 ) , msg ( 5 ) / 8
*4 , 101 , 120 , 116 , 32 /
data msg ( 6 ) , msg ( 7 ) , msg ( 8 ) , msg ( 9 ) , msg ( 10 ) /
*79 , 112 , 116 , 105 , 111 /
data msg ( 11 ) , msg ( 12 ) , msg ( 13 ) , msg ( 14 ) / 110 , 32
*, 40 , 0 /
data m2 ( 1 ) , m2 ( 2 ) , m2 ( 3 ) , m2 ( 4 ) , m2 ( 5 ) / 41 , 3
*2 , 61 , 32 , 0 /
data txtcha ( 1 ) , txtcha ( 2 ) , txtcha ( 3 ) , txtcha ( 4 ) , t
*xtcha ( 5 ) / 102 , 111 , 110 , 116 , 0 /
data txtcha ( 6 ) , txtcha ( 7 ) , txtcha ( 8 ) , txtcha ( 9 ) , t
*xtcha ( 10 ) / 119 , 105 , 100 , 116 , 104 /
data txtcha ( 11 ) , txtcha ( 12 ) , txtcha ( 13 ) , txtcha ( 14 )
* , txtcha ( 15 ) / 0 , 104 , 101 , 105 , 103 /
data txtcha ( 16 ) , txtcha ( 17 ) , txtcha ( 18 ) , txtcha ( 19 )
* , txtcha ( 20 ) / 104 , 116 , 0 , 115 , 112 /
data txtcha ( 21 ) , txtcha ( 22 ) , txtcha ( 23 ) , txtcha ( 24 )
* , txtcha ( 25 ) / 97 , 99 , 105 , 110 , 103 /
data txtcha ( 26 ) , txtcha ( 27 ) , txtcha ( 28 ) , txtcha ( 29 )
* , txtcha ( 30 ) / 0 , 105 , 116 , 97 , 108 /
data txtcha ( 31 ) , txtcha ( 32 ) , txtcha ( 33 ) , txtcha ( 34 )
* , txtcha ( 35 ) / 105 , 99 , 32 , 97 , 110 /
data txtcha ( 36 ) , txtcha ( 37 ) , txtcha ( 38 ) , txtcha ( 39 )
* , txtcha ( 40 ) / 103 , 108 , 101 , 0 , 115 /
data txtcha ( 41 ) , txtcha ( 42 ) , txtcha ( 43 ) , txtcha ( 44 )
* , txtcha ( 45 ) / 108 , 111 , 112 , 101 , 32 /
data txtcha ( 46 ) , txtcha ( 47 ) , txtcha ( 48 ) , txtcha ( 49 )
* , txtcha ( 50 ) / 97 , 110 , 103 , 108 , 101 /
data txtcha ( 51 ) / 0 /
data txtlab ( 1 ) , txtlab ( 2 ) , txtlab ( 3 ) , txtlab ( 4 ) , t
*xtlab ( 5 ) / 1 , 6 , 12 , 19 , 27 /
data txtlab ( 6 ) / 40 /
call putcha ( msg )
call putcha ( txtcha ( txtlab ( index ) ) )
call putcha ( m2 )
call putdec ( value )
vertxt = 0
return
end
integer function verwrt ( index , value )
integer index , value
C string msg Writing Option (
C string m2 ) =
C slist wrtlab
C string wrtcha raster op
C string + negate
C string + pattern
C string + pattern multiplier
C string + shading
C string + shading y axis
C string + pixel multiplier
C string + blink
C string + color
C string + background color
C elist wrtlab
integer wrtlab ( 10 )
integer msg ( 17 )
integer m2 ( 5 )
integer wrtcha ( 113 )
data msg ( 1 ) , msg ( 2 ) , msg ( 3 ) , msg ( 4 ) , msg ( 5 ) / 8
*7 , 114 , 105 , 116 , 105 /
data msg ( 6 ) , msg ( 7 ) , msg ( 8 ) , msg ( 9 ) , msg ( 10 ) /
*110 , 103 , 32 , 79 , 112 /
data msg ( 11 ) , msg ( 12 ) , msg ( 13 ) , msg ( 14 ) , msg ( 15
*) / 116 , 105 , 111 , 110 , 32 /
data msg ( 16 ) , msg ( 17 ) / 40 , 0 /
data m2 ( 1 ) , m2 ( 2 ) , m2 ( 3 ) , m2 ( 4 ) , m2 ( 5 ) / 41 , 3
*2 , 61 , 32 , 0 /
data wrtcha ( 1 ) , wrtcha ( 2 ) , wrtcha ( 3 ) , wrtcha ( 4 ) , w
*rtcha ( 5 ) / 114 , 97 , 115 , 116 , 101 /
data wrtcha ( 6 ) , wrtcha ( 7 ) , wrtcha ( 8 ) , wrtcha ( 9 ) , w
*rtcha ( 10 ) / 114 , 32 , 111 , 112 , 0 /
data wrtcha ( 11 ) , wrtcha ( 12 ) , wrtcha ( 13 ) , wrtcha ( 14 )
* , wrtcha ( 15 ) / 110 , 101 , 103 , 97 , 116 /
data wrtcha ( 16 ) , wrtcha ( 17 ) , wrtcha ( 18 ) , wrtcha ( 19 )
* , wrtcha ( 20 ) / 101 , 0 , 112 , 97 , 116 /
data wrtcha ( 21 ) , wrtcha ( 22 ) , wrtcha ( 23 ) , wrtcha ( 24 )
* , wrtcha ( 25 ) / 116 , 101 , 114 , 110 , 0 /
data wrtcha ( 26 ) , wrtcha ( 27 ) , wrtcha ( 28 ) , wrtcha ( 29 )
* , wrtcha ( 30 ) / 112 , 97 , 116 , 116 , 101 /
data wrtcha ( 31 ) , wrtcha ( 32 ) , wrtcha ( 33 ) , wrtcha ( 34 )
* , wrtcha ( 35 ) / 114 , 110 , 32 , 109 , 117 /
data wrtcha ( 36 ) , wrtcha ( 37 ) , wrtcha ( 38 ) , wrtcha ( 39 )
* , wrtcha ( 40 ) / 108 , 116 , 105 , 112 , 108 /
data wrtcha ( 41 ) , wrtcha ( 42 ) , wrtcha ( 43 ) , wrtcha ( 44 )
* , wrtcha ( 45 ) / 105 , 101 , 114 , 0 , 115 /
data wrtcha ( 46 ) , wrtcha ( 47 ) , wrtcha ( 48 ) , wrtcha ( 49 )
* , wrtcha ( 50 ) / 104 , 97 , 100 , 105 , 110 /
data wrtcha ( 51 ) , wrtcha ( 52 ) , wrtcha ( 53 ) , wrtcha ( 54 )
* , wrtcha ( 55 ) / 103 , 0 , 115 , 104 , 97 /
data wrtcha ( 56 ) , wrtcha ( 57 ) , wrtcha ( 58 ) , wrtcha ( 59 )
* , wrtcha ( 60 ) / 100 , 105 , 110 , 103 , 32 /
data wrtcha ( 61 ) , wrtcha ( 62 ) , wrtcha ( 63 ) , wrtcha ( 64 )
* , wrtcha ( 65 ) / 121 , 32 , 97 , 120 , 105 /
data wrtcha ( 66 ) , wrtcha ( 67 ) , wrtcha ( 68 ) , wrtcha ( 69 )
* , wrtcha ( 70 ) / 115 , 0 , 112 , 105 , 120 /
data wrtcha ( 71 ) , wrtcha ( 72 ) , wrtcha ( 73 ) , wrtcha ( 74 )
* , wrtcha ( 75 ) / 101 , 108 , 32 , 109 , 117 /
data wrtcha ( 76 ) , wrtcha ( 77 ) , wrtcha ( 78 ) , wrtcha ( 79 )
* , wrtcha ( 80 ) / 108 , 116 , 105 , 112 , 108 /
data wrtcha ( 81 ) , wrtcha ( 82 ) , wrtcha ( 83 ) , wrtcha ( 84 )
* , wrtcha ( 85 ) / 105 , 101 , 114 , 0 , 98 /
data wrtcha ( 86 ) , wrtcha ( 87 ) , wrtcha ( 88 ) , wrtcha ( 89 )
* , wrtcha ( 90 ) / 108 , 105 , 110 , 107 , 0 /
data wrtcha ( 91 ) , wrtcha ( 92 ) , wrtcha ( 93 ) , wrtcha ( 94 )
* , wrtcha ( 95 ) / 99 , 111 , 108 , 111 , 114 /
data wrtcha ( 96 ) , wrtcha ( 97 ) , wrtcha ( 98 ) , wrtcha ( 99 )
* , wrtcha ( 100 ) / 0 , 98 , 97 , 99 , 107 /
data wrtcha ( 101 ) , wrtcha ( 102 ) , wrtcha ( 103 ) , wrtcha ( 1
*04 ) , wrtcha ( 105 ) / 103 , 114 , 111 , 117 , 110 /
data wrtcha ( 106 ) , wrtcha ( 107 ) , wrtcha ( 108 ) , wrtcha ( 1
*09 ) , wrtcha ( 110 ) / 100 , 32 , 99 , 111 , 108 /
data wrtcha ( 111 ) , wrtcha ( 112 ) , wrtcha ( 113 ) / 111 , 114
*, 0 /
data wrtlab ( 1 ) , wrtlab ( 2 ) , wrtlab ( 3 ) , wrtlab ( 4 ) , w
*rtlab ( 5 ) / 1 , 11 , 18 , 26 , 45 /
data wrtlab ( 6 ) , wrtlab ( 7 ) , wrtlab ( 8 ) , wrtlab ( 9 ) , w
*rtlab ( 10 ) / 53 , 68 , 85 , 91 , 97 /
call putcha ( msg )
call putcha ( wrtcha ( wrtlab ( index ) ) )
call putcha ( m2 )
call putdec ( value )
verwrt = 0
return
end