#
#
#
#    LIST File Listing Utility
#    =========================
#
#         Author:  William Wood
#
#         Address: Computer Center
#                  Institute For Cancer Research
#                  7701 Burholme Ave.
#                  Philadelphia, Pa. 19111
#                  (215) 728 2760
#
#         Version: 2.0
#
#         Date:    December 1, 1980
#
#
#
#      *******************************************************
#      *                                                     *
#      *      THIS SOFTWARE WAS DEVELOPED WITH SUPPORT       *
#      *      FROM THE NATIONAL INSTITUTES OF HEALTH:        *
#      *         NIH CA06927                                 *
#      *         NIH CA22780                                 *
#      *                                                     *
#      *      DIRECT INQUIRIES TO:                           *
#      *            COMPUTER CENTER                          *
#      *            THE INSTITUTE FOR CANCER RESEARCH        *
#      *            7701 BURHOLME AVENUE                     *
#      *            PHILADELPHIA, PENNSYLVANIA   19111       *
#      *                                                     *
#      *      NO WARRANTY OR REPRESENTATION, EXPRESS OR      *
#      *      IMPLIED, IS MADE WITH RESPECT TO THE           *
#      *      CORRECTNESS, COMPLETENESS, OR USEFULNESS       *
#      *      OF THIS SOFTWARE, NOR THAT USE OF THIS         *
#      *      SOFTWARE MIGHT NOT INFRINGE PRIVATELY          *
#      *      OWNED RIGHTS.                                  *
#      *                                                     *
#      *      NO LIABILITY IS ASSUMED WITH RESPECT TO        *
#      *      THE USE OF, OR FOR DAMAGES RESULTING FROM      *
#      *      THE USE OF THIS SOFTWARE                       *
#      *                                                     *
#      *******************************************************
#      *                                                     *
#      *      THIS SOFTWARE WAS DESIGNED FOR USE ON A        *
#      *      PDP-11/70 OPERATING UNDER IAS V3.0 USING       *
#      *      THE FORTRAN-IV PLUS COMPILER.                  *
#      *                                                     *
#      *******************************************************
#
#
#
include symbols.rat

# gttyp - get terminal type
subroutine gttyp(f)
integer f, f2, type, acr, ierr
include qiofn.cmn
include term.cmn
 
scrsiz = SCRLENGTH
#
# the return of screen width is inconsistent across operating systems;
# thus it is an installation dependent function, but could be included
# if you figure out how the screen width is returned at your installation.
#
WIDTH call qiofn(f, SFGMC, TCWID, syswid, ierr)	# get screen width
WIDTH if (ierr == 0)
WIDTH   if (syswid > 0)
WIDTH     syswid = syswid-1
WIDTH   else
WIDTH     syswid = 256+syswid-1
WIDTH else
      syswid = SCRWIDTH
    scrwid = syswid
#
#  if your terminals do a hardware line feed and carriagereturn after the
#  80th character but before the 81st character (ADM3A's do this if set for
#  auto newline in their switch bank) then set hlf (hardware line-feed) to
#  true, otherwise set hlf to false.
#  On our system, ADM3A's have terminal type USR0.
#
ICR call qiofn(f, SFGMC, TCTTP, type, ierr)	# get terminal type
ICR if (type == TUSR0  |  ierr ~= 0)
      hlf = .true.
ICR else
ICR   hlf = .false.
#
#  if your terminal is set for auto carriagereturn then software tabs work
#  properly all the time; otherwise they only work properly for the first
#  line of output from a record. Therefore autocr should be set true if the
#  terminal is set for auto carriagereturn, so that NUMLIN knows what's what.
#  The following code probably won't have to be modified.
#  note: auto carriagereturn is known as "wrap" on M systems.
#
call qiofn(f, SFGMC, TCACR, acr, ierr)	# get auto carriagereturn flag -
					# used in NUMLIN
if (acr == 1  &  ierr == 0)
  autocr = .true.
else
  autocr = .false.
#
# now set terminal for no hardware tabs so NUMLIN knows where it is on the screen
#
call qiofn(f, SFGMC, TCHHT, savtab, ierr)
call qiofn(f, SFSMC, TCHHT, 0, ierr)
return
 
