Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/wops.for
There are no other files named wops.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 copywo ( wo1 , wo2 , len )
integer wo1 ( 1 ) , wo2 ( 1 ) , len
integer i
continue
i = 1
23000 if(.not.(i.le.len))goto 23002
wo2 ( i ) = wo1 ( i )
23001 i=i+1
goto 23000
23002 continue
copywo = len
return
end
integer function setwop ( wop )
integer wop ( 10 )
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
call altwop ( gwop ( gwopsp ) , wop )
call copywo ( wop , gwop , 10 )
gwopsp = 1
setwop = 0
return
end
integer function newwop ( wo )
integer wo ( 10 )
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
call altwop ( gwop ( gwopsp ) , wo )
call copywo ( wo , gwop ( gwopsp ) , 10 )
newwop = 0
return
end
integer function getwop ( wo )
integer wo ( 10 )
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
call copywo ( gwop ( gwopsp ) , wo , 10 )
getwop = 0
return
end
integer function putwop ( noargs )
integer noargs
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 dwom ( 10 )
data dwom ( 1 ) , dwom ( 2 ) , dwom ( 3 ) , dwom ( 4 ) , dwom ( 5
*) / - 1 , - 1 , - 1 , - 1 , - 1 /
data dwom ( 6 ) , dwom ( 7 ) , dwom ( 8 ) , dwom ( 9 ) , dwom ( 10
* ) / - 1 , - 1 , - 1 , - 1 , - 1 /
call altwop ( dwom , gwop ( gwopsp ) )
putwop = 0
return
end
integer function pushwo ( wo )
integer wo ( 10 )
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
C string ovmesg attribute stack overflow
integer ovmesg ( 25 )
data ovmesg ( 1 ) , ovmesg ( 2 ) , ovmesg ( 3 ) , ovmesg ( 4 ) , o
*vmesg ( 5 ) / 97 , 116 , 116 , 114 , 105 /
data ovmesg ( 6 ) , ovmesg ( 7 ) , ovmesg ( 8 ) , ovmesg ( 9 ) , o
*vmesg ( 10 ) / 98 , 117 , 116 , 101 , 32 /
data ovmesg ( 11 ) , ovmesg ( 12 ) , ovmesg ( 13 ) , ovmesg ( 14 )
* , ovmesg ( 15 ) / 115 , 116 , 97 , 99 , 107 /
data ovmesg ( 16 ) , ovmesg ( 17 ) , ovmesg ( 18 ) , ovmesg ( 19 )
* , ovmesg ( 20 ) / 32 , 111 , 118 , 101 , 114 /
data ovmesg ( 21 ) , ovmesg ( 22 ) , ovmesg ( 23 ) , ovmesg ( 24 )
* , ovmesg ( 25 ) / 102 , 108 , 111 , 119 , 0 /
if(.not.( gwopsp .ge. 10 * 4 ))goto 23003
call kbdead
call putcha ( ovmesg )
call kblive
pushwo = - 1
return
23003 continue
call altwop ( gwop ( gwopsp ) , wo )
call copywo ( wo , gwop ( gwopsp + 10 ) , 10 )
gwopsp = gwopsp + 10
pushwo = 0
return
end
integer function popwo ( noargs )
integer noargs
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
if(.not.( gwopsp .lt. 10 ))goto 23005
return
23005 continue
call altwop ( gwop ( gwopsp ) , gwop ( gwopsp - 10 ) )
gwopsp = gwopsp - 10
popwo = 0
return
end
integer function dupwo ( noargs )
integer noargs
integer wo ( 10 )
call getwop ( wo )
call pushwo ( wo )
dupwo = 0
return
end
integer function glowop ( noargs )
integer noargs
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
call copywo ( wrtopt , wrtcrv , 10 )
call copywo ( wrtopt , wrtlin , 10 )
call copywo ( wrtopt , wrtbox , 10 )
call copywo ( wrtopt , wrtcir , 10 )
call copywo ( wrtopt , wrttxt , 10 )
call setwop ( wrtopt )
glowop = 0
return
end
integer function pushxo ( noargs )
integer noargs
integer locwop ( 10 )
call getwop ( locwop )
locwop ( 9 ) = 8
locwop ( 1 ) = 2
call pushwo ( locwop )
pushxo = 0
return
end