%!PS-Adobe-3.1 % PostScript "==d", "printd" and "pstackd" diversion demo print_divert1.psl % ========================================================================= % Copyright c 2019 by Don Lancaster & Synergetics, Box 809, Thatcher, AZ, 85552 % (928) 428-4073 Email: don@tinaja.com Website: http://www.tinaja.com % Consulting services available http://www.tinaja.com/info01.html % All commercial rights and all electronic media rights ~fully~ reserved. % Linking usually welcome. Reposting expressly forbidden. Version 1.1 % "Log" outputs do not seem to be immediately available on Google Drive. % This demo diverts "==d", "pstackd", and "printd" commands to add appending % gridded yellow pages to the end of an otherwise functional .PDF screen output. % This simplified demo works best if all "==d", "pstackd", or all "print" % commands are placed at the end of the original document code. It does % not presently include error trapping, which is available in a separate demo. % Only the /print command is diverted and then only when requested. There are % no sever side mods needed or used. Nor any systemdict changes. % Note: An extremely flexible and versatile text formatter is available in % the full Gonzo Utilities if prepended or prerun. Only a simple two font % width and return" page formatter is used instead in this particular demo. % A gonzo tutorial is found at https://www.tinaja.com/glib/gonzotut.pdf % A PostScript Reference Manual at % https://www.adobe.com/content/dam/acom/en/devnet/actionscript/articles/PLRM.pdf % A PostScript Video at https://www.youtube.com/watch?v=C_tWW560tAE % Send the .psl file to Google Drive, to Acrobat Distiller with command line % //acrodist /F or to host GhostScript formatted for multiple pages. % ////// Extracted Gonzo Utilities ////// /mt {moveto} def /li {lineto} def /rm {rmoveto} def /rl {rlineto} def /ct {curveto} def /cp {closepath} def /f {fill} def /pd {0 exch neg rl} def /pr { 0 rl} def /pu {0 exch rl} def /pl {neg 0 rl} def /line1 {.06 dup setlinewidth 5 mul /erase exch def} def /line2 {.12 dup setlinewidth 5 mul /erase exch def} def /line3 {.18 dup setlinewidth 5 mul /erase exch def} def /thingridlines {0} def /setgrid { /blocksize exch def translate % simplified blocksize dup scale} def /showgrid {gsave /vblocks exch def /hblocks exch def thingridlines setlinewidth [{0 0 moveto 0 vblocks rlineto stroke} 1 hblocks 1 add] xrpt [{0 0 moveto hblocks 0 rlineto stroke} 1 vblocks 1 add] yrpt fatterborder { gsave newpath 0 0.96 blocksize div dtransform round idtransform setlinewidth pop 2 setlinecap 0 0 moveto hblocks 0 rlineto 0 vblocks rlineto hblocks neg 0 rlineto closepath stroke grestore} if fat5 { gsave newpath 0 0.48 blocksize div dtransform round idtransform setlinewidth pop mark {5 0 moveto 0 vblocks rlineto stroke} 5 hblocks 5 div cvi] xrpt mark {0 5 moveto hblocks 0 rlineto stroke} 5 vblocks 5 div cvi] yrpt grestore} if fatter10 { gsave 24 setwebtint % emphasize here newpath 0 0.96 blocksize div dtransform round idtransform setlinewidth pop mark {10 0 moveto 0 vblocks rlineto stroke} 10 hblocks 10 div cvi] xrpt mark {0 10 moveto hblocks 0 rlineto stroke} 10 vblocks 10 div cvi] yrpt grestore} if grestore} def /fatterborder {true } store /fat5 {true} store /fatter10 { true} store /showdots { false } store /dot { showdots { currentpoint newpath 0.150 0 360 arc fill }if} def /mdot { mt dot} def /random {rand 65536 div 32768 div mul cvi} def % as in -- 6 random -- /gonzofont {dup type cvlit /arraytype eq {exch findfont exch makefont} {exch findfont exch scalefont} ifelse setfont mark /spacewidth ( ) stringwidth pop /cstretch cvx /add cvx /sstretch cvx /add cvx /def cvx currentfont dup backcdict exch (F?) dup 1 14 index (xxxxx) cvs 4 get put put /setfont cvx ] cvx def} def 50 dict /backcdict exch def % used "backwards" during compiling to get % fontname given the "made" font dictionary /cstretch 0 store /sstretch 0 store % repeats [ proc distance trips] xrpt /xrpt{gsave aload pop /trips exch def /dist exch def /rproc exch def trips { gsave rproc grestore dist 0 translate } repeat grestore} def /yrpt{gsave aload pop /trips exch def /dist exch def /rproc exch def trips { gsave rproc grestore 0 dist translate } repeat grestore} def % timing utilities. use stopwatchon and stopwatchoff for simple % one shot timing. For multiple time totals, use resettimer % starttimer stoptimer ... starttimer stoptimer reporttimer /mergestr {2 copy length exch length add string dup dup 4 3 roll 4 index length exch putinterval 3 1 roll exch 0 exch putinterval} def /stopwatchoff {stoptimer reporttimer} def % for single shots /stopwatchon {resettimer starttimer} def % for single shots /reporttimer {mytime 1000 div (\rElapsed time: ) print 20 string cvs print ( seconds.\r) print flush} def % to host /resettimer {/mytime 0 def} def % reset timer /starttimer {usertime /mytimenow exch def} def % add to time so far /stoptimer {usertime mytimenow sub /mytime exch mytime add def} def % for multiple timing intervals % curvetrace - creates a smooth curved path from a data point list. % enter with currentpoint set and absolute array. % 0 0 as initial data appends path; any other values % creates new path /curvetrace {/curvelist exch def tension 0 eq {/tension .000001 def} if curvelist length 3 div 1 sub cvi /#triads exch def /ptr 0 def firstpoint morepoint} def /tension 2.83301 def % default value for best fit SLIGHTLY REVISED! /showtick false def % don't show points /ticklen 15 def % length of ticks /tickhead ticklen 4 div def /prvx { curvelist ptr 3 sub get } def /curx { curvelist ptr get } def /prvy { curvelist ptr 2 sub get } def /cury { curvelist ptr 1 add get } def /prva { curvelist ptr 1 sub get } def /cura { curvelist ptr 2 add get 180 sub} def /showtic1 { showtick true eq {gsave currentpoint newpath translate cura 180 add rotate ticklen neg 2 div 0 moveto ticklen 0 rlineto tickhead neg dup rlineto tickhead dup rlineto tickhead dup neg exch rlineto 0 setlinewidth stroke 0 ticklen neg 2 div moveto 0 ticklen rlineto stroke grestore} if }def /firstpoint { curx cury 2 copy abs exch abs add 0 eq {pop pop currentpoint curvelist exch 1 exch put curvelist exch 0 exch put}{moveto} ifelse showtic1 /ptr ptr 3 add def}def /morepoint {#triads { curx prvx sub dup mul cury prvy sub dup mul add sqrt tension div /zdist exch def prva cos zdist mul prvx add prva sin zdist mul prvy add cura cos zdist mul curx add cura sin zdist mul cury add curx cury curveto showtic1 /ptr ptr 3 add def} repeat} def /showtick false def % ///////// (A) WEB FRIENDLY COLOR UTILITIES ///////////// % tintmat is a self-generating list of 216 triple color values /webtintmat [ 0 1 5 { /a exch store 0 1 5 { /b exch store 0 1 5 { 5 div b 5 div a 5 div }for } for } for ] def % setwebtint accepts a color number 0 to 215 and then % sets the PostScript color generator for later use... /setwebtint { abs cvi 216 cvi mod % restrict range webtintmat exch 3 mul 3 getinterval % get values from table aload pop setrgbcolor} def % and set them % The blocks are arranged as red to the right, green % up in order of increasing blue. % Some "pure color" sequences are % red: 0 1 2 3 4 5 % orange: 0 7 8 15 16 23 (sort of) % yellow: 0 7 14 21 28 35 % green: 0 6 12 18 24 30 % aqua: 0 42 84 126 168 210 % blue: 0 36 72 108 144 180 % magenta: 0 37 74 111 148 185 % purple 0 73 73 110 147 183 (sort of) % gray 0 43 86 129 172 215 % systemdict /begin get 20 string cvs % (**) exch mergestr (**) mergestr pop % glotz % ////////// "==" Diversion code ///// % Note: An extremely flexible and versatile text formatter is available in % the full Gonzo Utilities if prepended or prerun. Only a simple two font % width and return" is used instead in this particular demo. userdict begin /ytop 60 store /ypos ytop store /ybot 3 store /xleft 3 store /xbot 3 store /yinc 1.2 store /txtwide 48 1 sub store % fakes stringwidth /texright txtwide xleft add store /curchar (X) store /wanttoshowgrid true store /firstreportpage true store /reportpagecolor {143} store /font1 {/StoneSans-Bold findfont 1 scalefont setfont} store /font2 {/StoneSans findfont 1 scalefont setfont} store font1 /makenewreportpage { showpage 0 0 mt 1000 0 rlineto 0 1000 rlineto -1000 0 rlineto closepath reportpagecolor setwebtint fill 43 63 10 setgrid wanttoshowgrid {32 setwebtint 52 67 showgrid 0 setwebtint} if xleft ytop moveto () show % set currentpoint } store %%%%%%%%%%% /printd { /curstring exch store % grab the print string curstring { /asASCII exch store % grab 0-255 integer ASCII value asASCII 10 eq {/ypos ypos yinc sub store % if a \n newline /xpos xleft store xpos ypos moveto % set new currentpoint ypos ybot lt {makenewreportpage} if % make sure we are still on page } if asASCII 12 eq {makenewreportpage } if % unconditional formfeed asASCII 10 ne asASCII 12 ne and { % if a real character curchar 0 asASCII put curchar show currentpoint /ypos exch store % reset position info from show /xpos exch store xpos txtwide ge {/ypos ypos yinc % check for right margin crash sub store /xpos xleft store % Use the Gonzo Utilities for better xpos ypos moveto } if ypos ybot lt % conditional formfeed {makenewreportpage} if } if } forall } store /dtypesknown 20 dict store dtypesknown begin /operax {100 string cvs (**) exch mergestr (**) mergestr printd (\n) printd } store /strinx {(\() exch mergestr printd (\)) printd (\n) printd } store /integx { 25 string cvs printd (\n) printd } store /realtx { 25 string cvs printd (\n) printd } store /nametx {(/) printd 25 string cvs printd (\n) printd } store /dicttx {/curdict exch store (*dict* ) printd curdict length 20 string cvs printd ( long with /) printd curdict {pop exit} forall 25 string cvs printd (\n) printd } store /boolex { 20 string cvs printd(\n) printd } store /marktx {("[" or "mark"\n) printd } store /nulltx { (*null*\n) printd } store /arrayx { dup xcheck {/openbrack ({) store /closebrack (}) store} {/openbrack ([) store /closebrack (]) store} ifelse openbrack printd (\n)printd { ( ) printd ==d} forall closebrack printd (\n) printd } store /pstackd { count /scount exch store scount copy mark scount 1 add 1 roll ] (\n\nstack:\n) printd {( ) printd ==d } forall } store /==d { dup type dup cvlit /curtype exch store 25 string cvs 0 5 getinterval (x) mergestr cvn % prevent name reuse! /targetap exch store dtypesknown targetap known {dtypesknown targetap get exec } % report if reportable {(Sorry, "/) curtype 20 string cvs mergestr % otherwise, default (" reporting not yet implemented.\n) mergestr printd } ifelse }store % /////////////////////// Error Reporter Code //////////////////// /diverterrors true store % for debug only if false! diverterrors { errordict begin /VMerror {/VMerror eproc} store % not yet verified /configurationerror {/configurationerror eproc} store % not yet verified /dhandleerror {/dhandleerror eproc} store % not yet verified /dictfull {/dictfull eproc} store % not yet verified /dictstackoverflow {/dictstackoverflow eproc} store % not yet verified /dictstackunderflow {/dictstackunderflow eproc} store % not yet verified /execstackoverflow {/execstackoverflow eproc} store % not yet verified /handleerror {/handleerror eproc} store % not yet verified /interrupt {/interrupt eproc} store % not yet verified /invalidaccess {/invalidaccess eproc} store /invalidfileaccess {/invalidfileaccess eproc} store % not yet verified /invalidfont {/invalidfont eproc} store % not yet verified /invalidrestore {/invalidrestore eproc} store % not yet verified /ioerror {/ioerror eproc} store % not yet verified /limitcheck {/limitcheck eproc} store % not yet verified /nocurrentpoint {/nocurrentpoint eproc} store /rangecheck {/rangecheck eproc} store /stackoverflow {/stackoverflow eproc} store % not yet verified /stackunderflow {/stackunderflow eproc} store /syntaxerror {dup length 25 gt {0 25 getinterval} if /syntaxerror eproc} store /typecheck {/typecheck {eproc} } store /timeout {/timeout eproc} store % not yet verified /undefined {/undefined eproc} store /undefinedfilename {/undefinedfilename eproc} store /undefinedresult {/undefinedresult eproc} store /unmatchedmark {/unmatchedmark eproc} store /undefinedresource {/undefinedresource eproc} store % not yet verified /unregistered {/unregistered eproc} store % not yet verified end } if % these must go into an active dictionary, not errordict! userdict begin /firsterr true store % report only first error /eproc { firsterr {/firsterr false store eproc1} {/firsterr false store pop pop} ifelse % ignore subsequent errors } store /eproc1 { /err1 exch 200 string cvs store % save errpr name /val1 exch 200 string cvs store % save errpr cause showpage % show real program so far 131 setwebtint % start new red page 0 0 moveto 1000 0 rlineto 0 1000 rlineto -1000 0 rlineto closepath fill 0 0 0 setrgbcolor % report first error /font1 {/StoneSans-Bold findfont 1 scalefont setfont} store /font2 {/StoneSans findfont 1 scalefont setfont} store font1 43 63 10 setgrid wanttoshowgrid {32 setwebtint 52 67 showgrid 0 setwebtint} if xleft ytop moveto () show % set currentpoint % 1.0 20.0 moveto font1 (A first )show font2 err1 show font1( error involving ) show font2 val1 show font1 ( was found.\n\n\n) show pstackd % end of composite doc } store % end error reporting code % ////////// "==d" Diversion demo ///// % Note: An extremely flexible and versatile text formatter is available in % the full Gonzo Utilities if prepended or prerun. Only a simple two font % "width and return and newpage" gets used instead in this particular demo. % Full Gonzo adds about 80K to the program length -or- else demands the % //acrodist /F Distiller run capability. Full details in the Gonzo tutorial. userdict begin /font1 {/StoneSans-Bold findfont 1 scalefont setfont} store /font2 {/StoneSans findfont 1 scalefont setfont} store font1 (A stack marker in case it is empty) % glotz % An early error when uncommented 0 setwebtint 0 0 moveto 1000 1000 rlineto stroke % a fake "real" program woof (\f) printd % force showpage and start of log pages. (This is a a simple message. \n\n) printd % horace (\nThe next "regular" text follows, but don't forget a between-text space! ) printd (Should the next "regular" text be long, a newline will be forced. Use the Gonzo Utilities if you want better linebreaks or otherwise superb results. ) printd (\n\nHere is how you ) printd font2 (change a font) printd font1 ( and back again.) printd (\n\nNewline characters of "\\n" \ncan be added when and where wanted.\n) printd (\nNewpage characters of "\\f" \ncan be added when and where wanted.\n\f) printd % should be on next page (The "==d" command presently includes...\n\n) printd systemdict /begin get ==d % reporting ps type examples 1234 ==d (A dreported string) ==d 123.456 ==d /a_nice_name ==d null ==d mark ==d true ==d /mydict <> store mydict ==d [ (an array string) true 1.4 5678 ] cvlit ==d { (an array string) true 1.4 5678 } cvx ==d (\n\n\n\n) printd (A stack dumping demo...\n) printd clear (an array string) true 1.4 5678 pstackd showpage %EOF