#
#
#
#    SRD command line generator
#    ==========================
#
#         Author:  William Wood
#
#         Address: Computer Center
#                  Institute For Cancer Research
#                  7701 Burholme Ave.
#                  Philadelphia, Pa. 19111
#                  (215) 728 2760
#
#         Version: 1.1
#
#         Date:   Dec 28, 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                       *
#      *                                                     *
#      *******************************************************
#      *                                                     *
#      *      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
# parse - return first arg in comand and delete it from comand
subroutine parse(comand, arg)
byte comand(1), arg(1)
integer j
byte cupper
 
j = 1
while (comand(j) ~= ' '  &  comand(j) ~= EOS  &
       (comand(j) ~= '/'  |  j == 1  |  comand(1) ~= '/')) {
  arg(j) = cupper(comand(j))
  j = j+1
  }
arg(j) = EOS
if (comand(j) == ' ')
  j = j+1
call scopy(comand, j, comand, 1)
return
end
 
# getfil - return selected file names one at a time from a list of file specs
#          separated by commas.
#          File specs may be a simple file name, or they may reference
#          an indirect file if @<indirect file> is specified, or
#          if the SRD option is in use, file names may be selected by
#          an SRD pattern.
define(SIMPLENAME,0)
define(SRDNAME,1)
define(INDIRECTNAME,2)
logical function getfil(file, ans, nselec, prompt)
byte file(1), ans(2), termc, tfile(MAXLINE), filist(MAXLINE)
integer nselec, nc, name, ip, j, i, nfile
logical prompt, islist, inbrak
integer bkscan, length
byte cupper
 
if (nselec == 0) {
  ip = 0
  call scopy(file, 1, filist, 1)
  nfile = 0
  islist = .false.
  }
repeat {
  if (nfile == 0) {
    inbrak = .false.
    for (j = ip+1; filist(j) ~= EOS  &  (inbrak | filist(j) ~= ','); j = j+1)
      if (filist(j) == '[')
        inbrak = .true.
      else if (filist(j) == ']')
        inbrak = .false.
    if (filist(j) == ',')
      islist = .true.			# this is a list of file names
    do i = ip+1, j
      file(i-ip) = filist(i)
    file(j-ip) = EOS
    ip = j
    name = SIMPLENAME
    if (file(1) == '@')  			     # Indirect file name?
      name = INDIRECTNAME
    else if (file(bkscan(file, '/*?', 1)) ~= EOS) {  # SRD wild card or switch?
SRD   name = SRDNAME
      }
    }
  nc = 0
  if (name == SIMPLENAME  &  ~islist)
    nfile = 1 - nfile
  else {
    repeat {
      if (name == SRDNAME) {
SRD     call fndfil(FINDFILE, file, tfile, nfile)
        }
      else if (name == INDIRECTNAME)
        call readf(FINDFILE, file, tfile, nfile)
      else {
        nfile = 1 - nfile
        call scopy(file, 1, tfile, 1)
        }
      if (nfile > 0) {
        call scopy(tfile, 1, file, 1)
        if (prompt)
          if (ans(1) ~= 'G') {
            repeat {
              call readpr(TERM, file, ans, nc, 2, termc)
              } until (nc == EOF  |  nc >= 0)
            ans(1) = cupper(ans(1))
            }
          else
            call put(TERM, file, length(file), ier)
        }
      } until (nfile <= 0  |  nc == EOF  |  ans(1) == 'G'  |
               (nc > 0  &  ans(1) == 'Y')  |  ~prompt)
    }
  } until (nfile > 0  |  filist(ip) == EOS  |  nc == EOF)
getfil = nfile > 0  &  nc ~= EOF
if (getfil)
  nselec = nselec + 1
if (nc == EOF)
  close(unit=FINDFILE)
return
end
 
# readf - read in file names from indirect file
subroutine readf(f, file, outfil, nselec)
integer f, nselec, nc
byte file(1), outfil(1)
 
if (nselec == 0) {
  call defnam(file(2), EOS, 'SY:', EOS, EOS, '.', .false.)
  close(unit=f)
%
      open(unit=f, name=file(2), type='old', readonly, shared, err=10)
%
  }
repeat
  call get(f, outfil, MAXLINE-1, nc)
  until (nc ~= 0)
if (nc < 0) {
  nselec = 0
  close(unit=f)
  }
else {
  nselec = nselec+1
  outfil(nc+1) = EOS
  }
return
 
10 continue
call err(file, 2, "Can't open file.")
return
end
 
# err - put out error message
subroutine err(comand, cp, msg)
integer cp, ier, j, k, l, scrwid
integer length
byte comand(1), msg(1)
data scrwid /80/
 
j = mod(cp-1, scrwid) + 1
l = length(comand)
k = min0(cp + scrwid - j, l)
call put(TERM, comand, k, ier)
encode(j, 10, comand)
%
10    format(t<j>,'^')
%
call put(TERM, comand, j, ier)
if (k < l)
  call put(TERM, comand(k+1), l - k, ier)
call put(TERM, msg, length(msg), ier)
comand(cp) = ERROR
return
end