#
#
#
#    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:    March 26, 1982
#
#
#
#      *******************************************************
#      *                                                     *
#      *      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"

_ifndef(VAX)

# gttyp - get terminal type for IAS and RSX11-M
  subroutine gttyp(f)
  integer f, f2, type, acr, ierr
  include "term.cmn"
  include "qiofn.cmn"

  scrsiz = SCRLENGTH

  call qiofn(f, IOATT, 0, 0, ierr)		# attach terminal

#
# The return of screen width is inconsistent across operating systems (ie.
# IAS is weird); thus the variable widfac is patched by TKB to be 1 for IAS.
#
  call qiofn(f, SFGMC, TCWID, syswid, ierr)	# get screen width
  if (ierr == 0)
    syswid = syswid-widfac
  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.
#
  call qiofn(f, SFGMC, TCTTP, type, ierr)	# get terminal type
  if (ierr == 0 & (type == TV100 | type == TVT52))
    hlf = .false.
  else
    hlf = .true.
#
#  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 and VMS 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)
  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)
      val = val & 8%377				# mask out high byte
      }
    }
  else
    ierr = -1
  return
  end

_elsedef

# gttyp - get terminal type for VAX
  subroutine gttyp(f)
  integer f, f2
  include "term.cmn"
  include "qiofn.cmn"
  integer icr_trnlog_str, sys$assign, sys$qiow
  `character`*63 trname
  logical istrm

  scrsiz = SCRLENGTH

  syswid = SCRWIDTH
  hlf = .true.
  autocr = .false.
  qio_ok = .false.

  if (istrm(f)) {
    if (icr_trnlog_str(STD$OUT, trname))
      if (sys$assign(trname, channel, , ))
	if (sys$qiow( , %val(channel), %val(io$_sensemode), , , ,
		     characteristics, , , , , ))
	  goto 10

      call ttput(_
	"LIST -- Can't get terminal characteristics - assuming defaults", 0)
      goto 20

10  continue

      qio_ok = .true.

      do i = 1, 8				# save initial characteristics
	save_char(i) = characteristics(i)

      syswid = ttwidth

      if (tttype == tt$_vt52 | tttype == tt$_vt100)
	hlf = .false.
      else
	hlf = .true.

      if (isset(ttchar, tt$m_wrap))
	autocr = .true.
      else
	autocr = .false.

      ttchar = ttchar & !tt$m_mechtab		# disable hardware tabs
      call sys$qiow( , %val(channel), %val(io$_setmode), , , ,
		    characteristics, , , , , )
    }

20
  scrwid = syswid
  return
 
# tabbak - reset terminal characteristics on exit from list.
  entry tabbak(f2)

  if (qio_ok)
    call sys$qiow( , %val(channel), %val(io$_setmode), , , ,
		  save_char, , , , , )
  return
  end

_enddef

# setwid - set terminal screen width characteristic
  subroutine setwid(f, wid)
  integer wid, ierr
  include "qiofn.cmn"

_ifdef(VAX)

  if (qio_ok) {
    ttwidth = wid
    call sys$qiow( , %val(channel), %val(io$_setmode), , , ,
		  characteristics, , , , , )
    }

_elsedef

  call qiofn(f, SFSMC, TCWID, wid+widfac, ierr)		# widfac=1 for IAS

_enddef

  return
  end

# escseq - send out a terminal control sequence beginning with ESC
  subroutine escseq(f, seq)
  integer f, ier
  byte seq(1), tseq(10)
  integer length
  data tseq(1)/ESC/

  call scopy(seq, 1, tseq, 2)
  call put(f, tseq, length(tseq), ier, .true.)
  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 = prlen + 8 - mod(mod(prlen, scrwid), 8)
	else
	  prlen = prlen + 8

      case LF:
	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