%! % PostScript 8 place reporting accuracy improver Report8a.psl % ============================================================= % PostScript normally reports real values only to six decimal point precision. % Internally, nearly eight decimal points of precision are available per the % IEEE floating point routines. Certain custom PostScript-as-language apps may % demand ( or at least welcome ) more than six decimal points of precision. % /realto8dstring converts any signed PostScript real in the absolute range % of 0.000000001 to 999,999,999 to a reportable string accurate to nearly eight % decimal points of precision. Larger absolute values create an error while % smaller ones truncate and report as 0.0000000 or -0.0000000. % To use, place a real number or its variable on the stack and call % realto8dstring. The equvalent reportable string returns to the stack top. % Operation is based on converting any real over the allowable range to % an integer in the 10 to 100 million range, converting that integer to % a string, and modifying the string as needed for a decimal point and sign. % This utility presently operates over an absolute value range of 0.0000001 % to 99,999,999. Larger values are reported as errors. Smaller values are % truncated to 0.00000000. % One count or more uncertainties may exist in the eighth decimal place. % Original code has been modified for triple Distiller-GoogleDrive-GhostScript % compatibility. The demo is thus routed to a .PDF page along with a .LOG one. % Reporting is only when called, and no PS internals have been modified. % ////////////// GONZO EXCERPTS ////////////////// /setgrid { /blocksize exch def translate % simplified blocksize dup scale} def % 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 % mergestr merges the two top stack strings into one top stack string /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 /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 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 {false} store /fatter10 { false} store /thingridlines {0} 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 % ////////////// Reporting Code Modules /////////// /realto8dstring {dup 0 lt % test and flag negatives /isneg exch store abs /val exch store % save real as absolute value val 100000000 ge { % report and error trap values (real is too big! ) % that are too large to process real_is_too_big! } if val 0.00000001 le % truncate small numbers to zero {(0.0000000)} {processgoodreal} ifelse % process numbers versus zeros isneg {(-)}{( )} ifelse % create leading space or minus exch mergestr % add leading space or minus 20 string cvs % dereference string to avoid % any possible rude surprises } store % /processgoodreal continues the realto8string processing after numbers too % large and too small have been dealt with. Subprocs are called for tenmillions, % unitsormore, and fractions. Note that log floor cvi tells you the decade % size and position of any positive number. /processgoodreal { val log floor cvi % evaluate decimal location /posn exch store % posn 7 eq {tenmillions} % treat ten millions special {posn 0 ge {unitsormore} % handle >1 as a class {fractions} % handle fractions as a class ifelse } ifelse } store % /tenmillions handles ten millions as a special case needing no reformatting. /tenmillions { val round cvi % use ten millions val as is. 20 string cvs } store % /unitsormore handles units through millions... /unitsormore { /workstring val % scale val as needed to 10-99 megs 1 7 posn sub {10 mul} % this may give more accuracy repeat mul round cvi 20 string cvs store % and convert to string workstring 0 posn 1 add % stuff decimal point getinterval (.) mergestr workstring % post remainder of string posn 1 add workstring length 1 sub posn sub getinterval mergestr 20 string cvs % dereference } store % /fractions handles fractional values /fractions {/workstring val % scale workstring 1 7 posn sub {10 mul} repeat % this may give more accuracy mul round cvi 20 string cvs store % and convert to string (0.) % prepend leading zero and dp posn neg 1 sub % add intermediate zeros {(0) mergestr} repeat workstring mergestr % postpend value 20 string cvs % dereference } store % ///////////// PRINT TO PDF CODE ////////// /print_to_pdf { needpdfoutput { xpos ypos moveto show /xpos 3 store /ypos ypos yinc sub store }{pop} ifelse } store % ////////////// Code Reporting Demo /////////////// 30 setwebtint % green grid 50 50 10 setgrid true {45 57 showgrid} if 0 setwebtint % black text % Fonts will be substituted unless specific to acrobat, ghostscript, google drive /StoneSans-Bold findfont 1 scalefont setfont % Use more Gonzo if >1 font neede /needpdfoutput true store % also report as .pdf for Google Drive Compatibility /xpos 3 store /ypos 50 store /yinc 1.5 store 2 sqrt 10000000 mul realto8dstring dup == print_to_pdf 2 sqrt 1000000 mul neg realto8dstring dup == print_to_pdf % negs may be demoed anywhere. 2 sqrt 100000 mul realto8dstring dup == print_to_pdf 2 sqrt 10000 mul neg realto8dstring dup == print_to_pdf 2 sqrt 1000 mul realto8dstring dup == print_to_pdf 2 sqrt 100 mul neg realto8dstring dup == print_to_pdf 2 sqrt 10 mul realto8dstring dup == print_to_pdf 2 sqrt neg realto8dstring dup == print_to_pdf 2 sqrt 0.1 mul realto8dstring dup == print_to_pdf 2 sqrt 0.01 mul realto8dstring dup == print_to_pdf 2 sqrt 0.001 mul realto8dstring dup == print_to_pdf 2 sqrt 0.0001 mul realto8dstring dup == print_to_pdf 2 sqrt 0.00001 mul realto8dstring dup == print_to_pdf 2 sqrt 0.000001 mul realto8dstring dup == print_to_pdf 2 sqrt 0.0000001 mul realto8dstring dup == print_to_pdf 2 sqrt 0.00000001 mul realto8dstring dup == print_to_pdf 2 sqrt 0.000000001 mul realto8dstring dup == print_to_pdf 0 realto8dstring dup == print_to_pdf showpage %EOF