REBOL [ Title: "Printing module using HTML" Purpose: {A COBOL-like method for printing basic text-oriented business reports in an html file with markup such that we can get proper page breaks.} ] ;; [---------------------------------------------------------------------------] ;; [ This is a module for primitive printing. ] ;; [ It puts pre-formatted lines of text into an html file that includes ] ;; [ markup such that if the html file is printed then requested page ] ;; [ breaks will ge made correctly. ] ;; [---------------------------------------------------------------------------] ;; [---------------------------------------------------------------------------] ;; [ These items are the ones that would have to adjusted for a particular ] ;; [ installation. They could be pulled out into a configuration file ] ;; [---------------------------------------------------------------------------] HTMPRT-INSTALLATION-NAME: "INFORMATION SYSTEMS" HTMPRT-FILE-ID: %printfile.html HTMPRT-REPORT-ID: "" ;; [---------------------------------------------------------------------------] ;; [ "Printing" is going to mean appending a print line to the end of ] ;; [ this big string. When we "close" the print "file," this big string ] ;; [ will be written to a file. Actually putting it on paper will be done ] ;; [ by reading the file with a web browser and using the browser to print. ] ;; [---------------------------------------------------------------------------] HTMPRT-FILE: "" ;; [---------------------------------------------------------------------------] ;; [ Here are some other important items, defined here so we can keep ] ;; [ track of them. ] ;; [---------------------------------------------------------------------------] HTMPRT-PAGE-SIZE: 57 HTMPRT-LINE-COUNT: 0 ;; [---------------------------------------------------------------------------] ;; [ This is the html markup we will need to make this work. ] ;; [---------------------------------------------------------------------------] HTMPRT-HEAD-DOC: { <% HTMPRT-REPORT-ID %> } HTMPRT-HEAD-FIRSTPAGE: {

<% HTMPRT-INSTALLATION-NAME %>

}

HTMPRT-HEAD-NEXTPAGE: {

<% HTMPRT-INSTALLATION-NAME %>

}

