Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/puts.for
There are no other files named puts.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 putcha ( s )
integer s ( 1 )
integer i , n
n = 1
continue
i = 1
23000 if(.not.(s(i).ne.0))goto 23002
call putc ( s ( i ) )
n = n + 1
23001 i=i+1
goto 23000
23002 continue
putcha = n
return
end
integer function itoc ( n , c , l )
integer n , l
integer c ( 1 )
integer num , ci , si , t
num = n
ci = 1
if(.not.( num .eq. 0 ))goto 23003
c ( ci ) = 48
itoc = 1
return
23003 continue
if(.not.( num .lt. 0 ))goto 23005
c ( ci ) = 45
ci = ci + 1
num = - num
23005 continue
si = ci
continue
23007 if(.not.( num .gt. 0 .and. ci .le. l ))goto 23008
c ( ci ) = 48 + mod ( num , 10 )
num = num / 10
ci = ci + 1
goto 23007
23008 continue
ci = ci - 1
itoc = ci
continue
23009 if(.not.( si .lt. ci ))goto 23010
t = c ( si )
c ( si ) = c ( ci )
c ( ci ) = t
si = si + 1
ci = ci - 1
goto 23009
23010 continue
return
end
integer function putdec ( n )
integer n
integer res ( 16 )
integer itoc
integer i
putdec = 0
i = itoc ( n , res , 15 )
res ( i + 1 ) = 0
call putcha ( res )
return
end
integer function putsgn ( n )
integer n
if(.not.( n .ge. 0 ))goto 23011
call putc ( 43 )
23011 continue
call putdec ( n )
putsgn = 0
return
end
integer function abspos ( x , y )
integer x , y
call putc ( 91 )
call putdec ( x )
call putc ( 44 )
call putdec ( y )
call putc ( 93 )
abspos = 0
return
end
integer function putpos ( x , y )
integer x , y
integer cx , cy , relflg , sx , sy
common / compos / cx , cy
common / comrel / relflg
common / comsav / sx , sy
call putc ( 91 )
if(.not.( relflg .eq. 0 ))goto 23013
call putdec ( x )
goto 23014
23013 continue
call putsgn ( x - cx )
23014 continue
call putc ( 44 )
if(.not.( relflg .eq. 0 ))goto 23015
call putdec ( y )
goto 23016
23015 continue
call putsgn ( y - cy )
23016 continue
cx = x
cy = y
call putc ( 93 )
putpos = 0
return
end
integer function positn ( x , y )
integer x , y
integer cx , cy , relflg , sx , sy
common / compos / cx , cy
common / comrel / relflg
common / comsav / sx , sy
C string opn \np[
integer opn ( 4 )
data opn ( 1 ) , opn ( 2 ) , opn ( 3 ) , opn ( 4 ) / 10 , 112 , 91
* , 0 /
call putcha ( opn )
if(.not.( relflg .eq. 0 ))goto 23017
call putdec ( x )
goto 23018
23017 continue
call putsgn ( x - cx )
23018 continue
call putc ( 44 )
if(.not.( relflg .eq. 0 ))goto 23019
call putdec ( y )
goto 23020
23019 continue
call putsgn ( y - cy )
23020 continue
cx = x
cy = y
call putc ( 93 )
positn = 0
return
end
integer function setpos ( x , y )
integer x , y
integer cx , cy , relflg , sx , sy
common / compos / cx , cy
common / comrel / relflg
common / comsav / sx , sy
cx = x
cy = y
setpos = 0
return
end
integer function savpos ( noargs )
integer noargs
integer cx , cy , relflg , sx , sy
common / compos / cx , cy
common / comrel / relflg
common / comsav / sx , sy
C string sav \np(b)
integer sav ( 6 )
data sav ( 1 ) , sav ( 2 ) , sav ( 3 ) , sav ( 4 ) , sav ( 5 ) / 1
*0 , 112 , 40 , 98 , 41 /
data sav ( 6 ) / 0 /
call putcha ( sav )
sx = cx
sy = cy
savpos = 0
return
end
integer function oldpos ( noargs )
integer noargs
integer cx , cy , relflg , sx , sy
common / compos / cx , cy
common / comrel / relflg
common / comsav / sx , sy
C string old \np(e)
integer old ( 6 )
data old ( 1 ) , old ( 2 ) , old ( 3 ) , old ( 4 ) , old ( 5 ) / 1
*0 , 112 , 40 , 101 , 41 /
data old ( 6 ) / 0 /
call putcha ( old )
call setpos ( sx , sy )
oldpos = 0
return
end