# tabbak - reset hardware tab status on exit from list.
#          also reset screen width.
entry tabbak(f2)
call qiofn(f2, SFSMC, TCHHT, savtab, ierr)
WIDTH call setwid(f2, syswid)
return
end
 
# qiofn - do a qio function
subroutine qiofn(f, func, char, val, ierr)
integer f, func, char, val, ierr, dpb(6), dsw, iosb(2)
byte buf(2), biosb
include qiofn.cmn
equivalence (biosb, iosb)
 
buf(1) = char
buf(2) = val
call getadr(dpb, buf)
dpb(2) = 2
call wtqio(func, f, f, , iosb, dpb, dsw)
if (biosb >= 0  &  dsw >= 0) {
  ierr = 0
  if (func == SFGMC)
    val = buf(2)
  }
else
  ierr = -1
return
end
 
#
# numlin - castrate control chars, count number of lines to print this record
#
#  This routine figures out how many lines would be printed if a record
#  were printed at the terminal, sets non-printing (NONP) characters
#  to 0, and detects form feeds.
#
define(NONP,1)		# non-printing character
define(P,2)		# printing character
define(XBELL,3)		# ^G (bell)
define(XTAB,4)		# tab
define(XLF,5)		# line feed
define(XFF,6)		# form feed
define(XBS,7)		# back space
define(XCR,8)		# carriage return
 
subroutine numlin(buf, outb, blen, ffflag, nlines)
integer blen, nlines, prlen, i, nl
logical ffflag
byte buf(1), outb(1)
byte chars(-128:127)
include term.cmn
data chars/128*NONP,7*NONP,XBELL,XBS,XTAB,XLF,NONP,XFF,XCR,18*NONP,95*P,NONP/
 
ffflag = .false.
prlen = 0
nlines = 1
if (blen <= 0)
  return
do i = 1, blen {
  outb(i) = buf(i)
  goto (NONP, P, XBELL, XTAB, XLF, XFF, XBS, XCR), chars(outb(i))
 
  NONP continue
        outb(i) = 0
        next
   
  XTAB continue
        if ((prlen < scrwid  &  nlines == 1)  |  autocr)
           prlen=8*(prlen/8 + 1)
        else
           prlen=prlen+8
        next
   
  XLF  continue
        if (~ hlf)
          nl = max0(0, prlen - 1)/scrwid
        else
          nl = prlen/scrwid
        nlines = nlines + nl + 1
        prlen = prlen - nl*scrwid
        next
   
  XFF  continue
        outb(i) = 0
        ffflag = .true.			# signal new page
        next
   
  XBS  continue
        nl = prlen/scrwid
        nlines = nlines + nl
        prlen = max0(0, prlen - nl*scrwid - 1)
        next
 
  XCR  continue
        nl = prlen/scrwid
        nlines = nlines + nl
        prlen = 0
        next
 
  XBELL continue
        next
 
  P   continue
        prlen = prlen+1
   
  }
 
if (~ hlf)
  nl = max0(0, prlen - 1)/scrwid
else
  nl = prlen/scrwid
nlines = nlines + nl
return
end
 
DT80 # escseq - send out a terminal control sequence beginning with ESC
DT80 subroutine escseq(f, seq)
DT80 integer f, dsw, dpb(6)
DT80 integer length
DT80 byte seq(1), tseq(10)
DT80 include qiofn.cmn
DT80 data tseq(1)/ESC/
DT80  
DT80 call scopy(seq, 1, tseq, 2)
DT80 call getadr(dpb(1), tseq)
DT80 dpb(2) = length(tseq)
DT80 call wtqio(IOWAL, f, f, , , dpb, dsw)
DT80 return
DT80 end
 
WIDTH # setwid - set terminal screen width characteristic
WIDTH subroutine setwid(f, wid)
WIDTH integer wid, ierr
WIDTH include qiofn.cmn
WIDTH  
WIDTH call qiofn(f, SFSMC, TCWID, wid+1, ierr)
WIDTH return
WIDTH end