{$W-,Y-}
program multicolumnlister;
{    Author: Earl Chew
     Date: February 1984
  Copyright (c) 1984
        C. E. Chew
}
const
  cr=chr(13);
  printerwidth=79{132};
  printerlength=23{56};
  maxcolumns=(printerwidth+1) div 3;
  stringlength=122;
  progid="MCLIST";
  version="01.00";

type
  string = array [1..stringlength+1] of char;
  relation = (lt, le, eq, ge, gt, ne);

type
  lineposp=@lineposition;
  lineposition=record
                  pos:1..printerwidth;
                  next:lineposp
                end;
  titlerec=record
              filen:string;
              pagen:integer;
            end;

const
  wf=10-1;
  wfp=24-1;
  wfdp=35-1;
  wfdtp=45-1;
  bar='|';
  space=' ';
  continuation='&';
  circumflex='^';
  escape='$';

var
  free:lineposp;
  overlay:array[1..printerlength] of lineposp;
  titlerest,titlefile:string;
  title:array[1..(printerlength+1) div (wf+2)] of titlerec;
  fileno,pageno:integer;
  column,columns:1..maxcolumns;
  columnbase:1..printerwidth-1;
  columnoffset:0..printerwidth+1;
  columnwidth:1..printerwidth-1;
  line:1..printerlength;
  inp,out:text;
  matrix:array [1..printerlength,1..printerwidth] of char;
  noheaderopt, columnopt,outputopt, emphasiseopt:boolean;

function length(s:string):integer; external;

procedure insert(s1:string; var s2:string; st, m:integer); external;

procedure inform(p, m:string); external;

procedure warn(p, m:string); external;

procedure error(p, m:string); external;

procedure fatal(p, m:string); external;

procedure rerun; external;

function position(s1, s2:string; st:integer):integer; external;

function verify(s1, s2:string):integer; external;

procedure delete(var s:string; st, sp:integer); external;

procedure concatenate(var s1:string; s2:string; m:integer); external;

procedure padleft(var s:string; sp,m:integer); external;

procedure padright(var s:string; sp,m:integer); external;

procedure date(var s:string); external;

procedure time(var s:string); external;

function stoi(s:string; b, st:integer; var so:integer):integer; external;

procedure insertlist;
var
  p:lineposp;
begin
  if free=nil then
    new(p)
  else begin
    p:=free;
    free:=free@.next
  end;
  with p@ do begin
    next:=overlay[line];
    overlay[line]:=p;
    pos:=columnbase+columnoffset
  end
end;

procedure deletelist;
var
  p:lineposp;
begin
  p:=overlay[line];
  with p@ do begin
    overlay[line] := next;
    next:=free;
    free:=p
  end
end;

procedure reverselist;
var
  before,now,after:lineposp;
begin
  before:=nil;
  after:=overlay[line];
  while after<>nil do begin
    now:=after;
    with now@ do begin
      after:=next;
      next:=before;
      before:=now
    end
  end;
  overlay[line]:=before
end;


function nextfile:boolean;

var
  i : integer;

begin
  fileno := fileno + 1;
  if fileno = argc then
    nextfile := false
  else begin
    nextfile := true;
    titlefile := argv[fileno]@;
    i := position(titlefile, ":", 1);
    if i > 0 then
      delete(titlefile, 1, i);
    i := position(titlefile, ".", 1);
    if i = 0 then
      concatenate(titlefile, ".LST", stringlength);
    padright(titlefile, 10, stringlength);
    reset(inp, argv[fileno]@, "LST")
  end
end;

procedure heading;
var
  i:integer;
begin
  if ((columnwidth>=wf) and not noheaderopt) then begin
    for i:=1 to column do begin
      with title[i] do begin
        if i<>1 then
          write(out,' ');
        write(out,filen,titlerest);
        if columnwidth>=wfp then
          write(out,pagen:4)
      end
    end
  end;
  writeln(out);
  writeln(out)
end;

procedure entitle;
begin
  if columnwidth>=wf then begin
    with title[column] do begin
      pageno:=pageno+1;
      filen:=titlefile;
      pagen:=pageno
    end
  end
end;

procedure printline;
var
  i:integer;
begin
  if line=1 then
    heading;
  for i:=1 to columnbase do
    write(out,matrix[line,i])
end;

procedure advanceline;
begin
  if line=printerlength then begin
    if column=columns then begin
      columnbase:=1;
      column:=1;
      page(out)
    end
    else begin
      columnbase:=columnbase+columnwidth+2;
      column:=column+1
    end;
    line:=1
  end
  else
    line:=line+1
end;

procedure completeline;
var
  lastposition:0..printerlength;
begin
  if overlay[line]<>nil then begin
    reverselist;
    write(out,cr);
    lastposition:=0;
    while overlay[line]<>nil do begin
      with overlay[line]@ do begin
        write(out,bar:(pos-lastposition));
        lastposition:=pos
      end;
      deletelist;
    end
  end;
  writeln(out)
end;

