#
#
#
#    LIST File Listing Utility
#    =========================
#
#         Author:  William P. Wood, Jr.
#
#         Address: Computer Center
#                  Institute For Cancer Research
#                  7701 Burholme Ave.
#                  Philadelphia, Pa. 19111
#                  (215) 728 2760
#
#         Version: 3.0
#
#         Date:    December 29, 1981
#
#
#
#      *******************************************************
#      *                                                     *
#      *      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                       *
#      *                                                     *
#      *******************************************************
#
#
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 term 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 characters
#  to 0, and detects form feeds.
#
subroutine numlin(buf, outb, blen, ffflag, nlines)
integer blen, nlines, prlen, i, nl
logical ffflag
byte buf(1), outb(1)
include term.cmn
 
ffflag = .false.
prlen = 0
nlines = 1
if (blen <= 0)
  return
do i = 1, blen {
  outb(i) = buf(i)

  switch (outb(i)) {
    case BELL:
      continue

    case BS:
      nl = prlen/scrwid
      nlines = nlines + nl
      prlen = max0(0, prlen - nl*scrwid - 1)
 
    case TAB:
      if ((prlen < scrwid  &  nlines == 1)  |  autocr)
	prlen=8*(prlen/8 + 1)
      else
	prlen=prlen+8

    case LF:
      if (~ hlf)
	nl = max0(0, prlen - 1)/scrwid
      else
	nl = prlen/scrwid
      nlines = nlines + nl + 1
      prlen = prlen - nl*scrwid

    case FF:
      outb(i) = 0
      ffflag = .true.				# signal new page

    case CR:
      nl = prlen/scrwid
      nlines = nlines + nl
      prlen = 0

    case ESC:
      outb(i) = '$'
      prlen = prlen + 1

    case " " - "~":				# regular printing chars
      prlen = prlen+1

    default:					# anything else
      outb(i) = 0
    }
  }
 
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