home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug017.arc / PRINTCAT.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  9KB  |  230 lines
  1.  
  2. PROGRAM printcat;
  3. {Program to print out the MAST.CAT with 4 files to the line.}
  4. {The program needs to be on the same disk as the catalog.   }
  5.  
  6. {                        A D D I T I O N S                  }
  7. {                        -----------------                  }
  8. {1/2/86    removed unwanted variables and documented the    }
  9. {          lines.                                           }
  10. {2/2/86    padded extention to print left justified         }
  11. {          moved some assingments out of loop               }
  12. {          added procedure center                           }
  13.  
  14. LABEL
  15.   1;
  16.  
  17. CONST
  18.   ver     = 'Ver 1.02';
  19.   topline = 'M A S T . C A T  -- Printout.  ';
  20.   by      = 'Writen by Peter Billing.';
  21.   date    = '2 - 2 - 1986';
  22.  
  23. TYPE
  24.   st80    = STRING[80];
  25.  
  26. VAR
  27.   Q        : text;         {Used to switch between Screen and Printer}
  28.   infile   : text;         {assigned to MAST.CAT                     }
  29.   line     : STRING[60];   {read a line from the file                }
  30.   heading  : STRING[60];   {heading for each page.                   }
  31.   footnote : STRING[60];   {now many files printed                   }
  32.   topheading:STRING[50];   {Sign on heading                          }
  33.   filename : STRING[8];    {filename without extention               }
  34.   fill     : STRING[8];    {used to pad out filename to 8 characters }
  35.   test     : STRING[4];    {check to see if matches ".ext"           }
  36.   No       : STRING[4];    {Number of files printed.                 }
  37.   diskno   : STRING[3];    {the three digits of the disk name.       }
  38.   ext      : STRING[3];    {the three character extention.           }
  39.   extention: string[3];    {the extention left justified             }
  40.   ch       : char;         {a dummy char for general use.            }
  41.   f        : integer;      {length of filename without extention     }
  42.   i        : integer;      {general variable for use in loops        }
  43.   j        : integer;      {counter for the number of files per line }
  44.   k        : integer;      {position of the start of the extention   }
  45.   m        : integer;      {end of extention                         }
  46.   l        : integer;      {total length of whole "line"             }
  47.   e        : integer;      {length of extention                      }
  48.   lineno   : integer;      {counts the number of lines printed       }
  49.   printer  : boolean;      {is the printer being used                }
  50.   diskdrive: boolean;      {is the file being writen to disk         }
  51.  
  52. PROCEDURE Device;       {Q must be declared globaly as TEXT}
  53. VAR Dev: char;
  54. BEGIN
  55.   writeln('Which output device ? .. S<creen>, P<rinter> or F<ile> ? ');
  56.   REPEAT
  57.     read(kbd,dev);
  58.     dev := upcase(dev);
  59.     writeln(dev);
  60.     IF NOT (dev IN ['S','P','F'])
  61.       THEN
  62.         BEGIN
  63.           writeln;
  64.           writeln('An "S", "P" or "F"  expected. Try again.');
  65.         END;
  66.     UNTIL dev IN ['S','P','F'];
  67.     CASE dev OF
  68.       'S' : assign(Q,'CON:');
  69.       'P' : BEGIN
  70.               assign(Q,'LST:');
  71.               printer := true;
  72.             END;
  73.       'F' : BEGIN
  74.               assign(Q,'PRINT'+ ext +'.CAT');
  75.               diskdrive := true;
  76.             END;
  77.     END; {CASE OF}
  78.   rewrite(Q);
  79. END;{Procedure device}
  80.  
  81. PROCEDURE center(message : st80);
  82. begin
  83.   writeln(q,message:40+(length(message) div 2));
  84. end;
  85.  
  86. PROCEDURE center2(message : st80);
  87. begin
  88.   write(q,message:40+(length(message) div 2));
  89. end;
  90.  
  91.  
  92. BEGIN
  93.   clrscr;
  94.   printer   := false;
  95.   diskdrive := false;
  96.   extention := '';
  97.   ext       := '';
  98.   fill      := '        ';
  99.   assign(q,'CON:');
  100.   reset(q);
  101.   topheading := topline + ver;
  102.   center(topheading);
  103.   center(by);
  104.   center(date);
  105.   writeln;
  106.   writeln('     This program will print out the MAST.CAT with 4 files to the line.');
  107.   writeln('     The files can be displayed on the Screen, printed on a Printer or');
  108.   writeln('     written to a File.  The File name will be "PRINText.CAT".  The ext');
  109.   writeln('     will equal the extention you asked for.');
  110.   writeln('     There is no error checking for file names or disk space.');
  111.   writeln('     The program needs to be on the same disk as the catalog.');
  112.   writeln;
  113.   writeln('     You can enter a heading which will be printed on the top of each');
  114.   writeln('     page.  Maximium length is 60 characters.  There is only one line.');
  115.   writeln;
  116.   writeln('     When used with a printer the program will stop at the end of each');
  117.   writeln('     sheet and wait for the <RETURN> to be pressed. (I use single sheet.)');
  118.   writeln('     You will be prompted at this time.');
  119.   writeln;
  120.   center2('A to Abort.   Any key to continue.');
  121.   read(KBD,ch);
  122.   if upcase(ch) = 'A' then goto 1;
  123.   assign(infile,'MAST.CAT');
  124.   reset(infile);
  125.   ext := '';
  126.   writeln;
  127.   write('What Extention do you want listed? Just the last 3 letters eg MWB ');
  128.   readln(ext);
  129.   e := length(ext);
  130.   FOR i := 1 TO e DO
  131.     ext[i] :=  upcase(ext[i]);
  132.   writeln('Looking for files *.',ext);
  133.   extention := ext + copy(fill,5,3-e); {left justify the extention}
  134.   writeln;
  135.   writeln('What Heading do wish ? Just press <RETURN> for no heading. ');
  136.   readln(heading);
  137.   device;
  138.   clrscr;
  139.   REPEAT                    {don't worry about the files between ( )}
  140.     read(infile,ch);
  141.   UNTIL ch = ')';
  142.   readln(infile);           {put the pointer onto the next line}
  143.   j := 1;         {no of files printed}
  144.   lineno := 0;    {no of lines printed}
  145.   WHILE (NOT eof(infile)) DO
  146.     BEGIN
  147.       IF lineno MOD 55 = 0
  148.         THEN BEGIN
  149.                IF printer
  150.                  THEN BEGIN
  151.                         writeln('Press RETURN when printer is ready.':45);
  152.                         readln(ch);
  153.                         write(q,chr(27),chr(56));
  154.                    END;
  155.                writeln(q);       {v- put the heading in the center}
  156.                center(HEADING);
  157.                writeln(q);
  158.                FOR i := 1 TO 4 DO
  159.                  write(q,'   File name   Disk');
  160.                writeln(q);
  161.                FOR i := 1 TO 4 DO
  162.                  write(q,'                No.');
  163.                writeln(q);
  164.                FOR i := 1 TO 78 DO
  165.                  write(q,'-');
  166.                  writeln(q);
  167.                write(q,'   ');
  168.                lineno := lineno + 1;
  169.           END;
  170.       read(kbd);                {able to stop program  }
  171.       readln(infile,line);      {read the next line    }
  172.       k := pos('.',line);       {find the first .      }
  173.       m := pos(',',line);
  174.       test := copy(line,k+1,m-k-1); {read the length of ext}
  175.       IF test = ext             {Test to see if are what we are looking for  }
  176.         THEN BEGIN              {if it is true them start work               }
  177.                filename := copy(line,1,k-1); {filename is everything up to . }
  178.  
  179.                f := length(filename);        {find the length of the filename}
  180.                {So that all the names line up nicely they all need to be the }
  181.                {same length.  To do that spaces are added to the end of the  }
  182.                {filename.  This is done by taking away the length of the     }
  183.                {filename from a string of 8 blanks.  The blanks left are     }
  184.                {then added to the end of the filename making it 8 chars long }
  185.  
  186.                filename := filename  + copy(fill,1,8-f);
  187.  
  188.                l := length(line);            {find length of total line.     }
  189.                {The Disk No is found by subtracting from the end of the line }
  190.                {the last three characters                                    }
  191.  
  192.                diskno   := copy(line,l-2,3);
  193.  
  194.                {print the filename some where.}
  195.                write(q,filename:8,'.',extention:3,diskno:4,'   ');
  196.  
  197.                IF j <> 0
  198.                  THEN BEGIN
  199.                         IF j MOD 4 =0
  200.                           THEN BEGIN
  201.                                  writeln(q);
  202.                                  lineno := lineno + 1;
  203.                                  write(q,'   ');
  204.                                  IF (lineno MOD 55 = 0) AND (printer)
  205.                                    THEN
  206.                                      BEGIN
  207.                                        writeln(q,chr(12));
  208.                                        FOR i := 1 TO 3 DO
  209.                                          write(chr(7));
  210.                                      END;
  211.                             END;
  212.                    END;
  213.                j := j + 1;
  214.           END;
  215.     END;
  216.     writeln(q);
  217.     str(j - 1,no);
  218.     footnote := 'There were ' + No + ' files with the extention ' + ext;
  219.     center(footnote);
  220.     IF printer
  221.       THEN BEGIN
  222.              writeln(q,chr(12));
  223.              FOR i := 1 TO 4 DO
  224.                write(chr(7));
  225.         END;
  226.     IF diskdrive
  227.       THEN close(q);
  228. 1:
  229. END.
  230.