Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/altwop.for
There are no other files named altwop.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 altwop ( wo0 , wo1 )
integer wo0 ( 10 ) , wo1 ( 10 )
integer cx , cy , relflg , sx , sy
common / compos / cx , cy
common / comrel / relflg
common / comsav / sx , sy
integer res ( 50 )
integer itoc
integer bval
integer rp
integer i
res ( 1 ) = 119
res ( 2 ) = 40
rp = 3
if(.not.( wo1 ( 1 ) .ne. wo0 ( 1 ) ))goto 23000
if(.not.( wo1 ( 1 ) .eq. 3 ))goto 23002
res ( rp ) = 118
goto 23003
23002 continue
if(.not.( wo1 ( 1 ) .eq. 2 ))goto 23004
res ( rp ) = 99
goto 23005
23004 continue
if(.not.( wo1 ( 1 ) .eq. 1 ))goto 23006
res ( rp ) = 101
goto 23007
23006 continue
res ( rp ) = 114
23007 continue
23005 continue
23003 continue
C Replace
rp = rp + 1
23000 continue
if(.not.( wo1 ( 2 ) .ne. wo0 ( 2 ) ))goto 23008
if(.not.( rp .gt. 3 ))goto 23010
res ( rp ) = 44
rp = rp + 1
23010 continue
res ( rp ) = 110
rp = rp + 1
if(.not.( wo1 ( 2 ) .ne. 0 ))goto 23012
res ( rp ) = 49
goto 23013
23012 continue
res ( rp ) = 48
23013 continue
rp = rp + 1
23008 continue
if(.not.( wo1 ( 3 ) .ne. wo0 ( 3 ) .or. wo1 ( 4 ) .ne. wo0 ( 4 ) )
*)goto 23014
if(.not.( rp .gt. 3 ))goto 23016
res ( rp ) = 44
rp = rp + 1
23016 continue
res ( rp ) = 112
rp = rp + 1
if(.not.( wo1 ( 3 ) .gt. 255 ))goto 23018
res ( rp ) = 48 + wo1 ( 3 ) / 256
rp = rp + 1
goto 23019
23018 continue
bval = wo1 ( 3 )
rp = rp + 8
continue
i = 1
23020 if(.not.(i.le.8))goto 23022
if(.not.( mod ( bval , 2 ) .eq. 0 ))goto 23023
res ( rp - i ) = 48
goto 23024
23023 continue
res ( rp - i ) = 49
23024 continue
bval = bval / 2
23021 i=i+1
goto 23020
23022 continue
23019 continue
res ( rp ) = 40
rp = rp + 1
res ( rp ) = 109
rp = rp + 1
if(.not.( wo1 ( 4 ) .lt. 1 .or. wo1 ( 4 ) .gt. 9 ))goto 23025
res ( rp ) = 49
rp = rp + 1
goto 23026
23025 continue
res ( rp ) = 48 + wo1 ( 4 )
rp = rp + 1
23026 continue
res ( rp ) = 41
rp = rp + 1
23014 continue
if(.not.( wo1 ( 5 ) .ne. wo0 ( 5 ) .or. wo1 ( 6 ) .ne. wo0 ( 6 ) )
*)goto 23027
if(.not.( rp .gt. 3 ))goto 23029
res ( rp ) = 44
rp = rp + 1
23029 continue
res ( rp ) = 115
rp = rp + 1
if(.not.( wo1 ( 5 ) .eq. 0 ))goto 23031
res ( rp ) = 48
rp = rp + 1
goto 23032
23031 continue
if(.not.( wo1 ( 5 ) .lt. 10 ))goto 23033
res ( rp ) = 48 + wo1 ( 5 )
rp = rp + 1
goto 23034
23033 continue
res ( rp ) = 39
rp = rp + 1
res ( rp ) = wo1 ( 5 )
rp = rp + 1
res ( rp ) = 39
rp = rp + 1
23034 continue
23032 continue
if(.not.( wo1 ( 5 ) .ne. 0 ))goto 23035
res ( rp ) = 91
rp = rp + 1
res ( rp ) = 44
rp = rp + 1
if(.not.( relflg .eq. 0 ))goto 23037
rp = rp + itoc ( wo1 ( 6 ) , res ( rp ) , 4 )
goto 23038
23037 continue
if(.not.( wo1 ( 6 ) .ge. cy ))goto 23039
res ( rp ) = 43
rp = rp + 1
23039 continue
rp = rp + itoc ( wo1 ( 6 ) - cy , res ( rp ) , 5 )
23038 continue
res ( rp ) = 93
rp = rp + 1
23035 continue
23027 continue
if(.not.( wo1 ( 7 ) .ne. wo0 ( 7 ) ))goto 23041
if(.not.( rp .gt. 3 ))goto 23043
res ( rp ) = 44
rp = rp + 1
23043 continue
res ( rp ) = 109
rp = rp + 1
rp = rp + itoc ( wo1 ( 7 ) , res ( rp ) , 3 )
23041 continue
if(.not.( wo1 ( 8 ) .ne. wo0 ( 8 ) ))goto 23045
if(.not.( rp .gt. 3 ))goto 23047
res ( rp ) = 44
rp = rp + 1
23047 continue
res ( rp ) = 97
rp = rp + 1
if(.not.( wo1 ( 8 ) .ne. 0 ))goto 23049
res ( rp ) = 49
goto 23050
23049 continue
res ( rp ) = 48
23050 continue
rp = rp + 1
23045 continue
if(.not.( wo1 ( 9 ) .ne. wo0 ( 9 ) ))goto 23051
if(.not.( rp .gt. 3 ))goto 23053
res ( rp ) = 44
rp = rp + 1
23053 continue
res ( rp ) = 105
rp = rp + 1
if(.not.( wo1 ( 9 ) .ge. 0 .and. wo1 ( 9 ) .lt. 8 ))goto 23055
res ( rp ) = 48 + wo1 ( 9 )
rp = rp + 1
23055 continue
23051 continue
res ( rp ) = 41
rp = rp + 1
res ( rp ) = 0
altwop = rp
if(.not.( rp .lt. 5 ))goto 23057
return
23057 continue
call putc ( 10 )
call putcha ( res )
return
end