{ TURBO PASCAL version of CATL.COM

  Compile at 5200

  A program designed to open MASTL.CAT  and print to the screen
  a listing of the files.

  CATL                       Will display all files one screen at a time.
  CATL *.* *.*               Same as above
  CATL *.COM *.012           Will display all .COM files from disk 12.
  CATL (file) (disk) $l      Sends output to the list device (66 lines/page).  }

{$U+}

const
   bl               =                ' ';

type
   line             =                string[26];
   sline            =                string[16];

var
   catfile:                           text;
   testfile,testdisk,cfile, cdisk:    string[15];
   testa,testb,testc,testd:           sline;
   ll,filea,fileb,filec,filed:           sline;
   fcb1:                              string[11] absolute $5C;
   fcb2:                              string[11] absolute $6C;
   dma:                               string[50] absolute $80;
   date,optline:                      string[50];
   a,b,c,l,k,p,t,y,x:                 integer;
   list:                              array[1..40] of line;
   prlist:                            array[1..108] of line;
   s:                                 string[1];
   first,page,print,tf,td:            boolean;
   col,mode,pn,pr:                    integer;

procedure printpage;
begin
   if pr = 108 then
      col := 54
   else
      col := pr div 2;
   for l := 1 to 2 do
      writeln(lst);
   writeln(lst, bl:8, 'MASTER CATALOG including library files as of ', date);
   writeln(lst);
   writeln(lst, bl:12, 'file', bl:14, 'disk', bl:14, 'file', bl:14, 'disk');
   writeln(lst);
   for l := 1 to col do
   begin
      p := pos(',', prlist[l]);
      if EOF(catfile) then begin end;
      cfile := copy(prlist[l], 1, p - 1);
      cdisk := copy(prlist[l], p + 1, length(prlist[l]) - p);
      p := pos('.', cfile);
      if p <> 9 then
         insert(copy('        ', 1, 9 - p), cfile, p);
      if length(cfile) > 12 then
         ll := copy(cfile, 13, length(cfile) - 12) + '  '
      else
         ll := '  ';
      ll[0] := #02;
      write(lst, bl:8, copy(cfile, 1, 12), bl:2, ll, bl:2);
      p := pos('.', cdisk);
      if p <> 9 then
         insert(copy('        ', 1, 9 - p), cdisk, p);
      write(lst, cdisk);
      if prlist[l + col][1] <> ' ' then
      begin
         p := pos(',', prlist[l + col]);
         cfile := copy(prlist[l + col], 1, p - 1);
         cdisk := copy(prlist[l + col], p + 1, length(prlist[l + col]) - p);
         p := pos('.', cfile);
         if p <> 9 then
            insert(copy('        ', 1, 9 - p), cfile, p);
         if length(cfile) > 12 then
            ll := copy(cfile, 13, length(cfile) - 12) + '  '
         else
            ll := '  ';
         ll[0] := #02;
         write(lst, bl:6, copy(cfile, 1, 12), bl:2, ll, bl:2);
         p := pos('.', cdisk);
         if p <> 9 then
            insert(copy('        ', 1, 9 - p), cdisk, p);
         write(lst, cdisk);
      end;
      writeln(lst);
   end;
   for l := 1 to (54 - col) do
   begin
      writeln(lst);
   end;
   writeln(lst);
   l := length(optline) + 12;
   writeln(lst, bl:(80 - l) div 2, 'Using ', optline, '- ', pn, ' -');
   writeln(lst);
   writeln(lst);
   writeln(lst);
   writeln(lst);
   pn := pn + 1;
   if pr <> 108 then
      print := false;
   pr := 0;
end;

procedure printer;
begin
   for k := 1 to 40 do
   begin
      pr := pr + 1;
      prlist[pr] := list[k];
      if print then
         if (pr = 108) or (list[k][1] = ' ') then printpage;
   end;
   if list[k][1] = ' ' then
      print := false;
end;