procedure printchar(ch:char);
begin
  if columnoffset=columnwidth then begin
    if column=columns then
      completeline;
    advanceline;
    columnoffset:=1;
    matrix[line,columnbase]:=continuation
  end
  else
    columnoffset:=columnoffset+1;
  if (line=1) and (columnoffset=1) then
    entitle;
  if column=columns then begin
    if columnoffset=1 then
      printline;
    write(out,ch)
  end
  else
    matrix[line,columnbase+columnoffset]:=ch;
end;

procedure endline;
var
  i:integer;
begin
  if (line=1) and (columnoffset=0) then
    entitle;
  if column=columns then begin
    if columnoffset=0 then
      printline;
    completeline
  end
  else
    for i:=columnoffset+1 to columnwidth do
      printchar(space);
  advanceline;
  columnoffset:=0;
  matrix[line,columnbase]:=space
end;

procedure newpage;
var
  i:integer;
begin
  for i:=line to printerlength do
    endline
end;

procedure tabulate;
var
  i:integer;
begin
  for i:=1 to 8-((columnoffset-1) mod 8) do
    printchar(space)
end;

procedure uparrow(ch:char);
begin
  printchar(circumflex);
  if emphasiseopt then
    insertlist;
  printchar(chr(ord(ch)+64))
end;

procedure transfer;
var
  ch:char;
begin
  while not eof(inp) do begin
    while not eoln(inp) do begin
      read(inp,ch);
      if ch=chr(12) then
        newpage
      else
        if ch=chr(9) then
          tabulate
        else
          if ch=chr(27) then
            printchar(escape)
          else
            if ch<space then
              uparrow(ch)
            else
              printchar(ch)
    end;
    readln(inp);
    endline
  end
end;

procedure finishfile;
begin
  if line<>1 then
    newpage
end;

procedure finishup;
var
  i:integer;
begin
  column:=column-1;
  if column <> 0 then begin
    for i:=1 to printerlength do begin
      matrix[i, columnbase] := space;
      printline;
      completeline;
      advanceline
    end
  end
end;

function initialise:boolean;
var
  dates,times:array [1..15] of char;
  padsize:integer;
  i,j,k:integer;
  ch:char;
begin
  initialise:=true;
  line:=1;
  column:=1;
  columnbase:=1;
  columnoffset:=0;
  matrix[1,1] := space;
  columns:=2;
  free:=nil;
  for i:=1 to printerlength do
    overlay[i]:=nil;
  fileno:=1;
  pageno:=0;
  date(dates);
  time(times);
  padleft(dates,11,15);
  padleft(times,10,15);
  noheaderopt:=false;
  columnopt:=false;
  outputopt:=false;
  emphasiseopt := false;
  if argc=1 then
    initialise:=false
  else begin
    if argv[1]@[0]='-' then begin
      i:=0;
      loop
        i:=i+1;
        ch:=argv[1]@[i];
      exit if ch=chr(0);
        if ch='C' then
          columnopt:=true
        else if ch='N' then
          noheaderopt:=true
        else if ch='O' then
          outputopt:=true
	else if ch='E' then
	  emphasiseopt:=true
      end
    end;
    if columnopt then begin
      argc:=argc-1;
      columns:=stoi(argv[argc]@,10,1,i);
      if (i<>0) and ((columns<1) or (columns > maxcolumns)) then
        initialise:=false
    end;
    if outputopt then begin
      argc:=argc-1;
      rewrite(out,argv[argc]@,"COL")
    end
    else
      rewrite(out,"LP:");
    if argc < 3 then
      initialise := false;
    columnwidth:=(printerwidth+1) div columns-2;
    if columnwidth < 1 then
      fatal(progid, "Too many columns specified");
    titlerest:="";
    padsize := columnwidth - 9;
    if columnwidth>=wfdp then begin
      concatenate(titlerest,dates,stringlength);
      padsize := columnwidth - (9 + 4)
    end;
    if columnwidth>=wfdtp then begin
      concatenate(titlerest,times,stringlength);
      padsize := columnwidth - (9 + 4)
    end;
    if columnwidth>=wfp then begin
      concatenate(titlerest,"   PAGE : ",stringlength);
      padsize := columnwidth - (9 + 4)
    end;
    padleft(titlerest,padsize,stringlength);
    for i:=1 to printerlength do begin
      j:=1;
      for k:=1 to columns-1 do begin
        j:=j+columnwidth+2;
        matrix[i,j-1]:=bar
      end
    end
  end
end;

begin     {Main}
  if initialise then begin
    while nextfile do begin
      inform(progid,"");
      writeln('Processing "',argv[fileno]@,'"');
      transfer;
      finishfile
    end;
    finishup
  end
  else begin
    writeln(progid,'     Version',version);
    writeln;
    writeln('$-[options] input ... [output] [columns]');
    writeln;
    writeln('Default input extension    .LST');
    writeln('Default output extension   .COL');
    writeln('Default number of columns    2');
    writeln;
    writeln('Option C  Number of columns specified');
    writeln('Option E  Emphasise control characters');
    writeln('Option N  No header on each column');
    writeln('Option O  Output file specified');
    writeln;
    rerun
  end
end.