HTMPRT-FOOT-DOC: {
} ;; [---------------------------------------------------------------------------] ;; [ This procedure "opens" the print "file," which means we will clear ] ;; [ out the string and put some initial printer control characters ] ;; [ into it. In this module, "control characters" means the html markup ] ;; [ to cause the proper page break before each new heading when we print. ] ;; [---------------------------------------------------------------------------] HTMPRT-OPEN: does [ HTMPRT-FILE: copy "" append HTMPRT-FILE build-markup HTMPRT-HEAD-DOC append HTMPRT-FILE build-markup HTMPRT-HEAD-FIRSTPAGE HTMPRT-LINE-COUNT: 0 ] ;; [---------------------------------------------------------------------------] ;; [ This procedure "closes" the print "file," which means we will ] ;; [ put the appropriate closing markukp at the end of the string and ] ;; [ write it to a file. ] ;; [---------------------------------------------------------------------------] HTMPRT-CLOSE: does [ append HTMPRT-FILE build-markup HTMPRT-FOOT-DOC write HTMPRT-FILE-ID HTMPRT-FILE ] ;; [---------------------------------------------------------------------------] ;; [ This procedure causes a page skip by adding a heading line with the ] ;; [ "break" class so that if we print the page, the browser will eject ] ;; [ a page. ] ;; [---------------------------------------------------------------------------] HTMPRT-EJECT: does [ append HTMPRT-FILE build-markup HTMPRT-HEAD-NEXTPAGE HTMPRT-LINE-COUNT: 0 ] ;; [---------------------------------------------------------------------------] ;; [ This procedure "prints" a line passed to it, which means we will ] ;; [ append the passed line to the file, and add a newline. ] ;; [ The refinement of "double" puts an extra newline at the end for ] ;; [ double spacing. ] ;; [---------------------------------------------------------------------------] HTMPRT-PRINT: func [ HTMPRT-PRINT-LINE /DOUBLE ] [ append HTMPRT-FILE HTMPRT-PRINT-LINE append HTMPRT-FILE newline HTMPRT-LINE-COUNT: HTMPRT-LINE-COUNT + 1 if DOUBLE [ append HTMPRT-FILE rejoin [
newline] HTMPRT-LINE-COUNT: HTMPRT-LINE-COUNT + 1 ] ] ;; [---------------------------------------------------------------------------] ;; [ The procedures below use the procedures above for printing in a ] ;; [ classic COBOL manner. They print headings automatically, checks for ] ;; [ page skips, and so on. ] ;; [ The caller of this module should "do" it early in the program to define ] ;; [ the items below, and then set the following items to desired values: ] ;; [ LP-PROGRAM: Name of the program making the report. ] ;; [ LP-REPORT: 50-character report description. ] ;; [ LP-SUBTITLE: not used until we figure out how to center it. ] ;; [ What these procedures are going to give you is a report of text lines ] ;; [ in a fixed-width font, like the line printer of the COBOL days. ] ;; [---------------------------------------------------------------------------] ;; -- Items to be loaded before first use HTMPRT-LP-PROGRAM: "" HTMPRT-LP-REPORT: "" HTMPRT-LP-SUBTITLE: "" HTMPRT-LP-PAGE-COUNT: 1 HTMPRT-LP-TITLE: copy HTMPRT-INSTALLATION-NAME HTMPRT-LP-HEADING-1: "" HTMPRT-LP-HEADING-2: "" HTMPRT-LP-USER-HEADING-1: "" HTMPRT-LP-USER-HEADING-2: "" HTMPRT-LP-USER-HEADING-3: "" HTMPRT-LP-USER-HEADING-COUNT: 0 HTMPRT-LP-PROG-LGH: 0 HTMPRT-LP-REPT-LGH: 0 HTMPRT-LP-PROG-20: "" HTMPRT-LP-REPT-50: "" ;; -- Helper functions for the main printing functions HTMPRT-SUBSTRING: func [ "Return a substring from the start position to the end position" INPUT-STRING [series!] "Full input string" START-POS [number!] "Starting position of substring" END-POS [number!] "Ending position of substring" ] [ if END-POS = -1 [END-POS: length? INPUT-STRING] return skip (copy/part INPUT-STRING END-POS) (START-POS - 1) ] HTMPRT-FILLER: func [ "Return a string of a given number of spaces" SPACE-COUNT [integer!] /local FILLER ] [ FILLER: copy "" loop SPACE-COUNT [ append FILLER " " ] return FILLER ] HTMPRT-SPACEFILL: func [ "Left justify a string, pad with spaces to specified length" INPUT-STRING FINAL-LENGTH /local TRIMMED-STRING LENGTH-OF-TRIMMED-STRING NUMBER-OF-SPACES-TO-ADD FINAL-PADDED-STRING ] [ TRIMMED-STRING: copy "" TRIMMED-STRING: trim INPUT-STRING LENGTH-OF-TRIMMED-STRING: length? TRIMMED-STRING either (LENGTH-OF-TRIMMED-STRING < FINAL-LENGTH) [ NUMBER-OF-SPACES-TO-ADD: (FINAL-LENGTH - LENGTH-OF-TRIMMED-STRING) FINAL-PADDED-STRING: copy TRIMMED-STRING loop NUMBER-OF-SPACES-TO-ADD [ append FINAL-PADDED-STRING " " ] ] [ FINAL-PADDED-STRING: COPY "" FINAL-PADDED-STRING: HTMPRT-SUBSTRING TRIMMED-STRING 1 FINAL-LENGTH ] ] ;; -- Main printing functions HTMPRT-LP-PRINT-USER-HEADINGS: does [ HTMPRT-LP-USER-HEADING-COUNT: 0 if (HTMPRT-LP-USER-HEADING-1 <> "") [ HTMPRT-PRINT HTMPRT-LP-USER-HEADING-1 HTMPRT-LP-USER-HEADING-COUNT: HTMPRT-LP-USER-HEADING-COUNT + 1 ] if (HTMPRT-LP-USER-HEADING-2 <> "") [ HTMPRT-PRINT HTMPRT-LP-USER-HEADING-2 HTMPRT-LP-USER-HEADING-COUNT: HTMPRT-LP-USER-HEADING-COUNT + 1 ] if (HTMPRT-LP-USER-HEADING-3 <> "") [ HTMPRT-PRINT HTMPRT-LP-USER-HEADING-3 HTMPRT-LP-USER-HEADING-COUNT: HTMPRT-LP-USER-HEADING-COUNT + 1 ] if (HTMPRT-LP-USER-HEADING-COUNT > 0) [ HTMPRT-PRINT "" ] ] HTMPRT-LP-OPEN: does [ HTMPRT-OPEN HTMPRT-LP-PAGE-COUNT: 1 HTMPRT-LP-PROG-LGH: length? HTMPRT-LP-PROGRAM either (HTMPRT-LP-PROG-LGH >= 20) [ HTMPRT-LP-PROG-20: HTMPRT-SUBSTRING HTMPRT-LP-PROGRAM 1 20 ] [ HTMPRT-LP-PROG-20: HTMPRT-SPACEFILL HTMPRT-LP-PROGRAM 20 ] HTMPRT-LP-REPT-LGH: length? HTMPRT-LP-REPORT either (HTMPRT-LP-REPT-LGH >= 50) [ HTMPRT-LP-REPT-50: HTMPRT-SUBSTRING HTMPRT-LP-REPORT 1 50 ] [ HTMPRT-LP-REPT-50: HTMPRT-SPACEFILL HTMPRT-LP-REPORT 50 ] HTMPRT-LP-HEADING-1: rejoin [ HTMPRT-LP-PROG-20 HTMPRT-FILLER 43 HTMPRT-LP-TITLE HTMPRT-FILLER 52 now/date ] HTMPRT-LP-HEADING-2: rejoin [ HTMPRT-LP-REPT-50 HTMPRT-FILLER 13 HTMPRT-FILLER 39 ;; subtitle, eventually HTMPRT-FILLER 52 "Page " to-string HTMPRT-LP-PAGE-COUNT ] HTMPRT-PRINT HTMPRT-LP-HEADING-1 HTMPRT-PRINT/DOUBLE HTMPRT-LP-HEADING-2 HTMPRT-LP-PRINT-USER-HEADINGS ] HTMPRT-LP-CLOSE: does [ HTMPRT-CLOSE ] HTMPRT-LP-PRINT: func [ HTMPRT-LP-PRINT-LINE /DOUBLE ;; not used at this time ] [ if (HTMPRT-LINE-COUNT >= HTMPRT-PAGE-SIZE) [ HTMPRT-LINE-COUNT: 0 HTMPRT-LP-PAGE-COUNT: HTMPRT-LP-PAGE-COUNT + 1 HTMPRT-LP-HEADING-2: copy "" HTMPRT-LP-HEADING-2: rejoin [ HTMPRT-LP-REPT-50 HTMPRT-FILLER 13 HTMPRT-FILLER 39 ;; subtitle, eventually HTMPRT-FILLER 52 "Page " to-string HTMPRT-LP-PAGE-COUNT ] HTMPRT-EJECT HTMPRT-PRINT HTMPRT-LP-HEADING-1 HTMPRT-PRINT/DOUBLE HTMPRT-LP-HEADING-2 HTMPRT-LP-PRINT-USER-HEADINGS ] HTMPRT-PRINT HTMPRT-LP-PRINT-LINE ]