home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / MURUTIL.ZIP / LISTER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-05-28  |  7.4 KB  |  319 lines
  1. PROGRAM LISTER;
  2.  
  3. {  This Turbo Pascal program reads an input file and generates a
  4.    listing file suitable for printing.
  5.  
  6.    The input/listing files may be specified in the command line,
  7.    as in:   "LISTER LISTER.PAS LISTER.LIS"
  8.       or:   "LISTER LISTER.PAS".
  9.  
  10.    If the input/listing files are not specified in the command line,
  11.    the program asks for them.
  12.  
  13.    TAB codes are expanded, assuming standard a tab setting every eight
  14.    spaces.
  15.  
  16.    Other non-printing codes are converted to "^" characters.
  17.  
  18.    Program by Harry M. Murphy,  22 February 1986.
  19.  
  20.    Updated by H.M.M. on 28 May 1986.  }
  21.  
  22. CONST
  23.   MXLINE = 55;
  24.  
  25. TYPE
  26.   DATESTRING = STRING[28];
  27.   FILESPEC   = STRING[65];
  28.   LINESTRING = STRING[80];
  29.   TIMESTRING = STRING[6];
  30.  
  31. VAR
  32.   CLOCK:   TIMESTRING;
  33.   INP:     TEXT[2048];
  34.   INPNAME: FILESPEC;
  35.   INPLINE: LINESTRING;
  36.   NLINE:   INTEGER;
  37.   NPAGE:   INTEGER;
  38.   OUT:     TEXT[2048];
  39.   OUTLINE: LINESTRING;
  40.   OUTNAME: FILESPEC;
  41.   TITLE:   STRING[60];
  42.   TODAY:   DATESTRING;
  43.  
  44.  
  45. FUNCTION DATE: DATESTRING;
  46.  
  47. {  This function returns today's date as a DateString of up
  48.    to 28 bytes, such as:  "Tuesday, 18 February 1986".
  49.  
  50.    Note:  TYPE DATESTRING = STRING[28];
  51.  
  52.    Procedure adapted from the Turbo Pascal date example by
  53.    Harry M. Murphy,  18 February 1986.  }
  54.  
  55.   TYPE
  56.     REGPAK = RECORD
  57.                AX,BX,CX,DX,BP,SI,DI,DS,ES,FL: INTEGER
  58.              END;
  59.  
  60.   VAR
  61.     ID,IM,IW,IY,JC,JD,JM,JY: INTEGER;
  62.     REG:  REGPAK;
  63.     DAY:  STRING[2];
  64.     DTE:  DATESTRING;
  65.     YEAR: STRING[4];
  66.  
  67.   BEGIN
  68.     WITH REG DO
  69.       BEGIN
  70.         AX:=$2A00;
  71.         MSDOS(REG);
  72.         IY:=CX;
  73.         IM:=HI(DX);
  74.         ID:=LO(DX)
  75.       END;
  76.     JY:=IY; JM:=IM-2;
  77.     IF JM < 1 THEN BEGIN JM:=JM+12; JY:=JY-1 END;
  78.     JC:=JY DIV 100; JD:=JY-100*JC;
  79.     IW:=((ID+42+(13*JM-1) DIV 5 +JD+JD DIV 4+JC DIV 4-2*JC) MOD 7);
  80.     CASE IW OF
  81.       0: DTE:='Sunday, ';
  82.       1: DTE:='Monday, ';
  83.       2: DTE:='Tuesday, ';
  84.       3: DTE:='Wednesday, ';
  85.       4: DTE:='Thursday, ';
  86.       5: DTE:='Friday, ';
  87.       6: DTE:='Saturday, '
  88.     END { CASE };
  89.     STR(ID:2,DAY); STR(IY:4,YEAR);
  90.     CASE IM OF
  91.       1: DTE:=DTE+DAY+' January '+YEAR;
  92.       2: DTE:=DTE+DAY+' February '+YEAR;
  93.       3: DTE:=DTE+DAY+' March '+YEAR;
  94.       4: DTE:=DTE+DAY+' April '+YEAR;
  95.       5: DTE:=DTE+DAY+' May '+YEAR;
  96.       6: DTE:=DTE+DAY+' June '+YEAR;
  97.       7: DTE:=DTE+DAY+' July '+YEAR;
  98.       8: DTE:=DTE+DAY+' August '+YEAR;
  99.       9: DTE:=DTE+DAY+' September '+YEAR;
  100.      10: DTE:=DTE+DAY+' October '+YEAR;
  101.      11: DTE:=DTE+DAY+' November '+YEAR;
  102.      12: DTE:=DTE+DAY+' December '+YEAR
  103.     END { CASE };
  104.     DATE:=DTE
  105.   END {Function DATE};
  106.  
  107.  
  108. PROCEDURE FILTER(VAR LINE1, LINE2: LINESTRING);
  109.  
  110. {  This procedure "filters" non-printing ASCII characters from LINE1 to
  111.    LINE2 by translating tab codes to equivalent spaces and the remainder
  112.    to "^" characters.
  113.   
  114.    Note:  TYPE LINESTRING = STRING[80];
  115.  
  116.    Procedure by Harry M. Murphy,  22 February 1986.  }
  117.  
  118.   VAR
  119.     CH: CHAR;
  120.     K, KT, L, LL: 1..80;
  121.  
  122.   BEGIN
  123.     LL:=LENGTH(LINE1);
  124.     K:=0;
  125.     L:=0;
  126.     WHILE (L<LL) AND (K<80) DO
  127.       BEGIN
  128.         K:=K+1;
  129.         L:=L+1;
  130.         CH:=LINE1[L];
  131.         IF (CH>CHR(31)) AND (CH<CHR(127))
  132.           THEN
  133.             LINE2[K]:=CH
  134.           ELSE
  135.             IF CH=CHR(9)
  136.               THEN
  137.                 BEGIN
  138.                   LINE2[K]:=' ';
  139.                   KT:=((K+7) DIV 8)*8;
  140.                   IF KT>80 THEN KT:=80;
  141.                   WHILE K<KT DO
  142.                     BEGIN
  143.                       K:=K+1;
  144.                       LINE2[K]:=' '
  145.                     END
  146.                 END
  147.               ELSE
  148.                 LINE2[K]:='^'
  149.       END;
  150.     LINE2[0]:=CHR(K)
  151.   END {Procedure FILTER};
  152.  
  153.  
  154. PROCEDURE GETINPFIL(VAR INPNAME: FILESPEC);
  155.  
  156. {  This file gets an input file, either as the first parameter
  157.    on the command line or by requesting it from the user.
  158.  
  159.    Procedure by Harry M. Murphy,  22 February 1986.  }
  160.   
  161.   VAR
  162.     L: INTEGER;
  163.  
  164.   BEGIN
  165.     IF PARAMCOUNT = 0
  166.       THEN
  167.         BEGIN
  168.           WRITE('Input  file: ');
  169.           READLN(INPNAME)
  170.         END
  171.       ELSE
  172.         INPNAME:=PARAMSTR(1);
  173.     FOR L:=1 TO LENGTH(INPNAME) DO INPNAME[L]:=UPCASE(INPNAME[L]);
  174.     ASSIGN(INP,INPNAME);
  175.     {$I-} RESET(INP); {$I+}
  176.     IF IORESULT <> 0
  177.       THEN
  178.         BEGIN
  179.           CLOSE(INP);
  180.           WRITELN('ERROR!  Can''t find file ',INPNAME,'!');
  181.           HALT
  182.         END;
  183.   END {Procedure GETINPFIL};
  184.  
  185.  
  186. PROCEDURE GETOUTFIL(VAR OUTNAME: FILESPEC);
  187.  
  188. {  This file gets an output file, either as the second parameter
  189.    on the command line or by requesting it from the user.
  190.  
  191.    Procedure by Harry M. Murphy,  22 February 1986.  }
  192.  
  193.  VAR
  194.    L: INTEGER;
  195.  
  196.   BEGIN
  197.     IF PARAMCOUNT < 2
  198.       THEN
  199.         BEGIN
  200.           WRITE('Output file: ');
  201.           READLN(OUTNAME)
  202.         END
  203.       ELSE
  204.         OUTNAME:=PARAMSTR(2);
  205.     FOR L:=1 TO LENGTH(OUTNAME) DO OUTNAME[L]:=UPCASE(OUTNAME[L]);
  206.     ASSIGN(OUT,OUTNAME);
  207.     {$I-} REWRITE(OUT); {$I-}
  208.     IF IORESULT <> 0
  209.       THEN
  210.         BEGIN
  211.           CLOSE(OUT);
  212.           WRITELN('ERROR!  Can''t open ',OUTNAME,'!');
  213.           HALT
  214.         END
  215.   END {Procedure GETOUTFIL};
  216.  
  217.  
  218. PROCEDURE STRIPATH(VAR NAME: FILESPEC);
  219.  
  220. {  This procedure strips away any leading pathname in the file
  221.    specification, NAME.
  222.  
  223.    Procedure by Harry M. Murphy,  22 February 1986.  }
  224.  
  225. VAR
  226.   L: INTEGER;
  227.  
  228. BEGIN
  229.   L:=LENGTH(NAME);
  230.   IF L > 0
  231.     THEN
  232.       BEGIN
  233.         WHILE (NAME[L]<>'\') AND (L>1) DO L:=L-1;
  234.         IF NAME[L]='\' THEN DELETE(NAME,1,L)
  235.       END
  236. END {Procedure STRIPATH};
  237.  
  238.  
  239. FUNCTION TIME: TIMESTRING;
  240.  
  241. {  This function returns the current clock time as a TimeString
  242.    of 6 bytes, such as:  "19:05h".
  243.  
  244.    Note:  TYPE TIMESTRING = STRING[6];
  245.  
  246.    Procedure adapted from the Turbo Pascal date example by
  247.    Harry M. Murphy,  19 February 1986.  }
  248.  
  249.   TYPE
  250.     REGPAK = RECORD
  251.                AX,BX,CX,DX,BP,SI,DI,DS,ES,FL: INTEGER
  252.              END;
  253.  
  254.   VAR
  255.     H,M,S,T: INTEGER;
  256.     HR:      STRING[2];
  257.     MN:      STRING[2];
  258.     REG:     REGPAK;
  259.  
  260.   BEGIN
  261.     WITH REG DO
  262.       BEGIN
  263.         AX:=$2C00;
  264.         MSDOS(REG);
  265.         H:=HI(CX);
  266.         M:=LO(CX);
  267.         S:=HI(DX);
  268.         T:=LO(DX)
  269.       END;
  270.     IF T > 50 THEN S:=S+1;
  271.     IF S > 30 THEN M:=M+1;
  272.     IF M = 60
  273.       THEN
  274.         BEGIN
  275.           H:=H+1;
  276.           M:=0;
  277.           IF H = 24 THEN H:=0
  278.         END;
  279.     STR(H:2,HR);
  280.     STR(M:2,MN);
  281.     IF MN[1]=' ' THEN MN[1]:='0';
  282.     TIME:=HR+':'+MN+'h'
  283.   END {Function TIME};
  284.  
  285.  
  286. BEGIN  {Program LISTER}
  287.   CLOCK:=TIME;
  288.   TODAY:=DATE;
  289.   LOWVIDEO;
  290.   GETINPFIL(INPNAME);
  291.   GETOUTFIL(OUTNAME);
  292.   WRITELN('    Reading: ',INPNAME);
  293.   WRITELN('    Writing: ',OUTNAME);
  294.   STRIPATH(INPNAME);
  295.   TITLE:='File:  '+INPNAME+'  '+TIME+', '+TODAY+'.';
  296.   NLINE:=MXLINE;
  297.   NPAGE:=0;
  298.   WHILE NOT EOF(INP) DO
  299.     BEGIN
  300.       IF NLINE=MXLINE
  301.         THEN
  302.           BEGIN
  303.             WRITELN(OUT,CHR(12));
  304.             NPAGE:=NPAGE+1;
  305.             WRITELN(OUT,'Page',NPAGE:4,'.   ',TITLE);
  306.             WRITELN(OUT);
  307.             NLINE:=0
  308.           END;
  309.       READLN(INP,INPLINE);
  310.       FILTER(INPLINE,OUTLINE);
  311.       WRITELN(OUT,OUTLINE);
  312.       NLINE:=NLINE+1
  313.     END;
  314.   CLOSE(INP);
  315.   IF (OUTNAME='PRN') AND (NLINE>0) THEN WRITELN(OUT,CHR(12));
  316.   CLOSE(OUT);
  317.   WRITELN(OUTNAME,' is ',NPAGE,' pages long.')
  318. END.
  319.