home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PASUTIL1.ZIP / PRINTER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  10.2 KB  |  405 lines
  1. {$TITLE:'MULTIPLE FILE PRINT SPOOLER     ---       VERSION 1.1 '}
  2. {$LINESIZE:131}
  3. {$PAGESIZE:58}
  4. {$LIST+}
  5. {$WARN-}
  6. {$SYMTAB+}
  7. {$DEBUG+}
  8. {$LINE+}
  9. {-------------------------------------------------------------}
  10. {                                                             }
  11. {      I B M / P C   M U L T I - F I L E     S P O O L E R    }
  12. {                                                             }
  13. {                                                             }
  14. {                                                             }
  15. {   THIS PROGRAM ALLOWS SEVERAL DATASETS TO BE "STACKED"      }
  16. {   FOR PRINTING.                                             }
  17. {                                                             }
  18. {   CONTROLS FOR PAGE LENGTH, COLUMN RASTER, AND PAGE         }
  19. {   NUMBERING ARE PROVIDED.                                   }
  20. {                                                             }
  21. {                                                             }
  22. {-------------------------------------------------------------}
  23. {$PAGE+}
  24.  
  25. PROGRAM PRINTER ( OPTIONS) ;
  26.  
  27. CONST 
  28.       MAXPAGESIZE       = 88 ;
  29.       MINPAGESIZE       = 10 ;
  30.       MAXLINESIZE       = 132 ;
  31.       MINLINESIZE       = 40  ;
  32.       DSMAX             = 16 ;
  33.       PGN               = 'Page ' ;
  34.       DSN_EMPTY         = '*             ' ;
  35.  
  36.   RR1 = '1...5....0....5....0....5....0....5....0....5....0....5....0';
  37.   RR2 = '....5....0....5....0';
  38.   RR3 = '....5....0....5....0....5....0....5....0....5....0..';
  39.   RA1 = '0        1         2         3         4         5         6';
  40.   RA2 = '         7         8';
  41.   RA3 = '         9         0         1         2         3  ';
  42.   RB1 = '                                                            ';
  43.   RB2 = '                    ';
  44.   RB3 = '                   1         1         1         1  ';
  45.       RAST32_oh  = RB1 * RB2* RB3 ;
  46.  
  47.       RAST80_ONE = RA1 * RA2 ;
  48.       RAST80_TWO = RR1 * RR2 ;
  49.       RAST32_ONE = RA1 * RA2* RA3 ;
  50.       RAST32_TWO = RR1 * RR2* RR3 ;
  51.  
  52.  
  53. VAR 
  54.     DSNUM,
  55.     IKF,
  56.     IHC,
  57.     IKJ,
  58.     PAGESIZE,         {actual pagesize}
  59.     LINESIZE,         {actual linesize MUST be 80 or 132}
  60.     PAGECOUNT,
  61.     LINECOUNT         :  INTEGER  ;
  62.     LPI8,
  63.     PAGENUM,
  64.     SEQUENCE,
  65.     PRT_TITLE,
  66.     SHOW_RASTER,
  67.     HEADING           :  BOOLEAN   ;
  68.     P_DATE            :  STRING(8) ;
  69.     P_TIME            :  STRING(8) ;
  70.     P_TITL            :  LSTRING(80) ;
  71.     INPUT_LINE        :  LSTRING(255) ;
  72.     OUTPUT_LINE       :  LSTRING(255) ;
  73.     PRINTER           :  TEXT ;
  74.     INFILES           :  TEXT ;
  75.     OPTIONS           :  LSTRING(66) ;
  76.     DSNAME            :  LSTRING(14) ;
  77.     DATASET           :  ARRAY [1..DSMAX] OF STRING(14) ;
  78.     TITLE             :  ARRAY [1..DSMAX] OF LSTRING(80)  ;
  79.  
  80. {$INCLUDE:'B:INDEX.P'}
  81. {$INCLUDE:'B:PARSE.P'}
  82. {$INCLUDE:'B:DSNAME.P'}
  83. PROCEDURE GETDSN ; FORWARD ;
  84.  
  85. PROCEDURE FILEDSN;
  86. FORWARD;
  87.  
  88.  PROCEDURE TIME(VAR S: STRING);
  89. EXTERNAL;
  90.  
  91.  PROCEDURE DATE(VAR S: STRING);
  92. EXTERNAL;
  93.  
  94. PROCEDURE INITIALIZE;
  95. BEGIN
  96.   WRITE(PRINTER,CHR(27),'@',CHR(27),'5',CHR(27),'C',CHR(PAGESIZE));
  97.   IF LINESIZE = 132
  98.     THEN
  99.       WRITE(PRINTER,CHR(27),'P');
  100.   IF LINESIZE = 80
  101.     THEN
  102.       WRITE(PRINTER,CHR(27),'Q');
  103.   IF LPI8
  104.     THEN
  105.       WRITE(PRINTER,CHR(27),'0')
  106.      ELSE
  107.        WRITE(PRINTER,CHR(27),'2');
  108.   WRITE(PRINTER,CHR(7)) ;
  109.  
  110.   IF (OPTIONS  = ' ') OR (OPTIONS = '*') 
  111.     THEN
  112.       BEGIN
  113.       OPTIONS := NULL ;
  114.       DSNAME := NULL ;
  115.       END; {BEGIN-OPTIONS empty}
  116.  
  117.   IF DSNAME.LEN = 0
  118.     THEN
  119.       GETDSN
  120.     ELSE
  121.       FILEDSN;
  122.   IF (PRT_TITLE) or (PAGENUM) or (SHOW_RASTER) or (SEQUENCE)
  123.      THEN HEADING := TRUE ;
  124.   ELSE HEADING := FALSE ;
  125.  
  126.   IF HEADING THEN 
  127.      BEGIN
  128.       LINECOUNT := PAGESIZE - 3 ;
  129.      IF PRT_TITLE THEN
  130.       LINECOUNT := LINECOUNT - 1 ;
  131.      IF PAGENUM THEN
  132.       LINECOUNT := LINECOUNT - 2 ;
  133.      IF SHOW_RASTER THEN
  134.       IF LINESIZE = 80 
  135.          THEN LINECOUNT := LINECOUNT - 4 ;
  136.       ELSE LINECOUNT := LINECOUNT - 6 ;
  137.   END; {HEADING-BEGIN}
  138.  
  139. END; {INITIALIZE}
  140.  
  141.  
  142. PROCEDURE FILEDSN;
  143.  
  144. VAR 
  145.     I     :   INTEGER;
  146.     DSNS  :   TEXT ;
  147.     INREC :   LSTRING(255);
  148.     FNAME :    STRING(14) ;
  149. BEGIN
  150.    ASSIGN(DSNS,DSNAME);
  151.    RESET(DSNS);
  152.    I := 1 ;
  153.    REPEAT
  154.      READLN(DSNS,INREC);
  155.      IKJ := INDEX(INREC,'/');
  156.      IF IKJ <> 0
  157.        THEN
  158.          BEGIN
  159.            {TITLE CAPTURE GOES HERE }
  160.          END; {I <> 0 }
  161.      IKJ := INDEX(INREC,' ');
  162.      GET_DSNAME(FNAME,INREC);
  163.      IF IKJ > 14
  164.        THEN
  165.          BEGIN
  166.            WRITELN('Error in Filename Format in',DSNAME);
  167.            ABORT('EXECUTION HALTED',013,018);
  168.          END; {IKJ>14}
  169.      I := I + 1 ;
  170.      DATASET[I] := FNAME;
  171.   UNTIL EOF(DSNS);
  172. END; {FILEDSN}
  173.  
  174. PROCEDURE DEFAULTS;
  175.  
  176. VAR 
  177.     I    : INTEGER ;
  178. BEGIN
  179.    PAGESIZE     :=   66 ;
  180.    LINESIZE     :=   MAXLINESIZE ;
  181.    LPI8         :=   FALSE ;
  182.    PAGENUM      :=   TRUE ;
  183.    PRT_TITLE    :=   FALSE ;
  184.    SHOW_RASTER  :=   TRUE  ;
  185.    HEADING      :=   TRUE ;
  186.    PAGECOUNT    :=   1 ;
  187.    LINECOUNT    :=   1 ;
  188.    FOR I := 1 TO DSMAX DO
  189.      DATASET[I] := DSN_EMPTY ;
  190. END; {DEFAULTS}
  191.  
  192. PROCEDURE GET_TITLE;
  193.  
  194.  VAR 
  195.      I        :  INTEGER;
  196.      REPLY1    :  CHAR ;
  197. BEGIN
  198.   WRITE('TITLE PROMPT FOR EACH DATASET (Y/N) ?') ;
  199.   READLN(REPLY1);
  200.   IF (REPLY1 = 'Y') OR (REPLY1 = 'y')
  201.     THEN
  202.       BEGIN
  203.         PRT_TITLE := TRUE ;
  204.         FOR I := 1 TO DSNUM DO
  205.           BEGIN
  206.             WRITELN('DSN#':4,I:2,' = [':4,DATASET[I]:14);
  207.             WRITE('TITLE [79] =');
  208.             READLN(TITLE[I]);
  209.           END; {FOR I -DSMAX}
  210.       END; {REPLY=Y}
  211. END; {TITLE}
  212.  
  213. PROCEDURE TRUNK (VAR INSTR: LSTRING; VAR OUTSTR: LSTRING) ;
  214.  
  215.   VAR 
  216.       II,X,Y,Z : INTEGER;
  217.       U     : BYTE ;
  218.   BEGIN   {TRUNK}
  219.  
  220.           U := INSTR.LEN ;
  221.           X := ORD(U) ;
  222.           IF  X > LINESIZE
  223.             THEN
  224.               Y := LINESIZE
  225.             ELSE
  226.               Y := X ;
  227.           Z := 0 ;
  228.           II := Y ;
  229.           REPEAT
  230.             IF INSTR[II] = ' '
  231.               THEN
  232.                 Z := 256
  233.               ELSE
  234.                 Z := II ;
  235.             II := II - 1 ;
  236.           UNTIL (Z <> 256) ;
  237.           FOR II := 1 TO Z DO
  238.             OUTSTR[II] := INSTR[II] ;
  239.           OUTSTR.LEN := WRD(Z) ;
  240.   END;  {TRUNK}
  241.  
  242.     PROCEDURE GETDSN;
  243.  
  244.    VAR 
  245.        I       :  INTEGER ;
  246.    BEGIN
  247.                     FOR I := 1 TO DSMAX DO
  248.                       BEGIN
  249.                         WRITE('Dsname:') ;
  250.                         READLN(DATASET[I]);
  251.                         IF DATASET[I] = DSN_EMPTY
  252.                           THEN
  253.                             BREAK ;
  254.                       END; {GETDSN}
  255.                     DSNUM := I - 1 ;
  256.       END; {GETDSN}
  257.  
  258. PROCEDURE PRINTDSN (VAR DSN : STRING ) ;
  259.  
  260. VAR 
  261.     J           : INTEGER  ;
  262.     CONTROL   :   BOOLEAN  ;
  263.  
  264. PROCEDURE PAGENATE ;
  265.  
  266. BEGIN
  267. IF J = 255 THEN ;
  268.  ELSE
  269.   BEGIN
  270.  
  271.  if not(SHOW_RASTER) THEN  ;
  272.    
  273.  ELSE
  274.     BEGIN
  275.       WRITELN(PRINTER) ;
  276.       IF LINESIZE = 80 THEN
  277.         BEGIN
  278.            WRITELN(PRINTER,RAST80_TWO);
  279.            WRITELN(PRINTER,RAST80_ONE);
  280.         END;  {RASTER := 80}
  281.       ELSE
  282.         BEGIN
  283.            WRITELN(PRINTER,RAST32_TWO);
  284.            WRITELN(PRINTER,RAST32_ONE);
  285.            WRITELN(PRINTER,RAST32_OH) ;
  286.         END;  {RASTER := 132}
  287.      END; {ELSE-SHWO_RASTER}
  288.   END; {J = 255}
  289.  
  290.    WRITE(PRINTER,CHR(12));
  291.    IF NOT (PRT_TITLE)
  292.      THEN
  293.                       ;
  294.      ELSE
  295.        BEGIN
  296.          IF LINESIZE = 80
  297.            THEN
  298.              WRITELN(PRINTER,P_TITL)
  299.            ELSE
  300.              WRITELN(PRINTER,P_TITL:104);
  301.        END; {ELSE OF NOT PRT_TITLE}
  302.    IF LINESIZE = 132
  303.      THEN
  304.        BEGIN
  305.          WRITE(PRINTER,'SPOOL - V1.1 ':12,'  ':100,P_DATE:8,'  ':4) ;
  306.          WRITELN(PRINTER,PGN:5,PAGECOUNT:3) ;
  307.        END; {BEGIN =132}
  308.   ELSE
  309.      BEGIN
  310.         WRITE(PRINTER,'SPOOL - V1.1 ':12,'  ':48,P_DATE:8,'  ':4) ;
  311.         WRITELN(PRINTER,PGN:5,PAGECOUNT:3) ;
  312.      END; {BEGIN := 80}
  313.  
  314.   IF NOT (SHOW_RASTER)
  315.     THEN
  316.                       ;
  317.     ELSE
  318.       BEGIN
  319.         WRITELN(PRINTER) ;
  320.         IF LINESIZE = 80
  321.           THEN
  322.             BEGIN
  323.               WRITELN(PRINTER,RAST80_ONE);
  324.               WRITELN(PRINTER,RAST80_TWO);
  325.             END; {RASTER := 80}
  326.       ELSE
  327.         BEGIN
  328.           WRITELN(PRINTER,RAST32_OH) ;
  329.           WRITELN(PRINTER,RAST32_ONE);
  330.           WRITELN(PRINTER,RAST32_TWO);
  331.         END; {RASTER := 132}
  332.  
  333.      END;  {BEGIN -SHOW_RASTER}
  334.  
  335.    PAGECOUNT := PAGECOUNT + 1 ;
  336.  END; {PAGENATE}
  337.  
  338. BEGIN {PRINTDSN}
  339.   ASSIGN(INFILES,DSN);
  340.   RESET(INFILES);
  341.   WRITELN('Printing Dataset [',DSN,'] ') ;
  342.   J := 255;
  343.   REPEAT
  344.   IF (HEADING) THEN
  345.      BEGIN
  346.      IF J >= LINECOUNT
  347.        THEN
  348.          BEGIN
  349.            PAGENATE ;
  350.            j := 0 ;
  351.          END; {J GT PAGESIZE}
  352.    END;  { IF HEADING}
  353.  
  354.     READLN(INFILES,INPUT_LINE);
  355.     TRUNK(INPUT_LINE,OUTPUT_LINE);
  356.     WRITELN(PRINTER,OUTPUT_LINE);
  357.      J := J + 1 ;
  358.   UNTIL EOF(INFILES);
  359.    IF (HEADING) THEN
  360.       BEGIN 
  361.   IKJ = LINECOUNT  - J ;
  362.   IKJ := IKJ - 1 ;
  363.   FOR IKF := 1 TO IKJ DO 
  364.       WRITELN(PRINTER) ;
  365.   { PRINT LAST BOTTOM RASTER }
  366.   IF NOT (SHOW_RASTER) THEN  ;
  367.    ELSE
  368.      BEGIN
  369.        IF LINESIZE = 80 THEN
  370.           BEGIN
  371.             WRITELN(PRINTER,RAST80_TWO) ;
  372.             WRITELN(PRINTER,RAST80_ONE) ;
  373.           END; {LINE := 80}
  374.        ELSE 
  375.           BEGIN
  376.             WRITELN(PRINTER,RAST32_TWO);
  377.             WRITELN(PRINTER,RAST32_ONE) ;
  378.             WRITELN(PRINTER,RAST32_OH)  ;
  379.           END; {LINE := 132}
  380.      END; {ELSE - SHOW_RASTER}
  381.    end; { IF HEADING}
  382.  
  383.   CLOSE(INFILES);
  384. END; {PRINTDSN}
  385. {                                                                     }
  386. {  S T A R T    O F    M A I N    L I N E     C O D E                 }
  387. {                                                                     }
  388. BEGIN {PRINTER}
  389.   ASSIGN(PRINTER,'LPT1:') ;
  390.   REWRITE(PRINTER);
  391.   DEFAULTS ;
  392.   INITIALIZE ;
  393.   GET_TITLE ;
  394.   FOR IHC := 1 TO DSNUM DO
  395.     BEGIN
  396.       PAGECOUNT := 1 ;
  397.       TIME(P_TIME);
  398.       DATE(P_DATE) ;
  399.       IF PRT_TITLE
  400.         THEN
  401.           P_TITL := TITLE[IHC] ;
  402.       PRINTDSN(DATASET[IHC]) ;
  403.     END; {IHC FOR}
  404. END. {PRINTER}
  405.