home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol094 / sub.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  7.0 KB  |  232 lines
  1. Program Sub; (* revision 8/8/82 - L. Farwell *)
  2.          (* CP/M File Menu Program *)
  3. type
  4.   string0 = string 0;
  5.   string255  = string 255;
  6.   string128 = string 128;
  7.   scope = 0..7;
  8.   xsub = array[scope] of string128;
  9.  
  10. var
  11.   asub : xsub;
  12.   command : char;
  13.   drive,        
  14.   drive1,
  15.   drive2,
  16.   name,
  17.   new,
  18.   old : string128;
  19.   count : scope;
  20.  
  21. function length(source : string255) : integer; external;
  22.  
  23. procedure submit(asub : xsub; last : scope);
  24.  
  25. const
  26.   max = 128;
  27.  
  28. type
  29.   line = string128;
  30.  
  31. var
  32.   idx : integer;
  33.   fsub : file of line;
  34.   
  35.   procedure put_sub(inbuffer : line);
  36.  
  37.   var 
  38.     tbuffer : line;
  39.     
  40.   begin (* put_sub *)
  41.     tbuffer := ' ';
  42.     tbuffer[1] := chr(length(inbuffer));
  43.     append(tbuffer, inbuffer);
  44.     repeat
  45.       append(tbuffer, chr(0)); (* pad to end of buffer *)
  46.     until length(tbuffer) = max;
  47.     write(fsub, tbuffer)
  48.   end; (* put_sub*)
  49.  
  50. begin (* submit *)
  51.   rewrite('$$$.SUB', fsub);
  52.   for idx := last downto 0 do    (* last MUST be even *)
  53.     put_sub(asub[idx]);                             end; (* submit *)
  54.  
  55. begin (* sub *)
  56.     count := 1;     (* normal end of command buffer *)
  57.     asub[1] := 'SUB';
  58.     writeln('          ----------------------------------------------');
  59.     writeln('          -           CP/M FILE SYSTEM MENU            -');
  60.     writeln('          -                                            -');
  61.     writeln('          - Choose function:                           -');
  62.     writeln('          -                                            -');
  63.     writeln('          -  A) CHECK available disk space             -');
  64.     writeln('          -  B) CHECK disk space used by one file      -');
  65.     writeln('          -  C) LIST command files                     -');
  66.     writeln('          -  D) LIST disk directory                    -');
  67.     writeln('          -  E) ERASE a file                           _');
  68.     writeln('          -  F) ERASE all backup files on a disk       -');
  69.     writeln('          -  G) RENAME a file                          -');
  70.     writeln('          -  H) TRANSFER one file to another disk      -');
  71.     writeln('          -  I) TRANSFER all files to another disk     -');
  72.     writeln('          -  J) FORMAT a disk in B drive               -');
  73.     writeln('          -  K) COPY CP/M to a disk in B drive         -');
  74.     writeln('          -  L) INITIALIZE a new disk in B drive       -');
  75.     writeln('          -  M) COPY system files to disk in B drive   -');
  76.     writeln('          -                                            -');
  77.     writeln('          -  Q) QUIT menu and return to CP/M           -');
  78.     writeln('          -                                            -');
  79.     writeln('          ----------------------------------------------');
  80.     writeln;
  81.     write('           --> ');
  82.     readln(command);
  83.     case command of
  84.       'a', 'A' : begin 
  85.            count := 3;
  86.            asub[count] := ' ';
  87.            asub[2] := 'SUB';
  88.            asub[1] := 'HOLD';           
  89.            writeln;
  90.            write('       Status of drive A or drive B : ');
  91.            readln(drive);
  92.            asub[0] := 'STAT ';
  93.            append(asub[0], drive);
  94.            append(asub[0], ':');                       
  95.          end; (* 'a', 'A' *);
  96.       'b', 'B' : begin             
  97.            count := 3;
  98.            asub[count] := ' ';
  99.            asub[2] := 'SUB';
  100.            asub[1] := 'HOLD';           
  101.            writeln;
  102.            write('            File is on drive A or drive B : ');
  103.            readln(drive);
  104.            write('            File name is <filename.type> : ');
  105.            readln(name);                           
  106.            asub[0] := 'STAT ';
  107.            append(asub[0], drive);
  108.            append(asub[0], ':');
  109.            append(asub[0], name);                       
  110.          end; (* 'b', 'B' *)                           
  111.       'c', 'C' : begin
  112.            count := 3;
  113.            asub[count] := ' ';
  114.            asub[2] := 'SUB';
  115.            asub[1] := 'HOLD';           
  116.            writeln;
  117.            write('Command files on drive A or drive B : ');
  118.            readln(drive);
  119.            asub[0] := 'DIR ';  
  120.            append(asub[0], drive);
  121.            append(asub[0], ':*.COM');
  122.          end; (* 'c', 'D' *)
  123.      'd', 'D' : begin
  124.            count := 3;
  125.            asub[count] := ' ';
  126.            asub[2] := 'SUB';
  127.            asub[1] := 'HOLD';
  128.            writeln;
  129.            write('   Directory for drive A or drive B : ');
  130.            readln(drive);
  131.            asub[0] := 'DIR ';  
  132.            append(asub[0], drive);
  133.            append(asub[0], ':');            
  134.         end; (* 'd', 'D' *)
  135.       'e', 'E' : begin
  136.            writeln;
  137.            write('            File is on drive A or drive B : ');
  138.            readln(drive);
  139.            write('            File name is <filename.type> : ');
  140.            readln(name);                           
  141.            asub[0] := 'ERA ';
  142.            append(asub[0], drive);
  143.            append(asub[0], ':');
  144.            append(asub[0], name);                       
  145.          end; (* 'e', 'E' *)                           
  146.       'f', 'F' : begin
  147.            write('            File is on drive A or drive B : ');
  148.            readln(drive);
  149.            asub[0] := 'ERA ';
  150.            append(asub[0], drive);
  151.            append(asub[0], ':*.bak');
  152.           end; (* 'f', 'F' *)
  153.       'g', 'G' : begin
  154.            writeln;
  155.            write('            File is on drive A or drive B : ');
  156.            readln(drive);
  157.            write('            Old file name is <filename.type> : ');
  158.            readln(old);
  159.            write('            New file name is <filename.type> : ');
  160.            readln(new);
  161.            asub[0] := 'REN ';
  162.            append(asub[0], drive);
  163.            append(asub[0], ':');
  164.            append(asub[0], new);
  165.            append(asub[0], '=');
  166.            append(asub[0], drive);
  167.            append(asub[0], ':');
  168.            append(asub[0], old);
  169.          end; (* 'g', 'G' *)                          
  170.       'h', 'H' : begin
  171.            writeln;
  172.            write('            Transfer from drive : ');
  173.            readln(drive1);
  174.            write('            Transfer to drive : ');
  175.            readln(drive2);
  176.            write('            File name is <filename.type> : ');
  177.            readln(name);
  178.            asub[0] := 'PIP ';
  179.            append(asub[0], drive2);
  180.            append(asub[0], ':=');
  181.            append(asub[0], drive1);
  182.            append(asub[0], ':');
  183.            append(asub[0], name);
  184.          end; (* 'h', 'H' *)                           'i', 'I' : begin
  185.            writeln;
  186.            write('            Transfer ALL files from drive : ');
  187.            readln(drive1);
  188.            write('            Transfer to drive : ');
  189.            readln(drive2);
  190.            asub[0] := 'PIP ';
  191.            append(asub[0], drive2);
  192.            append(asub[0], ':=');
  193.            append(asub[0], drive1);
  194.            append(asub[0], ':*.*');
  195.          end; (* 'i', 'I' *)                           
  196.       'j', 'J' : begin
  197.            writeln;
  198.            asub[0] := 'FORMAT';
  199.          end; (* 'j', 'J' *)                          
  200.       'k', 'K' : begin
  201.            writeln;
  202.            writeln('To copy CP/M to formated disk in drive B:');
  203.            writeln('enter A as source and B as destination.');
  204.            writeln('Press RETURN key when function is complete.');
  205.            writeln;
  206.            asub[0] := 'SYSGEN';
  207.          end; (* 'k', 'K' *)                          
  208.       'l', 'L' : begin
  209.            writeln;
  210.            count := 3;
  211.            asub[count] := ' ';
  212.            asub[2] := 'SUB';
  213.            asub[1] := 'SYSGEN';
  214.            asub[0] := 'FORMAT';
  215.          end; (* 'l', 'L' *)
  216.       'm', 'M' : begin
  217.            writeln;
  218.            count := 7;
  219.            asub[7] := 'SUB';
  220.            asub[6] := 'PIP B:=HOLD.COM'; 
  221.            asub[5] := 'PIP B:=SYSGEN.COM';
  222.            asub[4] := 'PIP B:=SUB.COM';
  223.            asub[3] := 'PIP B:=PIP.COM';
  224.            asub[2] := 'PIP B:=FORMAT.COM';
  225.            asub[1] := 'PIP B:=STAT.COM';
  226.            asub[0] := 'PIP B:=SUBMIT.COM';
  227.          end; (* 'm', 'M' *)
  228.     end; (* cases *)
  229.   if not (command in ['q', 'Q']) then
  230.     submit(asub, count);
  231. end. (* sub *)
  232.