SJLennon
293 lines
9.3 KiB
RPGLE
293 lines
9.3 KiB
RPGLE
**free
|
|
// ==================================================================
|
|
// PRT: A program that prints a report by printing a line at a time.
|
|
// A convenience routine for simple reports, since O-SPECs are not
|
|
// supported in **FREE RPG programs. It avoids having to create an
|
|
// externally defined printer file.
|
|
// ==================================================================
|
|
// Parms:
|
|
//
|
|
// 1) Char(132) Line text. (Or blank for certain control cases.)
|
|
//
|
|
// 2) Char(10) Control field. Optional.
|
|
// blank Parm 1 contains the line to be printed with
|
|
// single spacing.
|
|
// Line control: How to print Parm 1:
|
|
// S1 Space one line and print.
|
|
// Omitted or blank is the same as S1.
|
|
// S2 Space two lines and print.
|
|
// S3 Space three lines and print.
|
|
// S0 Overprint current line.
|
|
//
|
|
// Definitions - no line are printed with this call.
|
|
// *Hn Define heading line "n", where n is 1 to 9
|
|
// Parm 1 can be all blanks to print a blank line
|
|
// heading line.
|
|
// *Hn:Sx Define heading line "n", where n is 1 to 9 and
|
|
// "x" is the number of lines to space, where
|
|
// x is 0 to 3. S0 will overprint prior line.
|
|
// *Hn:*P:Sx Page number will be printed at the end of this
|
|
// header line.
|
|
//
|
|
// Special control funtions - no line is printed.
|
|
// *NEWPAGE Next line will print on a new page.
|
|
// Parm 1 is ignored.
|
|
|
|
// *CLOSE Close the print file.
|
|
// Parm 1 is ignored.
|
|
|
|
// ==================================================================
|
|
ctl-opt option(*srcstmt: *nodebugio)
|
|
actgrp(*caller)
|
|
main(Prt);
|
|
|
|
// ==================================================================
|
|
// === Program defined print file. ==================================
|
|
dcl-f MYPRT printer(133) usropn oflind(*in99) extfile('MYPRT');
|
|
// Change extfile above to use another *FCFC print file.
|
|
|
|
// === Global Constants =============================================
|
|
dcl-c SP0 'S0'; // Overprint
|
|
dcl-c SP1 'S1'; // Space 1 & print
|
|
dcl-c SP2 'S2'; // Space &2 print
|
|
dcl-c SP3 'S3'; // Space 3 and print
|
|
dcl-c TOP 'SK1'; // Skip to top and print
|
|
dcl-c PAGELINE '*P'; // Header line has page #
|
|
|
|
// ==================================================================
|
|
// ===Prt procedure =================================================
|
|
dcl-proc Prt;
|
|
dcl-pi Prt;
|
|
pi_line char(132); // Line text
|
|
pi_ctl char(10); // Control
|
|
end-pi;
|
|
|
|
// Data structure template for write to printer file
|
|
dcl-ds lines qualified template;
|
|
line char(132) inz;
|
|
isHdr ind inz;
|
|
isPage ind inz;
|
|
Ctl char(2) inz(SP1);
|
|
end-ds;
|
|
|
|
dcl-s j int(10);
|
|
dcl-s pageNumC char(8);
|
|
dcl-s wk_Ctl like(pi_ctl);
|
|
dcl-ds wkLn likeds(lines); // header line with page num
|
|
dcl-s headerSkip ind;
|
|
dcl-s gotHeaders ind;
|
|
dcl-s ctlValues varchar(4) dim(*auto : 3); // Values split from Ctl
|
|
|
|
// Array of Valid Spacing control chars.
|
|
dcl-ds vs qualified;
|
|
s1 char(3) inz(' ');
|
|
*n char(3) inz(SP0);
|
|
*n char(3) inZ(SP1);
|
|
*n char(3) inZ(SP2);
|
|
*n char(3) inZ(SP3);
|
|
validSpaces char(3) dim(5) samepos(s1);
|
|
end-ds;
|
|
|
|
// Static fields: These need to be retained across calls
|
|
dcl-ds hdrs likeds(lines) dim(9) static; // Up to 9 header lines
|
|
dcl-s newPage ind inz(*on) static; // First page is a new page
|
|
dcl-s pageNum packed(5) static inz(1);
|
|
|
|
// === Open printer file ===
|
|
if (not %open(MYPRT));
|
|
open MYPRT;
|
|
endif;
|
|
|
|
// ================================================================
|
|
// === Main processing logic ======================================
|
|
select;
|
|
// A non-printing control function
|
|
when (%parms = 2 and %subst(pi_ctl :1 :1) = '*');
|
|
exsr doControl;
|
|
// Print with a control
|
|
when (%parms = 2);
|
|
wk_Ctl = pi_ctl;
|
|
exsr doPrint;
|
|
// Print without a control - default space 1
|
|
when (%parms = 1);
|
|
wk_Ctl = SP1;
|
|
exsr doPrint;
|
|
other;
|
|
PrtLn('>>1>>>>>> Error: Called with missing/incorrect parmaters':SP1);
|
|
endsl;
|
|
return;
|
|
|
|
// ================================================================
|
|
// === Non-printing control functions =============================
|
|
begsr doControl;
|
|
wk_Ctl = %upper(pi_ctl);
|
|
select;
|
|
// Force a new page if next line won't be a new page
|
|
when (pi_ctl = '*NEWPAGE');
|
|
newPage = *on;
|
|
|
|
// Handle closing the report
|
|
when (pi_ctl = '*CLOSE');
|
|
if (%open(MYPRT));
|
|
close MYPRT;
|
|
endif;
|
|
// Reset static in case called again from same activation group
|
|
reset newPage;
|
|
reset pageNum;
|
|
reset hdrs;
|
|
*inlr =*on;
|
|
|
|
// Save head line definitions
|
|
when (%subst(wk_Ctl :1 :2) = '*H');
|
|
// Split up the control function par,
|
|
%elem(ctlValues) = 0;
|
|
ctlValues = %split(wk_Ctl :':');
|
|
// first one is *Hn, where n is 1=9
|
|
if (%len(%trim(ctlValues(1))) > 3);
|
|
PrtLn('>>2>>>>>> *Hn value too long: ' + %trim(pi_ctl)
|
|
+ '. Missing ":" maybe?' : SP1);
|
|
endif;
|
|
j = %int(%subst(ctlValues(1) : 3 :1));
|
|
hdrs(j).isHdr = *on;
|
|
hdrs(j).line = pi_line;
|
|
// Process 2nd and/or 3rd parms
|
|
select;
|
|
// If it is page control
|
|
when (%elem(ctlValues) = 2);
|
|
if (%trim(ctlValues(2)) = PAGELINE);
|
|
hdrs(j).isPage = *on;
|
|
else;
|
|
// If no, should be spacing
|
|
if (%trim(ctlValues(2)) in vs.validSpaces);
|
|
hdrs(j).Ctl = %trim(ctlValues(2));
|
|
else;
|
|
PrtLn('>>3>>>>>> Space or page value is not valid: ' + %trim(pi_ctl) : SP1);
|
|
endif;
|
|
endif;
|
|
// Process 2nd and 3rd parms
|
|
when (%elem(ctlValues) = 3);
|
|
// second must be paging
|
|
if (%trim(ctlValues(2)) = PAGELINE);
|
|
hdrs(j).isPage = *on;
|
|
else;
|
|
PrtLn('>>4>>>>>> Paging value is not valid: ' + %trim(pi_ctl) : SP1);
|
|
endif;
|
|
// 3rd is spacing
|
|
if (%trim(ctlValues(3)) in vs.validSpaces);
|
|
hdrs(j).Ctl = %trim(ctlValues(3));
|
|
else;
|
|
PrtLn('>5>>>>>>> Space value is not valid: ' + %trim(pi_ctl) : SP1);
|
|
endif;
|
|
endsl;
|
|
|
|
other;
|
|
PrtLn('>>7>>>>> Calling error. Control value not supported: ' + pi_ctl :SP1);
|
|
endsl;
|
|
|
|
endsr;
|
|
|
|
// ================================================================
|
|
// === Print the line =============================================
|
|
begsr doPrint;
|
|
select;
|
|
// Need new page
|
|
when (newPage);
|
|
exsr doHeaders;
|
|
// If heading lines were printed, then print the line with
|
|
// the specified spacing, else skip to a new page and print.
|
|
If (gotHeaders);
|
|
PrtLn(pi_Line : wk_Ctl);
|
|
else;
|
|
PrtLn(pi_line : TOP);
|
|
newPage = *off;
|
|
endif;
|
|
// Just print the line
|
|
other;
|
|
PrtLn(pi_Line : wk_Ctl);
|
|
endsl;
|
|
|
|
// === If overflow, remember for next line ===
|
|
if (*in99 = *on);
|
|
newPage = *on;
|
|
*in99 = *off;
|
|
endif;
|
|
|
|
endsr ;
|
|
|
|
// ================================================================
|
|
// === Print Headers ==============================================
|
|
begsr doHeaders;
|
|
if (newPage);
|
|
// Print the Heading lines and page number.
|
|
|
|
// No defined headers is possible.
|
|
gotHeaders = *off;
|
|
// Set up character page number
|
|
pageNumC = 'Page +++';
|
|
if (pageNum <= 999);
|
|
pageNumC = 'Page ' + %char(pageNum);
|
|
endif;
|
|
// Loop through header definitions, printing those defined
|
|
for j = 1 to 9;
|
|
if (hdrs(j).isHdr);
|
|
gotHeaders = *on;
|
|
wkLn.line = hdrs(j).line;
|
|
if (hdrs(j).isPage);
|
|
%subst(wkLn.line :%len(wkLn.line) - %len(pageNumC) ) = pageNumC;
|
|
endif;
|
|
// First header line, and only the first, has to be a skip to top
|
|
if (headerSkip = *off);
|
|
PrtLn(wkLn.line : TOP);
|
|
headerSkip = *on;
|
|
else;
|
|
PrtLn(wkLn.line : hdrs(j).Ctl);
|
|
endif;
|
|
endif;
|
|
endfor;
|
|
|
|
headerSkip = *off;
|
|
newPage = *off;
|
|
pageNum += 1;
|
|
endif;
|
|
endsr ;
|
|
|
|
end-proc Prt;
|
|
|
|
// ==================================================================
|
|
// === Procedure to print a line ====================================
|
|
dcl-proc PrtLn;
|
|
dcl-pi PrtLn;
|
|
pi_Line char(132) const;
|
|
pi_Ctl char(10) const;
|
|
end-pi;
|
|
dcl-ds line len(133) qualified;
|
|
end-ds;
|
|
// FCFC Definitions for printer file
|
|
dcl-s SK1 char(1) inz('1'); // skip to channel 1
|
|
dcl-s S1 char(1) inz(' '); // space 1 and print
|
|
dcl-s S2 char(1) inz('0'); // spacw 2 and print
|
|
dcl-s S3 char(1) inz('-'); // Space 3 and print
|
|
dcl-s S0 char(1) inz('+'); // Overprint (space 0)
|
|
|
|
dcl-s fcFC char(1);
|
|
|
|
select;
|
|
when (pi_Ctl = SP1 or pi_Ctl = ' ');
|
|
fcFC = S1;
|
|
when (pi_Ctl = SP2);
|
|
fcFC = S2;
|
|
when (pi_Ctl = SP3);
|
|
fcFC = S3;
|
|
when (pi_Ctl = SP0);
|
|
fcFC = S0;
|
|
when (pi_Ctl = TOP);
|
|
fcFC = SK1;
|
|
other;
|
|
PrtLn('>>>>>>>> Invalid spacing control: ' + pi_Ctl :SP1);
|
|
endsl;
|
|
|
|
// Write must be from a data structure
|
|
line = fcFC + pi_Line;
|
|
write MYPRT line;
|
|
end-proc PrtLn;
|