{ Turbo Pascal version of LCAT
  by Paul Nance, October 6, 1984

  Compile at 8000

  Program designed to make a file called NAMESLBR.SUB with all files
  from a given disk. Even the library files will be included in the
  file. }


program lcat;

{U+}

const
   hfcbm      =    $39BF;
   hfcb       =    $39C0;
   hdmam      =    $39FF;
   hdma       =    $3A00;

type
   line       =    string[14];
   lline      =    string[16];

var
   filevar:                                  text;
   list:                                     array[1..1000] of line;
   hold:                                     lline;
   lbrhold:                                  array[1..40] of lline;
   lbrlbrhold:                               array[1..20] of lline;
   lbrlbrlbrhold:                            array[1..20] of lline;
   lbrlbrlbrlbrhold:                         array[1..20] of lline;
   a,b,z,i,j,n,q,t,y,zz,drnum,entries, test: integer;
   x:                                        byte;
   base,base1,base2,base3,olddrive:          integer;
   dr:                                       byte absolute $5C;
   ext:                                      string[3];
   drstr:                                    string[16];
   dmastr:                                   byte absolute hdmam;
   dma:                                      string[129] absolute hdmam;
   fcb:                                      string[16] absolute hfcbm;
   rl:                                       byte absolute $39E1;
   rh:                                       byte absolute $39E2;
   rz:                                       byte absolute $39E3;
   loop,olduser,zzz,zzzz:                    integer;
   user:                                     string[1];
   done,sortdone:                            boolean;
   lo, hi :                                  integer;



procedure setlr;
begin
   rl := base mod 256;
   rh := base div 256;
   rz := 0;
   x := bdos($21, hfcb);
end;

procedure despace;
begin
   for t := 1 to i do
   begin
      test := pos(' ', list[t]);
      if test = 0 then
         hold := copy(list[t], 1, 8) + '.' + copy(list[t], 9, length(list[t]) - 8)
      else
         hold := copy(list[t], 1, test-1) + '.' + copy(list[t], 9, length(list[t]) - 8);
      test := pos('.', hold);
      if (hold[1] = '-') and (test + 4 <= length(hold)) then
      begin
         repeat
            test := ord(hold[1]);
            if test = 45 then
               hold := copy(hold, 2, length(hold) - 1);
         until test <> 45;
      end;
      list[t] := hold;
   end;
end;




