Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/erase.for
There are no other files named erase.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 erase ( n )
integer n
C string pos0 \np[0,0]
integer pos0 ( 8 )
data pos0 ( 1 ) , pos0 ( 2 ) , pos0 ( 3 ) , pos0 ( 4 ) , pos0 ( 5
*) / 10 , 112 , 91 , 48 , 44 /
data pos0 ( 6 ) , pos0 ( 7 ) , pos0 ( 8 ) / 48 , 93 , 0 /
call putcha ( pos0 )
call setpos ( 0 , 0 )
call putc ( 115 )
call putc ( 40 )
call putc ( 105 )
call putdec ( mod ( n , 8 ) )
call putc ( 44 )
call putc ( 101 )
call putc ( 41 )
erase = 0
return
end
integer function aderas ( wop )
integer wop ( 10 )
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
integer confrm , insgel , adwopt
C string eras new page
integer eras ( 9 )
data eras ( 1 ) , eras ( 2 ) , eras ( 3 ) , eras ( 4 ) , eras ( 5
*) / 110 , 101 , 119 , 32 , 112 /
data eras ( 6 ) , eras ( 7 ) , eras ( 8 ) , eras ( 9 ) / 97 , 103
*, 101 , 0 /
aderas = 0
if(.not.( confrm ( eras ) .lt. 0 ))goto 23000
return
23000 continue
dotgel = adwopt ( dollar , wop )
if(.not.( insgel ( dotgel , 1 ) .lt. 0 ))goto 23002
return
23002 continue
gel ( dotgel ) = 10
call erase ( wop ( 10 ) )
return
end
integer function cyeras ( k , m )
integer k , m
integer cycval
integer erasv ( 8 )
C string eras Background
C slist erasi
C string erasc black/0
C string + blue/1
C string + red/2
C string + magenta/3
C string + green/4
C string + cyan/5
C string + yellow/6
C string + white/7
C elist erasi
integer erasi ( 8 )
integer eras ( 11 )
integer erasc ( 63 )
data eras ( 1 ) , eras ( 2 ) , eras ( 3 ) , eras ( 4 ) , eras ( 5
*) / 66 , 97 , 99 , 107 , 103 /
data eras ( 6 ) , eras ( 7 ) , eras ( 8 ) , eras ( 9 ) , eras ( 10
* ) / 114 , 111 , 117 , 110 , 100 /
data eras ( 11 ) / 0 /
data erasc ( 1 ) , erasc ( 2 ) , erasc ( 3 ) , erasc ( 4 ) , erasc
* ( 5 ) / 98 , 108 , 97 , 99 , 107 /
data erasc ( 6 ) , erasc ( 7 ) , erasc ( 8 ) , erasc ( 9 ) , erasc
* ( 10 ) / 47 , 48 , 0 , 98 , 108 /
data erasc ( 11 ) , erasc ( 12 ) , erasc ( 13 ) , erasc ( 14 ) , e
*rasc ( 15 ) / 117 , 101 , 47 , 49 , 0 /
data erasc ( 16 ) , erasc ( 17 ) , erasc ( 18 ) , erasc ( 19 ) , e
*rasc ( 20 ) / 114 , 101 , 100 , 47 , 50 /
data erasc ( 21 ) , erasc ( 22 ) , erasc ( 23 ) , erasc ( 24 ) , e
*rasc ( 25 ) / 0 , 109 , 97 , 103 , 101 /
data erasc ( 26 ) , erasc ( 27 ) , erasc ( 28 ) , erasc ( 29 ) , e
*rasc ( 30 ) / 110 , 116 , 97 , 47 , 51 /
data erasc ( 31 ) , erasc ( 32 ) , erasc ( 33 ) , erasc ( 34 ) , e
*rasc ( 35 ) / 0 , 103 , 114 , 101 , 101 /
data erasc ( 36 ) , erasc ( 37 ) , erasc ( 38 ) , erasc ( 39 ) , e
*rasc ( 40 ) / 110 , 47 , 52 , 0 , 99 /
data erasc ( 41 ) , erasc ( 42 ) , erasc ( 43 ) , erasc ( 44 ) , e
*rasc ( 45 ) / 121 , 97 , 110 , 47 , 53 /
data erasc ( 46 ) , erasc ( 47 ) , erasc ( 48 ) , erasc ( 49 ) , e
*rasc ( 50 ) / 0 , 121 , 101 , 108 , 108 /
data erasc ( 51 ) , erasc ( 52 ) , erasc ( 53 ) , erasc ( 54 ) , e
*rasc ( 55 ) / 111 , 119 , 47 , 54 , 0 /
data erasc ( 56 ) , erasc ( 57 ) , erasc ( 58 ) , erasc ( 59 ) , e
*rasc ( 60 ) / 119 , 104 , 105 , 116 , 101 /
data erasc ( 61 ) , erasc ( 62 ) , erasc ( 63 ) / 47 , 55 , 0 /
data erasi ( 1 ) , erasi ( 2 ) , erasi ( 3 ) , erasi ( 4 ) , erasi
* ( 5 ) / 1 , 9 , 16 , 22 , 32 /
data erasi ( 6 ) , erasi ( 7 ) , erasi ( 8 ) / 40 , 47 , 56 /
data erasv ( 1 ) , erasv ( 2 ) , erasv ( 3 ) , erasv ( 4 ) , erasv
* ( 5 ) / 0 , 1 , 2 , 3 , 4 /
data erasv ( 6 ) , erasv ( 7 ) , erasv ( 8 ) / 5 , 6 , 7 /
cyeras = cycval ( k , eras , 8 , erasi , erasc , erasv , m )
if(.not.( cyeras .gt. 0 ))goto 23004
call regis
call bakolr ( m )
call unrgis
23004 continue
return
end
integer function bakolr ( n )
C set background color
integer n
call putc ( 115 )
call putc ( 40 )
call putc ( 105 )
call putdec ( mod ( n , 8 ) )
call putc ( 41 )
bakolr = 0
return
end