Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/alter.for
There are no other files named alter.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 alter ( op0 , opn )
integer op0 , opn
integer curdx , curdy , smalld , larged
integer scf , lorng , hirng
integer cname ( 75 )
common / keypad / curdx , curdy , smalld , larged , scf , lorng ,
*hirng , cname
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
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 pregel , lengel , alter1
integer movgel , delete
integer adwopt , adtopt
integer helper
integer twop ( 10 ) , savwop ( 10 )
integer ttop ( 6 ) , savtop ( 6 )
integer p0 , pn , pc
integer inch , key , c
integer lp , pp
integer modded
C string altstr Select
C string pmtstr object
C string althlp alt
integer altstr ( 7 )
integer pmtstr ( 7 )
integer althlp ( 4 )
data altstr ( 1 ) , altstr ( 2 ) , altstr ( 3 ) , altstr ( 4 ) , a
*ltstr ( 5 ) / 83 , 101 , 108 , 101 , 99 /
data altstr ( 6 ) , altstr ( 7 ) / 116 , 0 /
data pmtstr ( 1 ) , pmtstr ( 2 ) , pmtstr ( 3 ) , pmtstr ( 4 ) , p
*mtstr ( 5 ) / 111 , 98 , 106 , 101 , 99 /
data pmtstr ( 6 ) , pmtstr ( 7 ) / 116 , 0 /
data althlp ( 1 ) , althlp ( 2 ) , althlp ( 3 ) , althlp ( 4 ) / 9
*7 , 108 , 116 , 0 /
continue
pn = opn
23000 if(.not.(pn.gt.op0.and.(gel(pn).le.0.or.gel(pn).gt.7)))goto 23002
23001 pn=pregel(pn)
goto 23000
23002 continue
continue
p0 = op0
23003 if(.not.(gel(p0).le.0.or.gel(p0).gt.7))goto 23005
if(.not.( p0 .ge. pn ))goto 23006
return
23006 continue
23004 p0=p0+lengel(p0)
goto 23003
23005 continue
pc = dotgel
C use dotgel as start if within range and legal object -- RJF
if(.not.( pc .lt. p0 .or. pc .gt. pn .or. gel ( pc ) .le. 0 .or. g
*el ( pc ) .gt. 7 ))goto 23008
pc = p0
23008 continue
dotgel = pc
C invocation of alter always sets dotgel -- RJF
alter = 1
call getwop ( twop )
call copywo ( txtopt , ttop , 6 )
call sumopt ( p0 , twop , ttop )
call copywo ( twop , savwop , 10 )
call copywo ( ttop , savtop , 6 )
call pushxo
call prompt ( altstr , pmtstr )
if(.not.( p0 .eq. pn ))goto 23010
call usemac ( 80 )
call defmac ( 90 )
call drwgel ( p0 , p0 , 1 )
call fedmac ( 90 )
if(.not.( alter1 ( p0 , pn ) .eq. 0 ))goto 23012
call usemac ( 90 )
23012 continue
call prompt ( altstr , pmtstr )
goto 23011
23010 continue
continue
23014 if(.not.( alter .ne. 0 ))goto 23015
call posgel ( pc )
dotgel = pc
C invocation of alter always sets dotgel -- RJF
C debug
C call putc(Semicolon);call putc(Quote1);call putdec(p0); call putc(Colon);
C call putdec(pn); call putc(Dot); call putdec(pc); call putc(Quote1)
C gubed
key = inch ( c )
if(.not.( key .eq. 268 ))goto 23016
call usemac ( 80 )
call defmac ( 90 )
call drwgel ( pc , pc , 1 )
call fedmac ( 90 )
if(.not.( alter1 ( pc , pn ) .eq. 0 ))goto 23018
call usemac ( 90 )
23018 continue
call prompt ( altstr , pmtstr )
goto 23017
23016 continue
if(.not.( key .eq. 274 ))goto 23020
pc = pc + lengel ( pc )
continue
23022 if(.not.( gel ( pc ) .lt. 0 .or. gel ( pc ) .gt. 7 ))goto 23023
pc = pc + lengel ( pc )
goto 23022
23023 continue
if(.not.( pc .gt. pn ))goto 23024
pc = pn
23024 continue
goto 23021
23020 continue
if(.not.( key .eq. 276 ))goto 23026
pc = pregel ( pc )
if(.not.( pc .lt. p0 ))goto 23028
pc = pn
23028 continue
goto 23027
23026 continue
if(.not.( key .eq. 269 ))goto 23030
call usemac ( 80 )
call popwo
modded = movgel ( pc , pc )
call pushxo
call prompt ( altstr , pmtstr )
goto 23031
23030 continue
if(.not.( key .eq. 270 ))goto 23032
call usemac ( 80 )
call popwo
call cpygel ( pc , pc )
call pushxo
call prompt ( altstr , pmtstr )
modded = 1
goto 23033
23032 continue
if(.not.( key .eq. 272 ))goto 23034
if(.not.( pc .ge. pn ))goto 23036
pp = pregel ( pc )
goto 23037
23036 continue
pp = pn - lengel ( pc )
23037 continue
call usemac ( 80 )
call popwo
modded = delete ( pc , pc )
if(.not.( modded .gt. 0 ))goto 23038
pn = pp
if(.not.( pc .gt. pn ))goto 23040
pc = pn
23040 continue
23038 continue
call pushxo
call prompt ( altstr , pmtstr )
goto 23035
23034 continue
if(.not.( key .eq. 275 ))goto 23042
dotgel = pc
alter = 0
goto 23043
23042 continue
if(.not.( key .eq. 273 ))goto 23044
call scrlup
call unrgis
call attrib ( twop , ttop , 0 )
call regis
call scrldn
pc = p0
p0 = adtopt ( adwopt ( p0 , twop ) , ttop )
pn = pn + p0 - pc
lp = adtopt ( adwopt ( pn + lengel ( pn ) , savwop ) , savtop )
pc = p0
goto 23045
23044 continue
if(.not.( key .eq. 277 ))goto 23046
if(.not.( helper ( althlp ) .eq. ( - 1 ) ))goto 23048
alter = 0
23048 continue
goto 23047
23046 continue
if(.not.( key .lt. 256 ))goto 23050
alter = 0
23050 continue
23047 continue
23045 continue
23043 continue
23035 continue
23033 continue
23031 continue
23027 continue
23021 continue
23017 continue
goto 23014
23015 continue
23011 continue
call usemac ( 80 )
call popwo
return
end