begin  { main }
   writeln('LCAT  v1.0  (c)  Paul Nance, 10/6/84');
   writeln;
   drnum := ord(dr);
   olddrive := bdos($19);
   olduser := bdos($20, $FF);
   if drnum = 0 then
   begin
      writeln('LCAT v1.0 library cataloging system');
      writeln('Usage:');
      writeln('         LCAT d:');
      writeln('Examples:');
      writeln('         LCAT A:      catalogs A disk');
      writeln('         LCAT B:      catalogs B disk');
      writeln;
      writeln('LCAT was designed to create a file called NAMESLBR.SUB,');
      writeln('containing an alphabetized list of all the files on the disk.');
      writeln('Library files in library files are also included if not squeezed.');
      writeln('It is ok to squeeze regular files in libraries but not LBR files.');
      writeln('This will work up to four levels deep. Required companion files');
      writeln('are ULCAT.COM, CATL.COM and MASTL.CAT.');
   end
   else
   begin
      for z := 1 to 1000 do
         list[z][0] := chr(0);
      write('reading directory                           ');
      bdos($E, drnum-1);
      drstr := '????????????' + #0#0#0#0;
      fcb := drstr;
      bdos(26, hdma);
      x := bdos($11, hfcb);
      dmastr := $80;
      hold := copy(dma, (x * 32) + 1, 12);
      if (x <> $FF) and (hold[1] <> chr($E5)) then
      begin
         i := 1;
         z := 0;
         zz := 0;
         list[i] := copy(hold, 2, 11);
         if copy(list[i], 9, 3) = 'LBR' then
         begin
            z := z + 1;
            lbrhold[z] := hold;
         end;
      end;
      if x <> $FF then
      begin
         repeat
            x := bdos($12, hfcb);
            if x <> $FF then
            begin
               dmastr := $80;
               hold := copy(dma, (x * 32) + 1, 12);
               if hold[1] <> chr($E5) then
               begin
                  i := i + 1;
                  n := i;
                  list[i] := copy(hold, 2, 11);
                  for y := 1 to i - 1 do
                     if list[y] = list[i] then
                        if i = n then
                           i := i - 1;
                  if copy(list[i], 9, 3) = 'LBR' then
                     if i = n then
                  begin
                     z := z + 1;
                     lbrhold[z] := hold;
                  end;
               end;
            end;
         until x = $FF;
         j := i;
         zz := 0;
         for t := 1 to z do
         begin
            write(chr(13), 'reading LBR directory                       ');
            bdos($20, ord(lbrhold[t][1]));
            fcb := chr(drnum) + copy(lbrhold[t], 2, 11) + #0#0#0#0;
            x := bdos($F, hfcb);
            if x <> $FF then
            begin
               rl := 0;
               rh := 0;
               rz := 0;
               bdos(26, hdma);
               x := bdos($21, hfcb);
               if x = 0 then
                  if copy(dma, 2, 11) = '           ' then
               begin
                  entries := ord(dma[15]) * 4;
                  for n := 2 to entries do
                  begin
                     if (n mod 4) = 1 then
                     begin
                        base := n div 4;
                        setlr;
                     end;
                     dmastr := $80;
                     hold := copy(dma, (((n mod 4) * 32) + 1), 16);
                     if x = 0 then
                        if ord(hold[1]) = 0 then
                           if hold[2] <> ' ' then
                     begin
                        i := i + 1;
                        list[i] := copy(hold, 2, 11) + 'L';
                        if copy(list[i], 9, 3) = 'LBR' then
                        begin
                           zz := zz + 1;
                           lbrlbrhold[zz] := hold;
                        end;
                     end;
                  end;
                  loop := zz;
                  zz := 0;
                  zzz := 0;
                  for q := 1 to loop do
                  begin
                     write(chr(13), 'reading LBR LBR directory                 ');
                     hold := lbrlbrhold[q];
                     base1 := ord(hold[13]) + ord(hold[14]);
                     base := base1;
                     setlr;
                     if x = 0 then
                        if copy(dma, 2, 11) = '           ' then
                     begin
                        entries := ord(dma[15]) * 4;
                        for n := 2 to entries do
                        begin
                           if (n mod 4) = 1 then
                           begin
                              base := base1 + n div 4;
                              setlr;
                           end;
                           dmastr := $80;
                           hold := copy(dma, (((n mod 4) * 32) + 1), 16);
                           if x = 0 then
                              if ord(hold[1]) = 0 then
                                 if hold[2] <> ' ' then
                           begin
                              i := i + 1;
                              list[i] := copy(hold, 2, 11) + 'L2';
                              if copy(list[i], 9, 3) = 'LBR' then
                              begin
                                 zzz := zzz + 1;
                                 hold[0] := chr(16);
                                 hold[1] := chr(n mod 4);
                                 hold[15] := chr(base1 mod 256);
                                 hold[16] := chr(base1 div 256);
                                 lbrlbrlbrhold[zzz] := hold;
                              end;
                           end;
                        end;
                     end;
                  end;
                  loop := zzz;
                  zzz := 0;
                  zzzz := 0;
                  for q := 1 to loop do
                  begin
                     write(chr(13), 'reading LBR LBR LBR directory            ');
                     hold := lbrlbrlbrhold[q];
                     base2 := ord(hold[13]) + ord(hold[14]) * 256 + ord(hold[15]) + ord(hold[16]) * 256;
                     base := base2;
                     setlr;
                     if x = 0 then
                        if copy(dma, 2, 11) = '           ' then
                     begin
                        entries := ord(dma[15]) * 4;
                        for n := 2 to entries do
                        begin
                           if (n mod 4) = 1 then
                           begin
                              base := base2 + n div 4;
                              setlr;
                           end;
                           dmastr := $80;
                           hold := copy(dma, (((n mod 4) * 32) + 1), 16);
                           if x = 0 then
                              if ord(hold[1]) = 0 then
                                 if hold[2] <> ' ' then
                           begin
                              i := i + 1;
                              list[i] := copy(hold, 2, 11) + 'L3';
                              if copy(list[i], 9, 3) = 'LBR' then
                              begin
                                 zzzz := zzzz + 1;
                                 hold[0] := chr(16);
                                 hold[1] := chr(n mod 4);
                                 hold[15] := chr(base2 mod 256);
                                 hold[16] := chr(base2 div 256);
                                 lbrlbrlbrlbrhold[zzzz] := hold;
                              end;
                           end;
                        end;
                     end;
                  end;
                  loop := zzzz;
                  zzzz := 0;
                  for q := 1 to loop do
                  begin
                     write(chr(13), 'reading LBR LBR LBR LBR directory        ');
                     hold := lbrlbrlbrlbrhold[q];
                     base3 := ord(hold[13]) + ord(hold[14]) * 256 + ord(hold[15]) + ord(hold[16]) * 256;
                     base := base3;
                     setlr;
                     if x = 0 then
                        if copy(dma, 2, 11) = '           ' then
                     begin
                        entries := ord(dma[15]) * 4;
                        for n := 2 to entries do
                        begin
                           if (n mod 4) = 1 then
                           begin
                              base := base3 + n div 4;
                              setlr;
                           end;
                           dmastr := $80;
                           hold := copy(dma, (((n mod 4) * 32) + 1), 16);
                           if x = 0 then
                              if ord(hold[1]) = 0 then
                                 if hold[2] <> ' ' then
                           begin
                              i := i + 1;
                              list[i] := copy(hold, 2, 11) + 'L4';
                              if copy(list[i], 9, 3) = 'LBR' then
                              begin
                                 writeln(chr(13), 'Can''t read a LBR, LBR, LBR, LBR, LBR dir!');
                              end;
                           end;
                        end;
                     end;
                  end;
               end;
               bdos($20, olduser);
            end;
         end;
      end;
      despace;
      write(chr(13), 'sorting list...                          ');
      a := 1;
      z := i;
      if a < z then
      begin
         if list[a] > list[z] then
         begin
            hold := list[a];
            list[a] := list[z];
            list[z] := hold;
         end;
         repeat
            for n := (a + 1) to (z - 1) do
            begin
               if list[a] > list[n] then
               begin
                  hold := list[a];
                  list[a] := list[n];
                  list[n] := hold;
               end;
               if list[n] > list[z] then
               begin
                  hold := list[n];
                  list[n] := list[z];
                  list[z] := hold;
               end;
            end;
         a := a + 1;
         z := z - 1;
         until a >= z;
      end;
      write(chr(13), 'creating NAMESLBR.SUB file               ');
      bdos($E, olddrive);
      assign(filevar, chr(olddrive + 65) + ':NAMESLBR.SUB');
      rewrite(filevar);
      writeln;
      for t := 1 to i do
      begin
         writeln(list[t]);
         writeln(filevar, list[t]);
      end;
      close(filevar);
      writeln;
      writeln(i, ' files, including ', i - j, ' LBR files');
   end;
end.     { LCAT.PASCAL }