Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/attrib.for
There are no other files named attrib.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 attrib ( wrt , txt , global )
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
integer wrt ( 10 ) , txt ( 6 ) , global
integer inch , key , c
integer m , did , atting
integer cyrast , cynega , cyblnk , cycolr , cyshad , cypatt , cypm
*ul
integer cyfont , cywide , cyhght , cyspac , cyital , cyslop , cyer
*as
integer t
C string aprmpt Select Attribute:
integer aprmpt ( 19 )
data aprmpt ( 1 ) , aprmpt ( 2 ) , aprmpt ( 3 ) , aprmpt ( 4 ) , a
*prmpt ( 5 ) / 83 , 101 , 108 , 101 , 99 /
data aprmpt ( 6 ) , aprmpt ( 7 ) , aprmpt ( 8 ) , aprmpt ( 9 ) , a
*prmpt ( 10 ) / 116 , 32 , 65 , 116 , 116 /
data aprmpt ( 11 ) , aprmpt ( 12 ) , aprmpt ( 13 ) , aprmpt ( 14 )
* , aprmpt ( 15 ) / 114 , 105 , 98 , 117 , 116 /
data aprmpt ( 16 ) , aprmpt ( 17 ) , aprmpt ( 18 ) , aprmpt ( 19 )
* / 101 , 58 , 32 , 0 /
atting = 1
continue
23000 if(.not.( atting .ne. 0 ))goto 23001
call uprmt ( aprmpt )
m = 0
key = inch ( c )
if(.not.( key .eq. 267 ))goto 23002
did = cyslop ( key , txt ( 6 ) )
goto 23003
23002 continue
if(.not.( key .eq. 261 ))goto 23004
did = cyital ( key , txt ( 5 ) )
goto 23005
23004 continue
if(.not.( key .eq. 266 ))goto 23006
did = cyspac ( key , txt ( 4 ) )
goto 23007
23006 continue
if(.not.( key .eq. 263 ))goto 23008
did = cyhght ( key , txt ( 3 ) )
goto 23009
23008 continue
if(.not.( key .eq. 277 ))goto 23010
did = cywide ( key , txt ( 2 ) )
goto 23011
23010 continue
if(.not.( key .eq. 262 ))goto 23012
did = cyfont ( key , txt ( 1 ) )
goto 23013
23012 continue
if(.not.( key .eq. 274 ))goto 23014
did = cyeras ( key , wrt ( 10 ) )
m = 10
C RJF -- why was this line missing?
goto 23015
23014 continue
if(.not.( key .eq. 265 ))goto 23016
did = cypmul ( key , wrt ( 4 ) )
m = 4
goto 23017
23016 continue
if(.not.( key .eq. 260 ))goto 23018
did = cypatt ( key , wrt ( 3 ) )
m = 3
goto 23019
23018 continue
if(.not.( key .eq. 264 ))goto 23020
did = cyshad ( key , wrt ( 5 ) )
m = 5
goto 23021
23020 continue
if(.not.( key .eq. 272 ))goto 23022
did = cycolr ( key , wrt ( 9 ) )
m = 9
goto 23023
23022 continue
if(.not.( key .eq. 271 ))goto 23024
did = cyblnk ( key , wrt ( 8 ) )
m = 8
goto 23025
23024 continue
if(.not.( key .eq. 270 ))goto 23026
did = cynega ( key , wrt ( 2 ) )
m = 2
goto 23027
23026 continue
if(.not.( key .eq. 269 ))goto 23028
did = cyrast ( key , wrt ( 1 ) )
m = 1
goto 23029
23028 continue
if(.not.( key .lt. 256 ))goto 23030
did = 0
goto 23031
23030 continue
did = - 1
23031 continue
23029 continue
23027 continue
23025 continue
23023 continue
23021 continue
23019 continue
23017 continue
23015 continue
23013 continue
23011 continue
23009 continue
23007 continue
23005 continue
23003 continue
if(.not.( global .ne. 0 .and. did .gt. 0 .and. m .gt. 0 ))goto 230
*32
t = wrt ( m )
wrtopt ( m ) = t
wrtcrv ( m ) = t
wrtlin ( m ) = t
wrtbox ( m ) = t
wrtcir ( m ) = t
wrttxt ( m ) = t
23032 continue
if(.not.( did .ge. 0 ))goto 23034
atting = 0
23034 continue
goto 23000
23001 continue
if(.not.( did .ge. 0 ))goto 23036
attrib = did
goto 23037
23036 continue
attrib = 0
23037 continue
return
end