diff toolboxes/graph_visualisation/lib/lefty/lefty.psp @ 0:e9a9cd732c1e tip

first hg version after svn
author wolffd
date Tue, 10 Feb 2015 15:05:51 +0000
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/toolboxes/graph_visualisation/lib/lefty/lefty.psp	Tue Feb 10 15:05:51 2015 +0000
@@ -0,0 +1,80 @@
+/BOX {
+    /boxy1 exch def /boxx1 exch def /boxy0 exch def /boxx0 exch def
+    boxx0 boxy0 moveto boxx1 boxy0 lineto
+    boxx1 boxy1 lineto boxx0 boxy1 lineto
+    closepath
+} def
+/SCP { stroke initclip newpath BOX clip newpath } def
+/CL { stroke setrgbcolor } def
+/DO { stroke } def
+/NP { newpath } def
+/FI { fill } def
+/LI { moveto lineto } def
+/CT { curveto } def
+/AR {
+    /ang2 exch def /ang1 exch def
+    /radius exch def /y2x exch def /cy exch def /cx exch def
+    gsave
+        cx cy translate 1 y2x scale 0 0 radius ang1 ang2 arc stroke
+    grestore
+} def
+/ARF {
+    /ang2 exch def /ang1 exch def
+    /radius exch def /y2x exch def /cy exch def /cx exch def
+    gsave
+        cx cy translate 1 y2x scale 0 0 radius ang1 ang2 arc fill
+    grestore
+} def
+/TXT {
+    /texth exch def
+    /textf exch def
+    /textn exch def
+    /texts exch def
+    /textyj exch def /texty exch def
+    /textxj exch def /textx exch def
+    textf findfont texth scalefont dup setfont
+    /FontBBox get 1 get 1000 div texth mul /textbl exch def
+    /textth texth textn mul def /texttw 0 def
+    0 1 textn 1 sub {
+        texts exch get 0 get stringwidth pop
+        dup texttw gt { /texttw exch def } { pop } ifelse
+    } for
+    textyj (b) eq { /ty texty textth add textbl add def } if
+    textyj (d) eq { /ty texty textth add def } if
+    textyj (c) eq { /ty texty textth 2 div add def } if
+    textyj (u) eq { /ty texty def } if
+    /ty ty textbl sub def
+    textxj (l) eq { /tx textx def } if
+    textxj (c) eq { /tx textx texttw 2 div sub def } if
+    textxj (r) eq { /tx textx texttw sub def } if
+    0 1 textn 1 sub {
+        /ty ty texth sub def
+        texts exch get dup 0 get /ts exch def 1 get /tj exch def
+        tj (l) eq { tx ty moveto ts show } if
+        tj (n) eq {
+            tx texttw ts stringwidth pop sub 2 div add ty moveto ts show
+        } if
+        tj (r) eq {
+            tx texttw ts stringwidth pop sub add ty moveto ts show
+        } if
+    } for
+} def
+
+/colorimage where {
+    pop
+} {
+    /bwproc {
+        rgbproc dup length 3 idiv string 0 3 0 5 -1 roll {
+            add 2 1 roll 1 sub dup 0 eq {
+                pop 3 idiv 3 -1 roll dup 4 -1 roll
+                dup 3 1 roll 5 -1 roll put 1 add 3 0
+            } {
+                2 1 roll
+            } ifelse
+        } forall
+        pop pop pop
+    } def
+    /colorimage {
+        pop pop /rgbproc exch def {bwproc} image
+    } bind def
+} ifelse