procedure show;
begin
   clrscr;
   gotoxy(12,1);
   write('file');
   gotoxy(30,1);
   write('disk');
   gotoxy(54,1);
   write('file');
   gotoxy(70,1);
   write('disk');
   b := 11;
   c := 3;
   for a := 1 to 40 do
   begin
      if list[a][1] <> ' ' then
      begin
         p := pos(',', list[a]);
         cfile := copy(list[a], 1, p - 1);
         cdisk := copy(list[a], p + 1, length(list[a]) - p);
         gotoxy(b, c);
         p := pos('.', cfile);
         write(copy(cfile, 1, p - 1));
         gotoxy(b + 8, c);
         write(copy(cfile, p, 4));
         gotoxy(b + 13, c);
         if (p + 4 < length(cfile) + 1) then
            write(copy(cfile, p + 4, length(cfile) - p - 3));
         gotoxy(b + 16, c);
         p := pos('.', cdisk);
         write(copy(cdisk, 1, p - 1));
         gotoxy(b + 24, c);
         write(copy(cdisk, p, 4));
         c := c + 1;
         if c = 23 then
         begin
            b := 48;
            c := 3;
         end;
      end;
   end;
   gotoxy(1, 24);
   if (list[a][1] <> ' ')  then
      write('CATL.COM', optline, '  - [more]');
end;

procedure geta;
begin
   filea := copy(list[a], 1, pos('.', list[a]) - 1);
   filea := copy(filea + '       ', 1, 8);
   for k := 1 to 8 do
      if testa[k] = '?' then
         filea[k] := '?';
end;

procedure getb;
begin
   fileb := copy(list[a], pos('.', list[a]) + 1, 3);
   for k := 1 to 3 do
      if testb[k] = '?' then
         fileb[k] := '?';
end;

procedure getc;
begin
   filec := copy(list[a], pos(',', list[a]) + 1, length(list[a]) - pos(',', list[a]));
   filec := copy(filec, 1, pos('.', filec) - 1);
   filec := copy(filec + '       ', 1, 8);
   for k := 1 to 8 do
      if testc[k] = '?' then
         filec[k] := '?';
end;

procedure getd;
begin
   filed := copy(list[a], pos(',', list[a]) + 1, length(list[a]) - pos(',', list[a]));
   filed := copy(filed, pos('.', filed) + 1, 3);
   for k := 1 to 3 do
      if testd[k] = '?' then
         filed[k] := '?';
end;

