diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
commit | 8466d8cfa486fb30d1755c4261b781135083787b (patch) | |
tree | c8c12c67246f543c3cc4f64d1c07e003cb1d45ae /grapheps.ps | |
parent | 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff) | |
download | slib-8466d8cfa486fb30d1755c4261b781135083787b.tar.gz slib-8466d8cfa486fb30d1755c4261b781135083787b.zip |
Import Upstream version 3a1upstream/3a1
Diffstat (limited to 'grapheps.ps')
-rw-r--r-- | grapheps.ps | 344 |
1 files changed, 344 insertions, 0 deletions
diff --git a/grapheps.ps b/grapheps.ps new file mode 100644 index 0000000..87658dd --- /dev/null +++ b/grapheps.ps @@ -0,0 +1,344 @@ +%%EndComments +/plotdict 100 dict def +plotdict begin + +% Definitions so that internal assignments are bound before setting. +/DATA 0 def +/DEN 0 def +/DIAG 0 def +/DIAG2 0 def +/DLTA 0 def +/EXPSN 0 def +/GPROCS 0 def +/GD 6 def +/GR 3 def +/IDX 0 def +/ISIZ 0 def +/MAX 0 def +/MIN 0 def +/NUM 0 def +/PLOT-bmargin 0 def +/PLOT-lmargin 0 def +/PLOT-rmargin 0 def +/PLOT-tmargin 0 def +/PROC 0 def +/ROW 0 def +/TXT 0 def +/WPAGE 0 def +/X-COORD 0 def +/XDX 0 def +/XOFF 0 def +/XPARTS 0 def +/XRNG 0 def +/XSCL 0 def +/XSTEP 0 def +/XSTEPH 0 def +/XTSCL 0 def +/XWID 0 def +/Y-COORD 0 def +/YDX 0 def +/YHIT 0 def +/YOFF 0 def +/YPARTS 0 def +/YRNG 0 def +/YSCL 0 def +/YSTEP 0 def +/YSTEPH 0 def +/YTSCL 0 def +/graphrect 0 def +/plotrect 0 def + +% Here are the procedure-arrays for passing as the third argument to +% plot-column. Plot-column moves to the first coordinate before +% calls to the first procedure. Thus both line and scatter graphs are +% supported. Many additional glyph types can be produced as +% combinations of these types. This is best accomplished by calling +% plot-column with each component. + +% GD and GR are the graphic-glyph diameter and radius. +% DIAG and DIAG2, used in /cross are diagonal and twice diagonal. +% gtrans maps x, y coordinates on the stack to 72dpi page coordinates. + +% Render line connecting points +/line [{} {lineto} {}] bind def +/mountain [{currentpoint 2 copy pop bottomedge moveto lineto} + {lineto} + {currentpoint pop bottomedge lineto closepath fill}] bind def +/cloud [{currentpoint 2 copy pop topedge moveto lineto} + {lineto} + {currentpoint pop topedge lineto closepath fill}] bind def +% Render lines from x-axis to points +/impulse [{} {moveto currentpoint pop 0 lineto} {}] bind def +/bargraph [{} {exch GR sub exch 0 exch GD exch rectstroke} {}] bind def + +% Solid round dot. +/disc [{GD setlinewidth 1 setlinecap} + {moveto 0 0 rlineto} {}] bind def +% Minimal point -- invisible if linewidth is 0. +/point [{1 setlinecap} {moveto 0 0 rlineto} {}] bind def +% Square box. +/square [{} {GR sub exch GR sub exch GD dup rectstroke} {}] bind def +% Square box at 45.o +/diamond [{} + {2 copy GR add moveto + GR neg GR neg rlineto GR GR neg rlineto + GR GR rlineto GR neg GR rlineto + closepath} + {}] bind def +% Plus Sign +/plus [{} + { GR sub moveto 0 GD rlineto + GR neg GR neg rmoveto GD 0 rlineto} + {}] bind def +% X Sign +/cross [{/DIAG GR .707 mul def /DIAG2 DIAG 2 mul def} + {exch DIAG sub exch DIAG add moveto DIAG2 dup neg rlineto + DIAG2 neg 0 rmoveto DIAG2 dup rlineto} + {}] bind def +% Triangle pointing upward +/triup [{} + {2 copy GR 1.12 mul add moveto GR neg GR -1.62 mul rlineto + GR 2 mul 0 rlineto GR neg GR 1.62 mul rlineto + closepath} + {}] bind def +% Triangle pointing downward +/tridown [{} + {2 copy GR 1.12 mul sub moveto GR neg GR 1.62 mul rlineto + GR 2 mul 0 rlineto GR neg GR -1.62 mul rlineto + closepath} + {}] bind def +/pentagon [{} + {gsave translate 0 GR moveto 4 {72 rotate 0 GR lineto} repeat + closepath stroke grestore} + {}] bind def +/circle [{stroke} {GR 0 360 arc stroke} {}] bind def + +% ( TITLE ) ( SUBTITLE ) +/title-top +{ dup stringwidth pop -2 div plotrect 0 get plotrect 2 get 2 div add add + plotrect 1 get plotrect 3 get add pointsize .4 mul add moveto show + dup stringwidth pop -2 div plotrect 0 get plotrect 2 get 2 div add add + plotrect 1 get plotrect 3 get add pointsize 1.4 mul add moveto show +} bind def + +% ( TITLE ) ( SUBTITLE ) +/title-bottom +{ dup stringwidth pop -2 div plotrect 0 get plotrect 2 get 2 div add add + plotrect 1 get pointsize -2 mul add moveto show + dup stringwidth pop -2 div plotrect 0 get plotrect 2 get 2 div add add + plotrect 1 get pointsize -1 mul add moveto show +} bind def + +% Plots column K against column J of given two-dimensional ARRAY. +% The arguments are: +% [ ARRAY J K ] J and K are column-indexes into ARRAY +% [ PREAMBLE RENDER POSTAMBLE ] Plotting procedures: +% PREAMBLE - Executed once before plotting row +% RENDER - Called with each pair of coordinates to plot +% POSTAMBLE - Called once after plotting row (often does stroke) +/plot-column +{ /GPROCS exch def aload pop /YDX exch def /XDX exch def /DATA exch def + /GD glyphsize def + /GR GD .5 mul def + gsave + /ROW DATA 0 get def ROW XDX get ROW YDX get gtrans moveto + GPROCS 0 get exec % preamble + /PROC GPROCS 1 get def DATA {dup XDX get exch YDX get gtrans PROC} forall + GPROCS 2 get exec stroke % postamble + grestore +} bind def + +/whole-page +{clippath pathbbox 2 index sub exch 3 index sub exch 4 array astore} bind def + +/partition-page +{ /YPARTS exch def /XPARTS exch def /WPAGE exch def + /XWID WPAGE 2 get XPARTS div def /YHIT WPAGE 3 get YPARTS div def + /Y-COORD WPAGE 1 get def + YPARTS + { /X-COORD WPAGE 0 get WPAGE 2 get add XWID sub def + XPARTS {[X-COORD Y-COORD XWID YHIT] + /X-COORD X-COORD XWID sub def} repeat + /Y-COORD Y-COORD YHIT add def + } repeat +} bind def + +% The arguments are: +% [ MIN-X MIN-Y DELTA-X DELTA-Y ] whole graph rectangle +% [ MIN-COLJ MAX-COLJ ] Numerical range of plot data +% [ MIN-COLK MAX-COLK ] Numerical range of plot data +% and the implicit current clippath +/setup-plot +{ /YRNG exch def /XRNG exch def /graphrect exch def + /PLOT-bmargin pointsize 2.4 mul def + /PLOT-tmargin pointsize 2.4 mul def + /PLOT-lmargin (-.0123456789) stringwidth pop pointsize 1.2 mul add def + /PLOT-rmargin (-.0123456789) stringwidth pop pointsize 1.2 mul add def + /plotrect [ graphrect 0 get PLOT-lmargin add + graphrect 1 get PLOT-bmargin add + graphrect 2 get PLOT-lmargin sub PLOT-rmargin sub + graphrect 3 get PLOT-bmargin sub PLOT-tmargin sub ] def + /XOFF XRNG 0 get def /YOFF YRNG 0 get def + /XSCL plotrect 2 get XRNG aload pop exch sub div def + /YSCL plotrect 3 get YRNG aload pop exch sub div def + /XOFF XOFF plotrect 0 get XSCL div sub def + /YOFF YOFF plotrect 1 get YSCL div sub def + /YTSCL plotrect 3 get YRNG aload pop exch sub find-tick-scale def + /YSTEP YTSCL 0 get 3 mod 0 eq {6} {8} ifelse 5 mul yuntrans def + /XTSCL plotrect 2 get XRNG aload pop exch sub find-tick-scale def + /XSTEP XTSCL 0 get 3 mod 0 eq {6} {8} ifelse 10 mul xuntrans def + /YSTEPH YSTEP 2 div def + /XSTEPH XSTEP 2 div def +} bind def + +% gtrans is the utility routine mapping data coordinates to view space. +% plot-column sets up XOFF, XSCL, and YSCL and uses it. +/gtrans {exch XOFF sub XSCL mul exch YOFF sub YSCL mul} bind def +%/guntrans {exch XSCL div XOFF add exch YSCL div YOFF add} bind def + +% /ytrans {YTSCL aload pop div mul} bind def +% /xtrans {XTSCL aload pop div mul} bind def +/yuntrans {YTSCL aload pop exch div mul} bind def +/xuntrans {XTSCL aload pop exch div mul} bind def + +/zero-in-range? {dup 0 get 0 le exch 1 get 0 ge and} bind def + +/y-axis +{ XRNG zero-in-range? + { 0 YRNG 0 get gtrans moveto 0 YRNG 1 get gtrans lineto stroke} if +} bind def +/x-axis +{ YRNG zero-in-range? + {XRNG 0 get 0 gtrans moveto XRNG 1 get 0 gtrans lineto stroke} if +} bind def + +% Find data range in column K of two-dimensional ARRAY. +% ARRAY +% K is the column-index into ARRAY +/column-range +{ /IDX exch def dup /MIN exch 0 get IDX get def /MAX MIN def + {IDX get dup dup MIN lt {/MIN exch def} {pop} ifelse + dup MAX gt {/MAX exch def} {pop} ifelse} forall + [MIN MAX] +} bind def + +/min {2 copy lt {pop} {exch pop} ifelse} bind def +/max {2 copy gt {pop} {exch pop} ifelse} bind def + +/combine-ranges +{ aload pop 3 2 roll aload pop exch 4 3 roll min 3 1 roll max 2 array astore} +bind def + +/pad-range +{ exch aload pop /MAX exch def /MIN exch def + /EXPSN exch 100 div MAX MIN sub mul def + [ MIN EXPSN sub MAX EXPSN add ] +} bind def + +/snap-range +{dup aload pop exch sub 1 exch find-tick-scale aload pop + /DEN exch def /NUM exch def 1 NUM div DEN mul /DLTA exch def + aload pop /MAX exch def /MIN exch def + [ DLTA MAX MIN sub sub 2 div dup MIN exch sub exch MAX add ] +} bind def + +% Given the width (or height) and the data-span, returns an array of +% numerator and denominator (NUM DEN) +% +% NUM will be 1, 2, 3, 4, 5, 6, or 8 times a power of ten. +% DEN will be a power of ten. +% +% NUM ISIZ +% === < ==== +% DEN DLTA +/find-tick-scale +{/DLTA exch def /ISIZ exch def + /DEN 1 def + {DLTA ISIZ le {exit} if /DEN DEN 10 mul def /ISIZ ISIZ 10 mul def} loop + /NUM 1 def + {DLTA 10 mul ISIZ ge {exit} if /NUM NUM 10 mul def /DLTA DLTA 10 mul def} loop + [[8 6 5 4 3 2 1] {/MAX exch def MAX DLTA mul ISIZ le {MAX exit} if} forall + NUM mul DEN] +} bind def + +/rule-vertical +{ /XWID exch def + /TXT exch def + /X-COORD exch def + X-COORD type [] type eq {/X-COORD X-COORD 0 get def} if + gsave + X-COORD plotrect 1 get plotrect 3 get 2 div add translate + TXT stringwidth pop -2 div + XWID 0 gt { 90 rotate PLOT-lmargin} {-90 rotate PLOT-rmargin} ifelse + pointsize 1.2 mul sub moveto TXT show + grestore + YRNG 0 get YSTEP div ceiling YSTEP mul YSTEP YRNG 1 get + { /YDX exch def 0 YDX gtrans /Y-COORD exch def pop + X-COORD Y-COORD moveto XWID 0 rlineto stroke + /TXT YDX 20 string cvs def + X-COORD + XWID 0 gt {TXT stringwidth pop sub ( ) stringwidth pop sub + Y-COORD pointsize .3 mul sub moveto} + {Y-COORD pointsize .3 mul sub moveto ( ) show} ifelse + TXT show} for + YRNG 0 get YSTEPH div ceiling YSTEPH mul YSTEPH YRNG 1 get + { /YDX exch def 0 YDX gtrans /Y-COORD exch def pop + X-COORD Y-COORD moveto XWID 2 div 0 rlineto stroke} for +} bind def + +/rule-horizontal +{ /YHIT exch def + /TXT exch def + /Y-COORD exch def + Y-COORD type [] type eq {/Y-COORD Y-COORD 1 get def} if + plotrect 0 get plotrect 2 get 2 div add TXT stringwidth pop -2 div add + Y-COORD + YHIT 0 gt {pointsize -2 mul} {pointsize 1.4 mul} ifelse add moveto TXT show + XRNG 0 get XSTEP div ceiling XSTEP mul XSTEP XRNG 1 get + { dup 0 gtrans pop /X-COORD exch def + X-COORD Y-COORD moveto 0 YHIT rlineto stroke + /TXT exch 10 string cvs def + X-COORD TXT stringwidth pop 2.0 div sub + Y-COORD YHIT 0 gt {pointsize sub} {pointsize .3 mul add} ifelse + moveto TXT show + } for + XRNG 0 get XSTEPH div ceiling XSTEPH mul XSTEPH XRNG 1 get + { 0 gtrans pop Y-COORD moveto 0 YHIT 2 div rlineto stroke} for +} bind def + +/grid-verticals +{ XRNG 0 get XSTEPH div ceiling XSTEPH mul XSTEPH XRNG 1 get + { 0 gtrans pop /X-COORD exch def + X-COORD plotrect 1 get moveto 0 plotrect 3 get rlineto} for + stroke +} bind def + +/grid-horizontals +{ YRNG 0 get YSTEPH div ceiling YSTEPH mul YSTEPH YRNG 1 get + { 0 exch gtrans /Y-COORD exch def pop + plotrect 0 get Y-COORD moveto plotrect 2 get 0 rlineto} for + stroke +} bind def + +/leftedge {plotrect 0 get} bind def +/rightedge {plotrect dup 0 get exch 2 get add} bind def +/topedge {plotrect dup 1 get exch 3 get add} bind def +/bottomedge {plotrect 1 get} bind def + +/outline-rect {aload pop rectstroke} bind def +/fill-rect {aload pop rectfill} bind def +/clip-to-rect {aload pop rectclip} bind def + +% Default parameters + +% glyphsize is the graphic-glyph size; GR, graphic radius, is +% glyphsize/2. Line width, set by "setlinewidth", must be much less +% than glyphsize for readable glyphs. +/glyphsize 6 def +% pointsize is the height of text characters in "points", 1/72 inch; 0.353.mm +/pointsize 12 def +% Set default font +/Helvetica pointsize selectfont + +gsave + |