#	DELAM
#
#	Delaminate file using field list
#
#	Thomas R. Hicks
#
#	Last modified 1/19/86 by Ralph E. Griswold
#

procedure main(a)
   local fylist, ranges
   if any('0123456789',a[1]) then
      ranges := fldecode(a[1])
   else
      {
      write(&errout,"Bad argument to delam: ",a[1])
      Usage()
      }
   if not a[2] then
      Usage()
   fylist := doutfyls(a,2)
   if *fylist ~= *ranges then
      stop("Unequal number of field args and output files")
   delamr(ranges,fylist)
end

# Usage - write usage message
#
procedure Usage()
   stop("Usage: delam fieldlist {outputfile | -} ...")
end

# delamr - do actual division of input file
#
procedure delamr(ranges,fylist)
   local i, j, k, line
   while line := read() do
      {
      i := 1
      while i <= *fylist do
         {
         j := ranges[i][1]
         k := ranges[i][2]
         if k > 0 then
            write(fylist[i][2],line[j+:k] | line[j:0] | "")
         i +:= 1
         }
      }
end

# doutfyls - process the output file arguments; return list
#
procedure doutfyls(a,i)
   local lst, x
   lst := []
   while \a[i] do
      {
      if x := llu(a[i],lst) then		# already in list
         lst |||:= [[a[i],lst[x][2]]]
      else					# not in list
         if a[i] == "-" then			# standard out
            lst |||:= [[a[i],&output]]
         else					# new file
            if not (x := open(a[i],"w")) then
               stop("Cannot open ",a[i]," for output")
            else
               lst |||:= [[a[i],x]]
      i +:= 1
      }
   return lst

end

# fldecode - decode the fieldlist argument
#
procedure fldecode(fldlst)
   local fld, flst, poslst, m, n, x
   poslst := []
   flst := str2lst(fldlst,':,;')
   every fld := !flst do
      {
      if x := upto('-+',fld) then
         {
         if not (m := integer(fld[1:x])) then
            stop("bad argument in field list; ",fld)
         if not (n := integer(fld[x+1:0])) then
            stop("bad argument in field list; ",fld)
         if upto('-',fld) then
            {
            if n < m then
               n := 0
            else
               n := (n - m) + 1
            }
         }
      else {
         if not (m := integer(fld)) then
            stop("bad argument in field list; ",fld)
         n := 1
         }
      poslst |||:= [[m,n]]
      }
   return poslst
end

# llu - lookup file name in output file list
#
procedure llu(str,lst)
   local i
   i := 1
   while \lst[i] do
      {
      if \lst[i][1] == str then
         return i
      i +:= 1
      }
end

# str2lst - create a list from a delimited string
#
procedure str2lst(str,delim)
   local lst, f
   lst := []
   str ? {
      while f := (tab(upto(delim))) do
      {
      lst |||:= [f]
      move(1)
      }
        if "" ~== (f := tab(0)) then
        lst |||:= [f]
        }
   return lst
end