home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / LCATCODE.LBR / CATL.PQS / CATL.PAS
Pascal/Delphi Source File  |  2000-06-30  |  14KB  |  454 lines
  1. { TURBO PASCAL version of CATL.COM
  2.  
  3.   Compile at 5200
  4.  
  5.   A program designed to open MASTL.CAT  and print to the screen
  6.   a listing of the files.
  7.  
  8.   CATL                       Will display all files one screen at a time.
  9.   CATL *.* *.*               Same as above
  10.   CATL *.COM *.012           Will display all .COM files from disk 12.
  11.   CATL (file) (disk) $l      Sends output to the list device (66 lines/page).  }
  12.  
  13. {$U+}
  14.  
  15. const
  16.    bl               =                ' ';
  17.  
  18. type
  19.    line             =                string[26];
  20.    sline            =                string[16];
  21.  
  22. var
  23.    catfile:                           text;
  24.    testfile,testdisk,cfile, cdisk:    string[15];
  25.    testa,testb,testc,testd:           sline;
  26.    ll,filea,fileb,filec,filed:           sline;
  27.    fcb1:                              string[11] absolute $5C;
  28.    fcb2:                              string[11] absolute $6C;
  29.    dma:                               string[50] absolute $80;
  30.    date,optline:                      string[50];
  31.    a,b,c,l,k,p,t,y,x:                 integer;
  32.    list:                              array[1..40] of line;
  33.    prlist:                            array[1..108] of line;
  34.    s:                                 string[1];
  35.    first,page,print,tf,td:            boolean;
  36.    col,mode,pn,pr:                    integer;
  37.  
  38. procedure printpage;
  39. begin
  40.    if pr = 108 then
  41.       col := 54
  42.    else
  43.       col := pr div 2;
  44.    for l := 1 to 2 do
  45.       writeln(lst);
  46.    writeln(lst, bl:8, 'MASTER CATALOG including library files as of ', date);
  47.    writeln(lst);
  48.    writeln(lst, bl:12, 'file', bl:14, 'disk', bl:14, 'file', bl:14, 'disk');
  49.    writeln(lst);
  50.    for l := 1 to col do
  51.    begin
  52.       p := pos(',', prlist[l]);
  53.       if EOF(catfile) then begin end;
  54.       cfile := copy(prlist[l], 1, p - 1);
  55.       cdisk := copy(prlist[l], p + 1, length(prlist[l]) - p);
  56.       p := pos('.', cfile);
  57.       if p <> 9 then
  58.          insert(copy('        ', 1, 9 - p), cfile, p);
  59.       if length(cfile) > 12 then
  60.          ll := copy(cfile, 13, length(cfile) - 12) + '  '
  61.       else
  62.          ll := '  ';
  63.       ll[0] := #02;
  64.       write(lst, bl:8, copy(cfile, 1, 12), bl:2, ll, bl:2);
  65.       p := pos('.', cdisk);
  66.       if p <> 9 then
  67.          insert(copy('        ', 1, 9 - p), cdisk, p);
  68.       write(lst, cdisk);
  69.       if prlist[l + col][1] <> ' ' then
  70.       begin
  71.          p := pos(',', prlist[l + col]);
  72.          cfile := copy(prlist[l + col], 1, p - 1);
  73.          cdisk := copy(prlist[l + col], p + 1, length(prlist[l + col]) - p);
  74.          p := pos('.', cfile);
  75.          if p <> 9 then
  76.             insert(copy('        ', 1, 9 - p), cfile, p);
  77.          if length(cfile) > 12 then
  78.             ll := copy(cfile, 13, length(cfile) - 12) + '  '
  79.          else
  80.             ll := '  ';
  81.          ll[0] := #02;
  82.          write(lst, bl:6, copy(cfile, 1, 12), bl:2, ll, bl:2);
  83.          p := pos('.', cdisk);
  84.          if p <> 9 then
  85.             insert(copy('        ', 1, 9 - p), cdisk, p);
  86.          write(lst, cdisk);
  87.       end;
  88.       writeln(lst);
  89.    end;
  90.    for l := 1 to (54 - col) do
  91.    begin
  92.       writeln(lst);
  93.    end;
  94.    writeln(lst);
  95.    l := length(optline) + 12;
  96.    writeln(lst, bl:(80 - l) div 2, 'Using ', optline, '- ', pn, ' -');
  97.    writeln(lst);
  98.    writeln(lst);
  99.    writeln(lst);
  100.    writeln(lst);
  101.    pn := pn + 1;
  102.    if pr <> 108 then
  103.       print := false;
  104.    pr := 0;
  105. end;
  106.  
  107. procedure printer;
  108. begin
  109.    for k := 1 to 40 do
  110.    begin
  111.       pr := pr + 1;
  112.       prlist[pr] := list[k];
  113.       if print then
  114.          if (pr = 108) or (list[k][1] = ' ') then printpage;
  115.    end;
  116.    if list[k][1] = ' ' then
  117.       print := false;
  118. end;
  119.  
  120. procedure show;
  121. begin
  122.    clrscr;
  123.    gotoxy(12,1);
  124.    write('file');
  125.    gotoxy(30,1);
  126.    write('disk');
  127.    gotoxy(54,1);
  128.    write('file');
  129.    gotoxy(70,1);
  130.    write('disk');
  131.    b := 11;
  132.    c := 3;
  133.    for a := 1 to 40 do
  134.    begin
  135.       if list[a][1] <> ' ' then
  136.       begin
  137.          p := pos(',', list[a]);
  138.          cfile := copy(list[a], 1, p - 1);
  139.          cdisk := copy(list[a], p + 1, length(list[a]) - p);
  140.          gotoxy(b, c);
  141.          p := pos('.', cfile);
  142.          write(copy(cfile, 1, p - 1));
  143.          gotoxy(b + 8, c);
  144.          write(copy(cfile, p, 4));
  145.          gotoxy(b + 13, c);
  146.          if (p + 4 < length(cfile) + 1) then
  147.             write(copy(cfile, p + 4, length(cfile) - p - 3));
  148.          gotoxy(b + 16, c);
  149.          p := pos('.', cdisk);
  150.          write(copy(cdisk, 1, p - 1));
  151.          gotoxy(b + 24, c);
  152.          write(copy(cdisk, p, 4));
  153.          c := c + 1;
  154.          if c = 23 then
  155.          begin
  156.             b := 48;
  157.             c := 3;
  158.          end;
  159.       end;
  160.    end;
  161.    gotoxy(1, 24);
  162.    if (list[a][1] <> ' ')  then
  163.       write('CATL.COM', optline, '  - [more]');
  164. end;
  165.  
  166. procedure geta;
  167. begin
  168.    filea := copy(list[a], 1, pos('.', list[a]) - 1);
  169.    filea := copy(filea + '       ', 1, 8);
  170.    for k := 1 to 8 do
  171.       if testa[k] = '?' then
  172.          filea[k] := '?';
  173. end;
  174.  
  175. procedure getb;
  176. begin
  177.    fileb := copy(list[a], pos('.', list[a]) + 1, 3);
  178.    for k := 1 to 3 do
  179.       if testb[k] = '?' then
  180.          fileb[k] := '?';
  181. end;
  182.  
  183. procedure getc;
  184. begin
  185.    filec := copy(list[a], pos(',', list[a]) + 1, length(list[a]) - pos(',', list[a]));
  186.    filec := copy(filec, 1, pos('.', filec) - 1);
  187.    filec := copy(filec + '       ', 1, 8);
  188.    for k := 1 to 8 do
  189.       if testc[k] = '?' then
  190.          filec[k] := '?';
  191. end;
  192.  
  193. procedure getd;
  194. begin
  195.    filed := copy(list[a], pos(',', list[a]) + 1, length(list[a]) - pos(',', list[a]));
  196.    filed := copy(filed, pos('.', filed) + 1, 3);
  197.    for k := 1 to 3 do
  198.       if testd[k] = '?' then
  199.          filed[k] := '?';
  200. end;
  201.  
  202. begin
  203.    optline := dma;
  204.    mem[$5C] := 11;
  205.    mem[$6C] := 11;
  206.    testfile := fcb1;
  207.    testdisk := fcb2;
  208.    writeln('CATL.COM  (c)  Paul Nance, 10/6/84');
  209.    delay(1000);
  210.    if testfile[1] = '$' then
  211.       testfile := '           ';
  212.    if testdisk[1] = '$' then
  213.       testdisk := '           ';
  214.    x := pos('$', optline);
  215.    print := false;
  216.    if x = 0 then
  217.    begin
  218.       for l := (x + 1) to length(optline) do
  219.          if optline[l] = 'L' then
  220.             print := true;
  221.       optline := copy(optline, 1, x - 1);
  222.    end;
  223.    if print then
  224.    begin
  225.       write('Date to print on listing?   <May 2, 1984>  ');
  226.       readln(date);
  227.       writeln;
  228.       pr := 0;
  229.       pn := 1;
  230.    end;
  231.    if testfile[1] = ' ' then
  232.       tf := false
  233.    else
  234.       tf := true;
  235.    mode := 0;
  236.    if tf then
  237.    begin
  238.       if (copy(testfile, 1, 8) <> '????????') then
  239.          if (testfile[1] <> ' ') then
  240.             mode := mode + 8;
  241.       if (copy(testfile, 9, 3) <> '???') then
  242.          if (testfile[9] <> ' ') then
  243.             mode := mode + 4;
  244.       if (copy(testdisk, 1, 8) <> '????????') then
  245.          if (testdisk[1] <> ' ') then
  246.             mode := mode + 2;
  247.       if (copy(testdisk, 9, 3) <> '???') then
  248.          if (testdisk[9] <> ' ') then
  249.             mode := mode + 1;
  250.    end;
  251.    assign(catfile, 'MASTL.CAT');
  252.    reset(catfile);
  253.    x := 0;
  254.    while x = 0 do
  255.    begin
  256.       readln(catfile, list[1]);
  257.       x := pos(')', list[1]);
  258.    end;
  259.    while not EOF(catfile) do
  260.    begin
  261.       case mode of
  262.  
  263.          0:  begin
  264.               end;
  265.          1:  begin
  266.                 testd := copy(testdisk, 9, 3);
  267.              end;
  268.          2:  begin
  269.                 testc := copy(testdisk, 1, 8);
  270.              end;
  271.          3:  begin
  272.                 testc := copy(testdisk, 1, 8);
  273.                 testd := copy(testdisk, 9, 3);
  274.              end;
  275.          4:  begin
  276.                 testb := copy(testfile, 9, 3);
  277.              end;
  278.          5:  begin
  279.                 testb := copy(testfile, 9, 3);
  280.                 testd := copy(testdisk, 9, 3);
  281.              end;
  282.          6:  begin
  283.                 testb := copy(testfile, 9, 3);
  284.                 testc := copy(testdisk, 1, 8);
  285.              end;
  286.          7:  begin
  287.                 testb := copy(testfile, 9, 3);
  288.                 testc := copy(testdisk, 1, 8);
  289.                 testd := copy(testdisk, 9, 3);
  290.              end;
  291.          8:  begin
  292.                 testa := copy(testfile, 1, 8);
  293.              end;
  294.          9:  begin
  295.                 testa := copy(testfile, 1, 8);
  296.                 testd := copy(testdisk, 9, 3);
  297.              end;
  298.          10: begin
  299.                 testa := copy(testfile, 1, 8);
  300.                 testc := copy(testdisk, 1, 8);
  301.              end;
  302.          11: begin
  303.                 testa := copy(testfile, 1, 8);
  304.                 testc := copy(testdisk, 1, 8);
  305.                 testd := copy(testdisk, 9, 3);
  306.              end;
  307.          12: begin
  308.                 testa := copy(testfile, 1, 8);
  309.                 testb := copy(testfile, 9, 3);
  310.              end;
  311.          13: begin
  312.                 testa := copy(testfile, 1, 8);
  313.                 testb := copy(testfile, 9, 3);
  314.                 testd := copy(testdisk, 9, 3);
  315.              end;
  316.          14: begin
  317.                 testa := copy(testfile, 1, 8);
  318.                 testb := copy(testfile, 9, 3);
  319.                 testc := copy(testdisk, 1, 8);
  320.              end;
  321.          15: begin
  322.                 testa := copy(testfile, 1, 8);
  323.                 testb := copy(testfile, 9, 3);
  324.                 testc := copy(testdisk, 1, 8);
  325.                 testd := copy(testdisk, 9, 3);
  326.              end;
  327.  
  328.       end;
  329.       first := false;
  330.       while not EOF(catfile) do
  331.       begin
  332.          for a := 1 to 40 do
  333.          begin
  334.             x := 0;
  335.             while x = 0 do
  336.             begin
  337.                if not EOF(catfile) then
  338.                begin
  339.                   readln(catfile, list[a]);
  340.                   case mode of
  341.  
  342.                      0:    begin
  343.                               x := 1;
  344.                            end;
  345.                      1:    begin
  346.                               getd;
  347.                               if testd = filed then
  348.                                  x := 1;
  349.                            end;
  350.                      2:    begin
  351.                               getc;
  352.                               if testc = filec then
  353.                                  x := 1;
  354.                            end;
  355.                      3:    begin
  356.                               getc;
  357.                               getd;
  358.                               if (testd = filed) and (testc = filec) then
  359.                                  x := 1;
  360.                            end;
  361.                      4:    begin
  362.                               getb;
  363.                               if testb = fileb then
  364.                                  x := 1;
  365.                            end;
  366.                      5:    begin
  367.                               getb;
  368.                               getd;
  369.                               if (testb = fileb) and (testd = filed) then
  370.                                  x := 1;
  371.                            end;
  372.                      6:    begin
  373.                               getb;
  374.                               getc;
  375.                               if (testb = fileb) and (testc = filec) then
  376.                                  x := 1;
  377.                            end;
  378.                      7:    begin
  379.                               getb;
  380.                               getc;
  381.                               getd;
  382.                               if (testb = fileb) and (testc = filec) and (testd = filed) then
  383.                                  x := 1;
  384.                            end;
  385.                      8:    begin
  386.                               geta;
  387.                               if testa = filea then
  388.                                  x := 1;
  389.                            end;
  390.                      9:    begin
  391.                               geta;
  392.                               getd;
  393.                               if (testa = filea) and (testd = filed) then
  394.                                  x := 1;
  395.                            end;
  396.                      10:   begin
  397.                               geta;
  398.                               getc;
  399.                               if (testa = filea) and (testc = filec) then
  400.                                  x := 1;
  401.                            end;
  402.                      11:   begin
  403.                               geta;
  404.                               getc;
  405.                               getd;
  406.                               if (testa = filea) and (testc = filec) and (testd = filed) then
  407.                                  x := 1;
  408.                            end;
  409.                      12:   begin
  410.                               geta;
  411.                               getb;
  412.                               if (testa = filea) and (testb = fileb) then
  413.                                  x := 1;
  414.                            end;
  415.                      13:   begin
  416.                               geta;
  417.                               getb;
  418.                               getd;
  419.                               if (testa = filea) and (testb = fileb) and (testd = filed) then
  420.                                  x := 1;
  421.                            end;
  422.                      14:   begin
  423.                               geta;
  424.                               getb;
  425.                               getc;
  426.                               if (testa = filea) and (testb = fileb) and (testc = filec) then
  427.                                  x := 1;
  428.                            end;
  429.                      15:   begin
  430.                               geta;
  431.                               getb;
  432.                               getc;
  433.                               getd;
  434.                               if (testa = filea) and (testb = fileb) and (testc = filec) and (testd = filed) then
  435.                                  x := 1;
  436.                            end;
  437.                   end;
  438.                end
  439.                else
  440.                begin
  441.                   list[a] := ' ';
  442.                   x := 1;
  443.                end;
  444.             end;
  445.          end;
  446.          if (not print) and (first) then read(s);
  447.          first := true;
  448.          show;
  449.          if print then printer;
  450.       end;
  451.    end;
  452.    read(s);
  453.    close(catfile);
  454. end.