begin
   optline := dma;
   mem[$5C] := 11;
   mem[$6C] := 11;
   testfile := fcb1;
   testdisk := fcb2;
   writeln('CATL.COM  (c)  Paul Nance, 10/6/84');
   delay(1000);
   if testfile[1] = '$' then
      testfile := '           ';
   if testdisk[1] = '$' then
      testdisk := '           ';
   x := pos('$', optline);
   print := false;
   if x = 0 then
   begin
      for l := (x + 1) to length(optline) do
         if optline[l] = 'L' then
            print := true;
      optline := copy(optline, 1, x - 1);
   end;
   if print then
   begin
      write('Date to print on listing?   <May 2, 1984>  ');
      readln(date);
      writeln;
      pr := 0;
      pn := 1;
   end;
   if testfile[1] = ' ' then
      tf := false
   else
      tf := true;
   mode := 0;
   if tf then
   begin
      if (copy(testfile, 1, 8) <> '????????') then
         if (testfile[1] <> ' ') then
            mode := mode + 8;
      if (copy(testfile, 9, 3) <> '???') then
         if (testfile[9] <> ' ') then
            mode := mode + 4;
      if (copy(testdisk, 1, 8) <> '????????') then
         if (testdisk[1] <> ' ') then
            mode := mode + 2;
      if (copy(testdisk, 9, 3) <> '???') then
         if (testdisk[9] <> ' ') then
            mode := mode + 1;
   end;
   assign(catfile, 'MASTL.CAT');
   reset(catfile);
   x := 0;
   while x = 0 do
   begin
      readln(catfile, list[1]);
      x := pos(')', list[1]);
   end;
   while not EOF(catfile) do
   begin
      case mode of

         0:  begin
              end;
         1:  begin
                testd := copy(testdisk, 9, 3);
             end;
         2:  begin
                testc := copy(testdisk, 1, 8);
             end;
         3:  begin
                testc := copy(testdisk, 1, 8);
                testd := copy(testdisk, 9, 3);
             end;
         4:  begin
                testb := copy(testfile, 9, 3);
             end;
         5:  begin
                testb := copy(testfile, 9, 3);
                testd := copy(testdisk, 9, 3);
             end;
         6:  begin
                testb := copy(testfile, 9, 3);
                testc := copy(testdisk, 1, 8);
             end;
         7:  begin
                testb := copy(testfile, 9, 3);
                testc := copy(testdisk, 1, 8);
                testd := copy(testdisk, 9, 3);
             end;
         8:  begin
                testa := copy(testfile, 1, 8);
             end;
         9:  begin
                testa := copy(testfile, 1, 8);
                testd := copy(testdisk, 9, 3);
             end;
         10: begin
                testa := copy(testfile, 1, 8);
                testc := copy(testdisk, 1, 8);
             end;
         11: begin
                testa := copy(testfile, 1, 8);
                testc := copy(testdisk, 1, 8);
                testd := copy(testdisk, 9, 3);
             end;
         12: begin
                testa := copy(testfile, 1, 8);
                testb := copy(testfile, 9, 3);
             end;
         13: begin
                testa := copy(testfile, 1, 8);
                testb := copy(testfile, 9, 3);
                testd := copy(testdisk, 9, 3);
             end;
         14: begin
                testa := copy(testfile, 1, 8);
                testb := copy(testfile, 9, 3);
                testc := copy(testdisk, 1, 8);
             end;
         15: begin
                testa := copy(testfile, 1, 8);
                testb := copy(testfile, 9, 3);
                testc := copy(testdisk, 1, 8);
                testd := copy(testdisk, 9, 3);
             end;

      end;
      first := false;
      while not EOF(catfile) do
      begin
         for a := 1 to 40 do
         begin
            x := 0;
            while x = 0 do
            begin
               if not EOF(catfile) then
               begin
                  readln(catfile, list[a]);
                  case mode of

                     0:    begin
                              x := 1;
                           end;
                     1:    begin
                              getd;
                              if testd = filed then
                                 x := 1;
                           end;
                     2:    begin
                              getc;
                              if testc = filec then
                                 x := 1;
                           end;
                     3:    begin
                              getc;
                              getd;
                              if (testd = filed) and (testc = filec) then
                                 x := 1;
                           end;
                     4:    begin
                              getb;
                              if testb = fileb then
                                 x := 1;
                           end;
                     5:    begin
                              getb;
                              getd;
                              if (testb = fileb) and (testd = filed) then
                                 x := 1;
                           end;
                     6:    begin
                              getb;
                              getc;
                              if (testb = fileb) and (testc = filec) then
                                 x := 1;
                           end;
                     7:    begin
                              getb;
                              getc;
                              getd;
                              if (testb = fileb) and (testc = filec) and (testd = filed) then
                                 x := 1;
                           end;
                     8:    begin
                              geta;
                              if testa = filea then
                                 x := 1;
                           end;
                     9:    begin
                              geta;
                              getd;
                              if (testa = filea) and (testd = filed) then
                                 x := 1;
                           end;
                     10:   begin
                              geta;
                              getc;
                              if (testa = filea) and (testc = filec) then
                                 x := 1;
                           end;
                     11:   begin
                              geta;
                              getc;
                              getd;
                              if (testa = filea) and (testc = filec) and (testd = filed) then
                                 x := 1;
                           end;
                     12:   begin
                              geta;
                              getb;
                              if (testa = filea) and (testb = fileb) then
                                 x := 1;
                           end;
                     13:   begin
                              geta;
                              getb;
                              getd;
                              if (testa = filea) and (testb = fileb) and (testd = filed) then
                                 x := 1;
                           end;
                     14:   begin
                              geta;
                              getb;
                              getc;
                              if (testa = filea) and (testb = fileb) and (testc = filec) then
                                 x := 1;
                           end;
                     15:   begin
                              geta;
                              getb;
                              getc;
                              getd;
                              if (testa = filea) and (testb = fileb) and (testc = filec) and (testd = filed) then
                                 x := 1;
                           end;
                  end;
               end
               else
               begin
                  list[a] := ' ';
                  x := 1;
               end;
            end;
         end;
         if (not print) and (first) then read(s);
         first := true;
         show;
         if print then printer;
      end;
   end;
   read(s);
   close(catfile);
end.