Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/ge.for
There is 1 other file named ge.for in the archive. Click here to see a list.
C ge -- main program for Graphics Editor
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 ========================================================================
common / glopts / wrtopt , wrtcrv , wrtlin , wrtbox , wrtcir , wrt
*txt , txtopt , gwopsp , gwop , ttytop
integer wrtopt ( 10 ) , wrtcrv ( 10 ) , wrtlin ( 10 ) , wrtbox ( 1
*0 )
integer wrtcir ( 10 ) , wrttxt ( 10 ) , txtopt ( 6 ) , ttytop ( 6
*)
integer gwop ( 36 ) , gwopsp
C ^ should be Woplen*Maxwops
integer curdx , curdy , smalld , larged
integer scf , lorng , hirng
integer cname ( 75 )
common / keypad / curdx , curdy , smalld , larged , scf , lorng ,
*hirng , cname
C typed commands...
C > 255 for regis exec, > 127 otherwise
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
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
C include logcom
integer c , cmd , getc , inch , inpfil
C string scor1 \ns[0,0](i0,e,a[0,0][767,479])
C string wframe w(p1i7va0n0s0)
C string prompt V1.01 - Command:
C string eprmpt Enter
C string helpch ? for help
C string cmdhlp cmd
integer scor1 ( 30 )
integer wframe ( 15 )
integer prompt ( 18 )
integer eprmpt ( 6 )
integer helpch ( 11 )
integer cmdhlp ( 4 )
data scor1 ( 1 ) , scor1 ( 2 ) , scor1 ( 3 ) , scor1 ( 4 ) , scor1
* ( 5 ) / 10 , 115 , 91 , 48 , 44 /
data scor1 ( 6 ) , scor1 ( 7 ) , scor1 ( 8 ) , scor1 ( 9 ) , scor1
* ( 10 ) / 48 , 93 , 40 , 105 , 48 /
data scor1 ( 11 ) , scor1 ( 12 ) , scor1 ( 13 ) , scor1 ( 14 ) , s
*cor1 ( 15 ) / 44 , 101 , 44 , 97 , 91 /
data scor1 ( 16 ) , scor1 ( 17 ) , scor1 ( 18 ) , scor1 ( 19 ) , s
*cor1 ( 20 ) / 48 , 44 , 48 , 93 , 91 /
data scor1 ( 21 ) , scor1 ( 22 ) , scor1 ( 23 ) , scor1 ( 24 ) , s
*cor1 ( 25 ) / 55 , 54 , 55 , 44 , 52 /
data scor1 ( 26 ) , scor1 ( 27 ) , scor1 ( 28 ) , scor1 ( 29 ) , s
*cor1 ( 30 ) / 55 , 57 , 93 , 41 , 0 /
data wframe ( 1 ) , wframe ( 2 ) , wframe ( 3 ) , wframe ( 4 ) , w
*frame ( 5 ) / 119 , 40 , 112 , 49 , 105 /
data wframe ( 6 ) , wframe ( 7 ) , wframe ( 8 ) , wframe ( 9 ) , w
*frame ( 10 ) / 55 , 118 , 97 , 48 , 110 /
data wframe ( 11 ) , wframe ( 12 ) , wframe ( 13 ) , wframe ( 14 )
* , wframe ( 15 ) / 48 , 115 , 48 , 41 , 0 /
data prompt ( 1 ) , prompt ( 2 ) , prompt ( 3 ) , prompt ( 4 ) , p
*rompt ( 5 ) / 86 , 49 , 46 , 48 , 49 /
data prompt ( 6 ) , prompt ( 7 ) , prompt ( 8 ) , prompt ( 9 ) , p
*rompt ( 10 ) / 32 , 45 , 32 , 67 , 111 /
data prompt ( 11 ) , prompt ( 12 ) , prompt ( 13 ) , prompt ( 14 )
* , prompt ( 15 ) / 109 , 109 , 97 , 110 , 100 /
data prompt ( 16 ) , prompt ( 17 ) , prompt ( 18 ) / 58 , 32 , 0 /
data eprmpt ( 1 ) , eprmpt ( 2 ) , eprmpt ( 3 ) , eprmpt ( 4 ) , e
*prmpt ( 5 ) / 69 , 110 , 116 , 101 , 114 /
data eprmpt ( 6 ) / 0 /
data helpch ( 1 ) , helpch ( 2 ) , helpch ( 3 ) , helpch ( 4 ) , h
*elpch ( 5 ) / 63 , 32 , 102 , 111 , 114 /
data helpch ( 6 ) , helpch ( 7 ) , helpch ( 8 ) , helpch ( 9 ) , h
*elpch ( 10 ) / 32 , 104 , 101 , 108 , 112 /
data helpch ( 11 ) / 0 /
data cmdhlp ( 1 ) , cmdhlp ( 2 ) , cmdhlp ( 3 ) , cmdhlp ( 4 ) / 9
*9 , 109 , 100 , 0 /
relflg = 0
call utty ( 2 )
call gettm
call regis
call putcha ( scor1 )
call newtop ( txtopt )
call glowop
call drwbox ( 0 , 0 , 767 , 480 )
call scrset
call unrgis
call pgkeys
call setup ( 80 , 75 , 49 )
call setup ( 86 , 67 , 51 )
continue
23000 if(.not.( cmd .ne. 128 ))goto 23001
call uprmt ( prompt )
cmd = inch ( c )
if(.not.( cmd .eq. 277 ))goto 23002
cmd = 129
C LOGSTAR 'ge>', cmd, c, dollar, dotgel, gel(dotgel), lorng, hirng
C call putarg(cname)
23002 continue
if(.not.( cmd .eq. 273 ))goto 23004
call kblive
call attrib ( wrtopt , txtopt , 1 )
call regis
call setwop ( wrtopt )
call kbdead
C non-regis execution stuff...
goto 23005
23004 continue
if(.not.( cmd .eq. 134 ))goto 23006
call getgel ( cname , hirng )
goto 23007
23006 continue
if(.not.( cmd .eq. 133 ))goto 23008
call putgel ( cname , lorng , hirng )
goto 23009
23008 continue
if(.not.( cmd .eq. 130 ))goto 23010
call admark ( 12 , cname , lorng , hirng )
goto 23011
23010 continue
if(.not.( cmd .eq. 131 ))goto 23012
call admark ( 11 , cname , lorng , hirng )
goto 23013
23012 continue
if(.not.( cmd .eq. 132 ))goto 23014
call admark ( 14 , cname , lorng , hirng )
goto 23015
23014 continue
if(.not.( cmd .eq. 136 ))goto 23016
call vergel ( lorng , hirng )
goto 23017
23016 continue
if(.not.( cmd .eq. 137 ))goto 23018
call joiner ( lorng )
goto 23019
23018 continue
if(.not.( cmd .eq. 139 ))goto 23020
if(.not.( cname ( 1 ) .eq. 0 ))goto 23022
bkgdnm ( 1 ) = 0
C clearing
goto 23023
23022 continue
C setting
call fspec ( cname , pictyp )
if(.not.( inpfil ( 0 ) .eq. 0 ))goto 23024
C does file exist?
call clsinp
C yes
call cpystr ( pathn , bkgdnm )
goto 23025
23024 continue
call err ( pathn )
23025 continue
C no
23023 continue
goto 23021
23020 continue
if(.not.( cmd .eq. 138 ))goto 23026
relflg = 1
cx = 0
cy = 0
call putgel ( cname , lorng , hirng )
goto 23027
23026 continue
if(.not.( cmd .gt. 255 ))goto 23028
C then keypad interaction...
call kblive
call scrldn
if(.not.( cmd .eq. 269 ))goto 23030
call adnotz ( 118 , wrtlin , eprmpt )
goto 23031
23030 continue
if(.not.( cmd .eq. 270 ))goto 23032
call adbox ( wrtbox , eprmpt )
goto 23033
23032 continue
if(.not.( cmd .eq. 271 ))goto 23034
call adcirc ( wrtcir , eprmpt )
goto 23035
23034 continue
if(.not.( cmd .eq. 272 ))goto 23036
call adnotz ( 99 , wrtcrv , eprmpt )
goto 23037
23036 continue
if(.not.( cmd .eq. 276 ))goto 23038
call adtext ( wrttxt , eprmpt )
goto 23039
23038 continue
if(.not.( cmd .eq. 274 ))goto 23040
call aderas ( wrtopt )
goto 23041
23040 continue
if(.not.( cmd .eq. 275 ))goto 23042
call alter ( dotgel , dotgel )
goto 23043
23042 continue
if(.not.( cmd .eq. 268 ))goto 23044
call alter ( 1 , dollar )
goto 23045
23044 continue
if(.not.( cmd .eq. 296 ))goto 23046
call alter ( lorng , hirng )
goto 23047
23046 continue
if(.not.( cmd .eq. 299 ))goto 23048
call movgel ( lorng , hirng )
goto 23049
23048 continue
if(.not.( cmd .eq. 297 ))goto 23050
call sclgel ( lorng , hirng )
goto 23051
23050 continue
if(.not.( cmd .eq. 298 ))goto 23052
call rotgel ( lorng , hirng )
goto 23053
23052 continue
if(.not.( cmd .eq. 303 ))goto 23054
call delete ( lorng , hirng )
goto 23055
23054 continue
if(.not.( cmd .eq. 302 ))goto 23056
call cpygel ( lorng , hirng )
goto 23057
23056 continue
if(.not.( cmd .eq. 304 ))goto 23058
call ldfont ( lorng , cname )
C debug
C else if (cmd == Pfive) call dmpgel
C gubed
goto 23059
23058 continue
if(.not.( cmd .eq. 300 ))goto 23060
call dupwo
call erase ( 0 )
if(.not.( bkgdnm ( 1 ) .eq. 0 ))goto 23062
call putcha ( wframe )
call drwbox ( 0 , 0 , 767 , 480 )
goto 23063
23062 continue
C supply background
call cpystr ( bkgdnm , pathn )
if(.not.( inpfil ( 0 ) .eq. 0 ))goto 23064
continue
23066 if(.not.( getc ( c ) .ne. ( - 1 ) ))goto 23067
call putc ( c )
goto 23066
23067 continue
call clsinp
23064 continue
23063 continue
call drwgel ( lorng , hirng , 0 )
call popwo
23060 continue
23059 continue
23057 continue
23055 continue
23053 continue
23051 continue
23049 continue
23047 continue
23045 continue
23043 continue
23041 continue
23039 continue
23037 continue
23035 continue
23033 continue
23031 continue
call scrlup
call kbdead
goto 23029
23028 continue
if(.not.( cmd .eq. 129 ))goto 23068
call helpfl ( cmdhlp )
call catfil
call regis
call putwop
call puttop
call unrgis
goto 23069
23068 continue
if(.not.( cmd .lt. 128 ))goto 23070
call err ( helpch )
23070 continue
23069 continue
23029 continue
23027 continue
23021 continue
23019 continue
23017 continue
23015 continue
23013 continue
23011 continue
23009 continue
23007 continue
23005 continue
goto 23000
23001 continue
call regis
call scrldn
call ttyres
end
C ttyres - called before exiting, or by ^C handler
integer function ttyres ( noargs )
integer noargs
integer cmprmt ( 130 )
C prompting text
integer lin ( 80 )
C tty input buffer
integer tm
C original TM value (0 VT52, 1 ANSI)
common / ctty / tm , cmprmt , lin
call unrgis
call setup ( 80 , 75 , 48 )
call setup ( 83 , 67 , 48 )
call foot
call flusho
C flush output to tty
call utty ( 1 )
ttyres = 0
end