From c571740f80243b351c79c03e688258e374a4c110 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Fri, 19 Oct 2018 20:34:34 +0000 Subject: pst-marble (19oct18) git-svn-id: svn://tug.org/texlive/trunk@48942 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/dvips/pst-marble/pst-marble.pro | 483 +++++++++------------- 1 file changed, 206 insertions(+), 277 deletions(-) (limited to 'Master/texmf-dist/dvips') 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 -- cgit v1.2.3