pst-marble (19oct18)

git-svn-id: svn://tug.org/texlive/trunk@48942 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 206 insertions, 277 deletions

diff --git a/Master/texmf-dist/dvips/pst-marble/pst-marble.pro b/Master/texmf-dist/dvips/pst-marble/pst-marble.pro
index 60a36806480..478b39d677a 100644
--- a/Master/texmf-dist/dvips/pst-marble/pst-marble.pro
+++ b/Master/texmf-dist/dvips/pst-marble/pst-marble.pro
@@ -1,28 +1,29 @@
+%%Creator: Aubrey Jaffer
+%%For: Voluntocracy
 %%Copyright: 2018 Aubrey Jaffer
 %%Creator: Aubrey Jaffer
 %%For: Voluntocracy
-%%CreationDate: 2018-09-13
-/plotdict 70 dict def
+%%CreationDate: 2018-10-19
+/plotdict 100 dict def
 plotdict begin
 
-/pi 3.141592653589793 def
-/e 2.718281828459045 def
-
+ /URL (http://people.csail.mit.edu/jaffer/Marbling) def
+ /pi 3.141592653589793 def
+ /e 2.718281828459045 def
+ /e^-1 1 e div def
+ /m4o3 -4 3.0 div def
 
 %% depend on rendering direction:
 %/zsgn 0 def
 
 /URL (http://people.csail.mit.edu/jaffer/Marbling) def
 
-% negative L for (raster) reverse-marbling
-/marble				% viscosity L
+% negative viscosity for (raster) reverse-marbling
+/marble				% nu (viscosity)
 {
-    /z exch def /visc exch def
-    /u 2.0 -1 visc div exp def
-    /L z abs def
-    /reverse-rendering? z 0 lt def
-    /z.2.pi z 180 pi div mul def
-    /zsgn 1 z 0 lt {neg} if def
+    dup /nu exch 1e-6 mul abs def
+    /reverse-rendering? exch 0 lt def
+
 %    0 setlinewidth
     reverse-rendering?
     {
@@ -35,33 +36,34 @@ plotdict begin
     /scl hiy loy sub hix lox sub max def
 %    /orgx hix lox add 2 div def
 %    /orgy hiy loy add 2 div def
-% set background field of each /ink
+    /acnt actions length def
+% set background field of each /drop
     0 1 acnt -1 add
     {
 	/sdx exch def
 	actions sdx get aload pop /ct exch def
-	ct /ink eq
+	ct /drop eq
 	{
-	    pop pop pop /cy exch def /cx exch def
-	    cx cy sdx find-ink-background /bgc exch def
+	    pop pop pop /cy exch .001 mul def /cx exch .001 mul def
+	    cx cy sdx find-drop-background /bgc exch def
 	    actions sdx get 3 bgc put
 	}
 	{
-	    ct /line eq
+	    ct /vortex eq
 	    {pop pop pop pop}
 	    {
-		ct /stroke eq
+		ct /stroke eq ct /rake eq or
 		{pop pop pop pop pop}
 		{
-		    ct /circle eq ct /vortex eq or
-		    {pop pop pop}
+		    ct /stir eq
+		    {pop pop pop pop pop pop}
 		    {
 			ct /wiggle eq
-			{pop pop pop}
+			{pop pop}
 			{
 			    ct /offset eq
 			    {pop pop}
-			    {(unrecognized token) = ct =}
+			    {(unrecognized token) = ct =} ifelse
 			} ifelse
 		    } ifelse
 		} ifelse
@@ -73,27 +75,55 @@ plotdict begin
 	do-raster
     }
     {
-%	orgx orgy translate
-	scl 1000. div dup scale
-	do-inks
+	orgx orgy translate
+	scl 1.0 div dup scale
+	do-drops
     } ifelse
 } bind def
 
-%% Given x, y coordinates and index of /ink on stack, returns the rgb
-%% vector of the ink immediately surrounding that ink.
-/find-ink-background
+/ct-dispatch
+{
+    ct /rake eq
+    {rake-deformation}
+    {
+	ct /stroke eq
+	{stroke-deformation}
+	{
+	    ct /stir eq
+	    {stir-deformation}
+	    {
+		ct /vortex eq
+		{vortex-deformation}
+		{
+		    ct /wiggle eq
+		    {wiggle}
+		    {
+			ct /offset eq
+			{offset}
+			{(unrecognized token) = ct =} ifelse
+		    } ifelse
+		} ifelse
+	    } ifelse
+	} ifelse
+    } ifelse
+} bind def
+
+%% Given x, y coordinates and index of /drop on stack, returns the rgb
+%% vector of the drop immediately surrounding that drop.
+/find-drop-background
 {
     /cdx exch -1 add def
     {
 	cdx 0 lt {pop pop background exit} if
 	actions cdx get aload pop /ct exch def
-	ct /ink eq
-	% movement due to ink-drop.
+	ct /drop eq
+	% movement due to drop.
 	{	% px py cx cy rad rgb
 	    /rgb exch def
 	    pop % /bgc exch def
-	    /rad^2 exch dup mul def
-	    /cy exch def /cx exch def /py exch def /px exch def
+	    /rad^2 exch .001 mul dup mul def
+	    /cy exch .001 mul def /cx exch .001 mul def
+	    /py exch def /px exch def
 	    /a^2 px cx sub dup mul py cy sub dup mul add def
 	    a^2 1e-10 lt {0.} {1. rad^2 a^2 div sub} ifelse
 	    /disc exch def
@@ -105,149 +135,134 @@ plotdict begin
 		py cy sub a mul cy add
 	    } ifelse
 	}
-	{
-	    ct /line eq
-	    {line-deformation}
-	    {
-		ct /circle eq
-		{circle-deformation}
-		{
-		    ct /vortex eq
-		    {vortex-deformation}
-		    {
-			ct /wiggle eq
-			{wiggle}
-			{offset} ifelse
-		    } ifelse
-		} ifelse
-	    } ifelse
-	} ifelse
+	{ct-dispatch} ifelse
 	/cdx cdx -1 add def
     } loop
 } bind def
 
 /offset	% px py dx dy --> px py
 {
-    /dy exch def /dx exch def
+    /dy exch .001 mul def /dx exch .001 mul def
     dy reverse-rendering? {neg} if add exch
     dx reverse-rendering? {neg} if add exch
 } bind def
 
-/wiggle	% px py dx dy {func} --> px py
+/wiggle	% px py ang {func} --> px py
 {
-  /func exch def
-  /dy exch def /dx exch def
+  /func exch def /ang exch def
+  /dy ang cos def /dx ang sin def
   /py exch def /px exch def
-  /a py dx mul px dy mul sub func exec reverse-rendering? {neg} if def
+  /a py dx mul px dy mul sub 1000 mul func exec 1e-3 mul reverse-rendering? {neg} if def
   px dx a mul add py dy a mul add
 } bind def
 
-/stroke-deformation	% px py bx by ex ey wid --> px py
+/stroke-deformation	% px py bx by ex ey V D --> px py
 {
-  /wid exch def
+  /D exch .001 mul def /V exch .001 mul abs def
   reverse-rendering? { 4 2 roll } if
-  /ey exch def /ex exch def
-  /by exch def /bx exch def
+  /ey exch .001 mul def /ex exch .001 mul def
+  /by exch .001 mul def /bx exch .001 mul def
   /py exch def /px exch def
   /tU ex bx sub dup mul ey by sub dup mul add sqrt def
-  tU 1e-3 le
-  {}
+  /L V D dup mul mul nu div def
+  1e-6 tU le
   {
-      /nx ex bx sub tU div def
-      /ny ey by sub tU div def
-      /rpts tU Q mul wid div ceiling cvi def
-      /stpx ex bx sub rpts div def
-      /stpy ey by sub rpts div def
-      /ex bx stpx add def
-      /ey by stpy add def
+      /nx ex bx sub tU div def /ny ey by sub tU div def
+      /rpts tU L div ceiling cvi def
+      /stpx ex bx sub rpts div def /stpy ey by sub rpts div def
+      /ex bx stpx add def /ey by stpy add def
       /tU tU rpts div def
-      /inx 0 def
-      /iny 0 def
+      /inx 0 def /iny 0 def
       1 1 rpts
       {
 	  pop
-	  /dxB bx px sub def
-	  /dyB by py sub 1e-12 add def
-	  /dxE ex px sub def
-	  /dyE ey by add 2 div py sub 1e-12 add def
+	  /dxB bx px sub def /dyB by py sub def
+	  /dxE ex px sub def /dyE ey py sub def
 	  /r dxB dup mul dyB dup mul add sqrt def
 	  /s dxE dup mul dyE dup mul add sqrt def
 	  /txB dxB nx mul dyB ny mul add def
 	  /txE dxE nx mul dyE ny mul add def
 	  /ty dxB ny mul dyB nx mul sub def
-	  /denr e r wid div exp r mul wid mul 2 mul def
-	  /dens e s wid div exp s mul wid mul 2 mul def
-	  /inx r wid mul ty dup mul sub tU mul denr div
-	       s wid mul ty dup mul sub tU mul dens div add def
+	  /denr e r L div exp r mul L mul 2 mul def
+	  /dens e s L div exp s mul L mul 2 mul def
+	  /inx r L mul ty dup mul sub tU mul denr div
+	       s L mul ty dup mul sub tU mul dens div add def
 	  /iny txB ty mul tU mul denr div
 	       txE ty mul tU mul dens div add def
 	  /px px inx nx mul iny ny mul add add def
 	  /py py inx ny mul iny nx mul sub add def
-	  /bx ex def
-	  /by ey def
-	  /ex ex stpx add def
-	  /ey ey stpy add def
+	  /bx ex def /by ey def
+	  /ex ex stpx add def /ey ey stpy add def
       } for
-  } ifelse
+  } if
   px py
 } bind def
 
-/line-deformation	% px py dx dy xs ys --> px py
+/rake-deformation		% [ ang [ rs ] V tU D /rake ]
 {
-  /ys exch def /xs exch def
-  /dy exch def /dx exch def
-  /py exch def /px exch def
-  /a 0 def
-  ys type /arraytype eq
-  {
-    /px-xf*dy px xs sub dy mul def
-    ys {
-	py sub dx mul px-xf*dy add abs u exch exp z mul a add /a exch def
-       } forall
-  }
-  {
-    /py-yf*dx py ys sub dx mul def
-    xs {
-	px sub dy mul py-yf*dx add abs u exch exp z mul a add /a exch def
-       } forall
-  } ifelse
-  px dx a mul add py dy a mul add
+    /D exch .001 mul def /tU exch .001 mul def /V exch .001 mul abs def
+    /rs exch def /ang exch def
+    /py exch def /px exch def
+    /dy ang cos def /dx ang sin def
+    /L^-1 nu V D dup mul mul div def
+    /a 0 def
+    rs
+    {
+	/r exch .001 mul def
+	/bx dy r mul def /by dx r mul neg def
+	px bx sub dy mul py by sub dx mul sub abs L^-1 mul
+	e^-1 exch exp tU mul a add /a exch def
+    } forall
+    /a a reverse-rendering? {neg} if def
+    px dx a mul add py dy a mul add
 } bind def
 
-/circle-deformation	% px py cx cy rs --> px py
+/stir-deformation	% [ cx cy [ rs ] w th D /stir ]
 {
+    /D exch .001 mul def /th exch def /w exch abs def
     /rs exch def
-    /cy exch def /cx exch def
+    /cy exch .001 mul def /cx exch .001 mul def
     /py exch def /px exch def
     /p-c px cx sub dup mul py cy sub dup mul add sqrt def
     /a 0 def
-    rs {
-	/r exch def /a p-c r abs sub abs u exch exp z.2.pi mul p-c div
-	r 0 lt {neg} if
+    1e-6 p-c lt
+    {rs {
+	/r exch .001 mul def
+	/L^-1 nu w pi 180 div mul r abs mul D dup mul mul div def
+	/a p-c r abs sub abs L^-1 mul e^-1 exch exp th mul r 0 lt {neg} if
 	a add def
-       } forall
+    } forall
+    /a a reverse-rendering? {neg} if def
+    } if
     px cx sub py cy sub
     [ a dup cos exch sin 2 copy neg exch cx cy ] transform
 } bind def
 
-% Acutally an irrotational vortex.  rad is radius with 360 deg rotation.
-/vortex-deformation	% px py cx cy rad --> px py
+% An irrotational vortex.  circ is circulation; t is time in seconds
+/vortex-deformation	% px py cx cy circ t --> px py
 {
-    /rad exch def
-    /cy exch def /cx exch def
+    /t exch def /circ exch 1e-6 mul def
+    /cy exch .001 mul def /cx exch .001 mul def
     /py exch def /px exch def
-    /p-c px cx sub dup mul py cy sub dup mul add sqrt def
-    /a p-c 1e-3 lt {0} {rad p-c div pi div 180 mul} ifelse reverse-rendering? {neg} if def
+    /p-c^2 px cx sub dup mul py cy sub dup mul add def
+    /a p-c^2 1e-6 lt
+	{0}
+	{ nu 4 mul .75 exp
+	  p-c^2 2 pi mul mul t div .75 exp
+	  add m4o3 exp
+	  180 pi div mul circ mul reverse-rendering? {neg} if }
+	ifelse def
     px cx sub py cy sub
     [ a dup cos exch sin 2 copy neg exch cx cy ] transform
 } bind def
 
 %% Functions used for forward rendering:
 
-% movement due to ink-drop.
-/spread	% px py cx cy rad
+% movement due to drop.
+/spread	% px py cx cy rad --> px py
 {
-    /rad exch def /cy exch def /cx exch def /py exch def /px exch def
+    /rad exch .001 mul def /cy exch .001 mul def /cx exch .001 mul def
+    /py exch def /px exch def
     /p-c^2 px cx sub dup mul py cy sub dup mul add def
     /a rad dup mul p-c^2 div 1 add sqrt def
     py cy sub px cx sub a mul cx add exch a mul cy add
@@ -260,29 +275,9 @@ plotdict begin
     idx 1 add 1 acnt -1 add
     {
 	actions exch get aload pop /ct exch def
-	ct /ink eq
+	ct /drop eq
 	{pop pop spread}	% pop rgb-vectors
-	{
-	    ct /line eq
-	    {line-deformation}
-	    {
-		ct /stroke eq
-		{stroke-deformation}
-		{
-		    ct /circle eq
-		    {circle-deformation}
-		    {
-			ct /vortex eq
-			{vortex-deformation}
-			{
-			    ct /wiggle eq
-			    {wiggle}
-			    {offset} ifelse
-			} ifelse
-		    } ifelse
-		} ifelse
-	    } ifelse
-	} ifelse
+	{ct-dispatch} ifelse
     } for
 } bind def
 
@@ -301,7 +296,7 @@ plotdict begin
     {
 	dup /oy exch def
 	Minsky-circle 2 copy
-	exch Cx add exch Cy add		% shift center of ink
+	exch Cx add exch Cy add		% shift center of drop
 	composite-map lineto
 	dup 0 gt oy 0 lt and {exit} if
     } loop
@@ -310,17 +305,17 @@ plotdict begin
 } bind def
 
 % Fills (distorted) circles.
-/do-inks	% acnt = index of last action + 1
+/do-drops	% acnt = index of last action + 1
 {
     0 1 acnt -1 add
     {
 	/idx exch def
 	actions idx get aload pop /act exch def
-	/ink act eq
+	/drop act eq
 	{
 	    aload pop setrgbcolor pop
-	    /Ir exch def /Cy exch def /Cx exch def
-	    /eps 10 scl sqrt div Ir div acnt idx sub 1 add log div def
+	    /Ir exch .001 mul def /Cy exch .001 mul def /Cx exch .001 mul def
+        /eps 10 scl sqrt div Ir 1000. mul div acnt idx sub 1 add log div def
 	    do-action
 	} if
     } for
@@ -360,7 +355,7 @@ plotdict begin
 
 /sharpen	% 0<=x<=1
 {
-    .5 sub dup abs 0.00001 lt {} {dup abs .66 exp div .63 mul} ifelse
+    .5 sub dup abs 1e-8 lt {} {dup abs .66 exp div .63 mul} ifelse
     .5 add
 } bind def
 
@@ -371,19 +366,20 @@ plotdict begin
     /cdx acnt -1 add def
     {
 	actions cdx get aload pop /ct exch def
-	ct /ink eq
-	% movement due to ink-drop.
+	ct /drop eq
+	% movement due to drop.
 	{	% px py cx cy rad^2 rgb
 	    /rgb exch def
 	    /bgc exch def
-	    /rad^2 exch dup mul def
-	    /cy exch def /cx exch def /py exch def /px exch def
+	    /rad^2 exch .001 mul dup mul def
+	    /cy exch .001 mul def /cx exch .001 mul def
+	    /py exch def /px exch def
 	    /a^2 px cx sub dup mul py cy sub dup mul add def
-	    a^2 .0000001 lt {0.} {1. rad^2 a^2 div sub} ifelse
+	    a^2 1e-10 lt {0.} {1. rad^2 a^2 div sub} ifelse
 	    /disc exch def
 	    disc 0. le
 	    {
-		disc -1 le
+		disc -1e-3 le
 		{rgb}
 		{
 		    /a disc neg sqrt sharpen def
@@ -397,27 +393,7 @@ plotdict begin
 		py cy sub a mul cy add
 	    } ifelse
 	}
-	{
-	    ct /line eq
-	    {line-deformation}
-	    {
-		ct /stroke eq
-		{stroke-deformation}
-		{
-		    ct /circle eq
-		    {circle-deformation}
-		    {
-			ct /vortex eq
-			{vortex-deformation}
-			{
-			    ct /wiggle eq
-			    {wiggle}
-			    {offset} ifelse
-			} ifelse
-		    } ifelse
-		} ifelse
- 	    } ifelse
-	} ifelse
+	{ct-dispatch} ifelse
 	/cdx cdx -1 add def
 	cdx 0 lt {pop pop background exit} if
     } loop
@@ -425,14 +401,14 @@ plotdict begin
 
 /do-raster
 {
-    loy resolution hiy
+    loy 1 hiy
     {
 	/iy exch def
-	/fy iy orgy sub scl div 1000. mul def
-	lox resolution hix
+	/fy iy orgy sub scl div 1.0 mul def
+	lox 1 hix
 	{
 	    /ix exch def
-	    /fx ix orgx sub scl div 1000. mul def
+	    /fx ix orgx sub scl div 1.0 mul def
 	    fx fy actions2rgb
 	    % color modifications
 	    % fy dup mul fx dup mul add sqrt dup
@@ -442,7 +418,7 @@ plotdict begin
 	    % ifelse
 	    % end color modifications
 	    aload pop setrgbcolor
-	    ix iy resolution dup rectfill
+	    ix iy 1 1 rectfill
 	} for
     } for
 } bind def
@@ -457,118 +433,71 @@ plotdict begin
 
 % Dimensions are relative to a 1000 x 1000 square with the origin
 % at its center.
-
-% colors are red, green, and blue components between 0 and 1.
-%/background [ 1 1 1 ] bind def
-
-% Cx Cy Ir bgc-vector rgb-vector /ink
-% dx dy xs ys /line
-% cx cy rs /circle
-
-/color1 [0.960 0.764 0.576] bind def
-/color2 [0.316 0.362 0.298] bind def
+/color1 [0.960 0.764 0.576] bind def % deep red background
+/color2 [0.316 0.362 0.298] bind def % blue
 /color3 [0.200 0.050 0.015] bind def
 /color4 [0.023 0.145 0.451] bind def
 /color5 [0.866 0.353 0.050] bind def
 /color6 [0.200 0.050 0.015] bind def
 
-/Q 1 def
-%/zsgn 1 raster-rendering? {neg} if def
-%/jdx raster-rendering? {2} {0} ifelse def
-% cx, cy center coordinates
-% dx, dy unit direction vector; dl length of displacement
-% bx, by begin coordinates; ex, ey end corrdinates
-
-% [ cx cy Ir bgc-vector rgb-vector /ink ]
-% [ dx dy {func} /wiggle ]
-% [ bx by ex ey /stroke ]
-% [ dx dy xs ys /line ]
-% [ cx cy [ rs ] /circle ]
-% [ cx cy rad /vortex ]
-% [ dx dy /offset ]
-%%----Examples----%%
-/concentric-bands {
-% This section creates even thickness concentric bands
-    32 -1 add -1 0
-    {
-	/cnt exch def
-	[ 0 0
-	  750 32
-	  div dup cnt 1 add mul dup mul exch cnt mul dup mul sub sqrt
-	  background colors cnt colors length mod get /ink ]
-    } for
-} def
-
+% Global: viscosity
 
-/strokeinks-circle {
-    -100 50 500
-    { /idx exch def
-      [ -270 idx sub -300 idx 2 mul add [ 200 idx 3 mul add ] /circle ]
-    } for
-    } def
-/color1 [0.960 0.764 0.576] bind def
-/color2 [0.316 0.362 0.298] bind def
-/color3 [0.200 0.050 0.015] bind def
-/color4 [0.023 0.145 0.451] bind def
-/color5 [0.866 0.353 0.050] bind def
-/color6 [0.200 0.050 0.015] bind def
-
-/drops {
-    100 {
-     [random:uniform pagewidth mul 1.5 mul pagewidth -2 div 1.5 mul round add    % x
-      random:uniform pageheight mul 1.5 mul pageheight -2 div 1.5 mul round add  % y
-      30 background [0.960 0.764 0.576] /ink]
-    } repeat
-    100 {
-     [random:uniform pagewidth mul 1.5 mul pagewidth -2 div 1.5 mul round add    % x
-      random:uniform pageheight mul 1.5 mul pageheight -2 div 1.5 mul round add  % y
-      30 background [0.270 0.035 0.058] /ink]
-    } repeat
-    50 {
-     [random:uniform pagewidth mul 1.5 mul pagewidth -2 div 1.5 mul round add    % x
-      random:uniform pageheight mul 1.5 mul pageheight -2 div 1.5 mul round add  % y
-     30 background [0.866 0.353 0.000  ] /ink]
-    } repeat
-%   [ 0 5 [ -800 100 800 {} for ] 0 /line]
-} def
+% [ cx cy radinc [ bgc ] [ rgb ] /drop ]
+% [ cx cy [ r ] w th D /stir ]
+% [ cx cy circ t /vortex ]
+% [ bx by ex ey V D /stroke ]
+% [ angle [ r ] V tU D /rake ]
+% [ angle {func} /wiggle ]
+% [ dx dy /offset ]
 
-% macros de pst-solides3d
-% de Jean-Paul Vignault
-%%%%% ### defpoint ###
-%% syntaxe : xA yA /A defpoint
-/defpoint {
-1 dict begin
-   /t@mp@r@ire exch def
-   [ 3 1 roll ] cvx t@mp@r@ire exch 
-end def
-} def
+/Q 1 def
 
-%%%%% ### norme ###
-%% syntaxe : u norme --> |u|
-/norme {
-   dup mul
-   exch
-   dup mul
-   add sqrt
+/concentric-bands {
+% xc yc radius increment number of bands %  [array of colors]
+% [array of colors] c'est le tableau donné en paramètres colors=
+    /nbands exch def
+    /rinc exch def
+    /yc exch def
+    /xc exch def
+ 11 -1 1
+  {
+   /rad exch sqrt rinc mul def
+   /cnt 0 def
+ nbands {
+  [ xc yc rad background colors cnt colors length mod get /drop]
+  /cnt cnt 1 add def
+                    } repeat
+ } for
+  [ xc yc rinc 2 div background colors 0 get /drop]
 } def
 
-%%%%% ### mulv ###
-%% syntaxe : u a mulv --> au
-/mulv {   %% xA, yA, a
-   dup          %% xA, yA, a, a
-   3 1 roll     %% xA, a, yA, a
-   mul 3 1 roll %% ayA, xA, a
-   mul exch
+/random-drops {
+/count exch def 
+/color exch def 
+/size exch def
+count
+{
+    [
+        random:uniform 1100 mul 550 sub
+        random:uniform 1100 mul 550 sub
+        e random:uniform exp size mul
+        background color /drop
+    ]
+    } repeat
 } def
 
-%%%%% ### normalize ###
-%% syntaxe : u normalize -> u / ||u||
-/normalize {
-2 dict begin
-   /u defpoint
-   /n u norme def
-   u 1 n div mulv
-end
+/random-drops-colors {
+/count exch def
+/size exch def
+count
+{
+    [
+        random:uniform 1100 mul 550 sub
+        random:uniform 1100 mul 550 sub
+        e random:uniform exp size mul
+        background colors random:uniform colors length mul floor cvi get /drop
+    ]
+    } repeat
 } def
 end