Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/inch.for
There are no other files named inch.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 uprmt ( s )
integer s ( 1 )
integer cmprmt ( 130 )
C prompting text
integer lin ( 80 )
C tty input buffer
integer tm
C original TM value (0 VT52, 1 ANSI)
common / ctty / tm , cmprmt , lin
integer i , j , strlen
C string topv52 \233H\233K
C string topans \233[m\233[H\233[K
integer topv52 ( 5 )
integer topans ( 10 )
data topv52 ( 1 ) , topv52 ( 2 ) , topv52 ( 3 ) , topv52 ( 4 ) , t
*opv52 ( 5 ) / 155 , 72 , 155 , 75 , 0 /
data topans ( 1 ) , topans ( 2 ) , topans ( 3 ) , topans ( 4 ) , t
*opans ( 5 ) / 155 , 91 , 109 , 155 , 91 /
data topans ( 6 ) , topans ( 7 ) , topans ( 8 ) , topans ( 9 ) , t
*opans ( 10 ) / 72 , 155 , 91 , 75 , 0 /
uprmt = 0
if(.not.( cmprmt ( 1 ) .eq. 0 ))goto 23000
if(.not.( tm .ne. 0 ))goto 23002
call cpystr ( topans , cmprmt )
goto 23003
23002 continue
call cpystr ( topv52 , cmprmt )
23003 continue
23000 continue
i = strlen ( cmprmt )
continue
j = 1
23004 if(.not.(s(j).ne.0.and.i.lt.130))goto 23006
cmprmt ( i ) = s ( j )
i = i + 1
23005 j=j+1
goto 23004
23006 continue
cmprmt ( i ) = 0
return
end
integer function err ( msg )
integer msg ( 1 )
C include logcom
C string huh \7?\
integer huh ( 4 )
data huh ( 1 ) , huh ( 2 ) , huh ( 3 ) , huh ( 4 ) / 7 , 63 , 32 ,
* 0 /
C LOGSTAR 'cerror>'
C call putarg (msg)
err = 0
call uprmt ( msg )
call uprmt ( huh )
return
end
integer function inch ( c )
integer c
integer cmprmt ( 130 )
C prompting text
integer lin ( 80 )
C tty input buffer
integer tm
C original TM value (0 VT52, 1 ANSI)
common / ctty / tm , cmprmt , lin
integer curdx , curdy , smalld , larged
integer scf , lorng , hirng
integer cname ( 75 )
common / keypad / curdx , curdy , smalld , larged , scf , lorng ,
*hirng , cname
integer getlin , scncmd
integer nc
C include logcom
nc = getlin ( cmprmt , lin , 80 )
cmprmt ( 1 ) = 0
C LOGSTAR nc
C call putarg(lin)
if(.not.( nc .eq. 0 .or. ( nc .eq. 1 .and. scf .eq. 0 ) ))goto 230
*07
c = 0
inch = ( - 1 )
return
23007 continue
if(.not.( nc .eq. 1 .and. scf .ne. 0 ))goto 23009
C then must be '\n'
nc = getlin ( 0 , lin , 80 )
C LOGSTAR nc
C call putarg(lin)
23009 continue
if(.not.( lin ( 1 ) .lt. 28 .or. lin ( 1 ) .gt. 31 ))goto 23011
if(.not.( scf .ne. 0 ))goto 23013
c = lin ( 1 )
goto 23014
23013 continue
c = scncmd ( lin )
23014 continue
goto 23012
23011 continue
if(.not.( lin ( 1 ) .eq. 28 ))goto 23015
if(.not.( nc .lt. 3 ))goto 23017
curdx = 0
curdy = - smalld
c = 256
goto 23018
23017 continue
if(.not.( nc .gt. 3 ))goto 23019
c = 273
goto 23020
23019 continue
if(.not.( lin ( 2 ) .eq. 28 ))goto 23021
curdx = - larged
curdy = larged
c = 266
goto 23022
23021 continue
if(.not.( lin ( 2 ) .eq. 29 ))goto 23023
curdx = 0
curdy = larged
c = 261
goto 23024
23023 continue
if(.not.( lin ( 2 ) .eq. 30 ))goto 23025
curdx = larged
curdy = larged
c = 267
goto 23026
23025 continue
curdx = - larged
curdy = 0
c = 262
23026 continue
23024 continue
23022 continue
23020 continue
23018 continue
goto 23016
23015 continue
if(.not.( lin ( 1 ) .eq. 29 ))goto 23027
if(.not.( nc .lt. 3 ))goto 23029
curdx = 0
curdy = smalld
c = 257
goto 23030
23029 continue
if(.not.( lin ( 2 ) .eq. 28 ))goto 23031
c = 277
goto 23032
23031 continue
if(.not.( lin ( 2 ) .eq. 29 ))goto 23033
curdx = larged
curdy = 0
c = 263
goto 23034
23033 continue
if(.not.( lin ( 2 ) .eq. 30 ))goto 23035
curdx = - larged
curdy = - larged
c = 264
goto 23036
23035 continue
curdx = 0
curdy = - larged
c = 260
23036 continue
23034 continue
23032 continue
23030 continue
goto 23028
23027 continue
if(.not.( lin ( 1 ) .eq. 30 ))goto 23037
if(.not.( nc .lt. 3 ))goto 23039
curdx = - smalld
curdy = 0
c = 258
goto 23040
23039 continue
if(.not.( lin ( 2 ) .eq. 28 ))goto 23041
curdx = larged
curdy = - larged
c = 265
goto 23042
23041 continue
if(.not.( lin ( 2 ) .eq. 29 ))goto 23043
c = 276
goto 23044
23043 continue
if(.not.( lin ( 2 ) .eq. 30 ))goto 23045
c = 274
goto 23046
23045 continue
c = 275
23046 continue
23044 continue
23042 continue
23040 continue
goto 23038
23037 continue
if(.not.( nc .lt. 3 ))goto 23047
curdx = smalld
curdy = 0
c = 259
goto 23048
23047 continue
if(.not.( nc .gt. 3 ))goto 23049
c = 268
goto 23050
23049 continue
if(.not.( lin ( 2 ) .eq. 28 ))goto 23051
c = 269
goto 23052
23051 continue
if(.not.( lin ( 2 ) .eq. 29 ))goto 23053
c = 270
goto 23054
23053 continue
if(.not.( lin ( 2 ) .eq. 30 ))goto 23055
c = 271
goto 23056
23055 continue
c = 272
23056 continue
23054 continue
23052 continue
23050 continue
23048 continue
23038 continue
23028 continue
23016 continue
23012 continue
inch = c
return
end
C clreol - clear from text-mode cursor to end-of-line
integer function clreol ( noargs )
integer noargs
integer cmprmt ( 130 )
C prompting text
integer lin ( 80 )
C tty input buffer
integer tm
C original TM value (0 VT52, 1 ANSI)
common / ctty / tm , cmprmt , lin
call putc ( 155 )
if(.not.( tm .ne. 0 ))goto 23057
call putc ( 91 )
23057 continue
C ANSI
call putc ( 75 )
clreol = 0
end
C home - home the text-mode cursor
integer function home ( noargs )
integer noargs
integer cmprmt ( 130 )
C prompting text
integer lin ( 80 )
C tty input buffer
integer tm
C original TM value (0 VT52, 1 ANSI)
common / ctty / tm , cmprmt , lin
C string hom52 \233H
C string homans \233[m\233[H
integer hom52 ( 3 )
integer homans ( 7 )
data hom52 ( 1 ) , hom52 ( 2 ) , hom52 ( 3 ) / 155 , 72 , 0 /
data homans ( 1 ) , homans ( 2 ) , homans ( 3 ) , homans ( 4 ) , h
*omans ( 5 ) / 155 , 91 , 109 , 155 , 91 /
data homans ( 6 ) , homans ( 7 ) / 72 , 0 /
if(.not.( tm .ne. 0 ))goto 23059
call putcha ( homans )
C ANSI
goto 23060
23059 continue
call putcha ( hom52 )
23060 continue
C VT52
home = 0
end
C foot - put the text-mode cursor at the foot of the screen
integer function foot ( noargs )
integer noargs
integer cmprmt ( 130 )
C prompting text
integer lin ( 80 )
C tty input buffer
integer tm
C original TM value (0 VT52, 1 ANSI)
common / ctty / tm , cmprmt , lin
C string fot52 \233Y7\40
C string fotans \233[m\233[24;1H
integer fot52 ( 5 )
integer fotans ( 11 )
data fot52 ( 1 ) , fot52 ( 2 ) , fot52 ( 3 ) , fot52 ( 4 ) , fot52
* ( 5 ) / 155 , 89 , 55 , 32 , 0 /
data fotans ( 1 ) , fotans ( 2 ) , fotans ( 3 ) , fotans ( 4 ) , f
*otans ( 5 ) / 155 , 91 , 109 , 155 , 91 /
data fotans ( 6 ) , fotans ( 7 ) , fotans ( 8 ) , fotans ( 9 ) , f
*otans ( 10 ) / 50 , 52 , 59 , 49 , 72 /
data fotans ( 11 ) / 0 /
if(.not.( tm .ne. 0 ))goto 23061
call putcha ( fotans )
C ANSI
goto 23062
23061 continue
call putcha ( fot52 )
23062 continue
C VT52
foot = 0
end