Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/shufle.for
There are no other files named shufle.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 cpygel ( lo , hix )
integer lo , hi , hix
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 lengel , adtopt , adwopt , confrm , insgel
integer lwop ( 10 ) , ltop ( 6 )
integer i , lp , len , pregel
integer doit
C string copys duplication
integer copys ( 12 )
data copys ( 1 ) , copys ( 2 ) , copys ( 3 ) , copys ( 4 ) , copys
* ( 5 ) / 100 , 117 , 112 , 108 , 105 /
data copys ( 6 ) , copys ( 7 ) , copys ( 8 ) , copys ( 9 ) , copys
* ( 10 ) / 99 , 97 , 116 , 105 , 111 /
data copys ( 11 ) , copys ( 12 ) / 110 , 0 /
len = 0
cpygel = 0
if(.not.( gel ( hix ) .eq. 0 .or. hix .ge. dollar ))goto 23000
hi = pregel ( hix )
goto 23001
23000 continue
hi = hix
23001 continue
call drwgel ( lo , hi , 1 )
doit = confrm ( copys )
call drwgel ( lo , hi , 1 )
if(.not.( doit .lt. 0 ))goto 23002
return
23002 continue
continue
i = lo
23004 if(.not.(i.le.hi))goto 23006
lp = lengel ( i )
len = len + lp
23005 i=i+lp
goto 23004
23006 continue
call copywo ( wrtopt , lwop , 10 )
call copywo ( txtopt , ltop , 6 )
call sumopt ( lo , lwop , ltop )
dotgel = adwopt ( adtopt ( dollar , ltop ) , lwop )
if(.not.( insgel ( dotgel , len ) .lt. 0 ))goto 23007
return
23007 continue
continue
i = lo
23009 if(.not.(i.lt.hi+lengel(hi)))goto 23011
gel ( dotgel + i - lo ) = gel ( i )
23010 i=i+1
goto 23009
23011 continue
C copies ending @ $ get messed up, since $ clobbered by then
return
end
integer function delete ( lo , hi )
integer lo , hi
integer confrm
C string dele deletion
integer dele ( 9 )
data dele ( 1 ) , dele ( 2 ) , dele ( 3 ) , dele ( 4 ) , dele ( 5
*) / 100 , 101 , 108 , 101 , 116 /
data dele ( 6 ) , dele ( 7 ) , dele ( 8 ) , dele ( 9 ) / 105 , 111
* , 110 , 0 /
call drwgel ( lo , hi , 1 )
if(.not.( confrm ( dele ) .gt. 0 ))goto 23012
call rmgel ( lo , hi )
delete = 1
goto 23013
23012 continue
call drwgel ( lo , hi , 1 )
delete = - 1
23013 continue
return
end
integer function confrm ( pmt )
integer pmt ( 1 )
integer curdx , curdy , smalld , larged
integer scf , lorng , hirng
integer cname ( 75 )
common / keypad / curdx , curdy , smalld , larged , scf , lorng ,
*hirng , cname
integer key , inch , c
C string conf Confirm
integer conf ( 8 )
data conf ( 1 ) , conf ( 2 ) , conf ( 3 ) , conf ( 4 ) , conf ( 5
*) / 67 , 111 , 110 , 102 , 105 /
data conf ( 6 ) , conf ( 7 ) , conf ( 8 ) / 114 , 109 , 0 /
call pushxo
call prompt ( conf , pmt )
key = inch ( c )
if(.not.( key .eq. 268 ))goto 23014
confrm = 1
goto 23015
23014 continue
confrm = - 1
23015 continue
call usemac ( 80 )
call popwo
return
end