From f019cbf3107bf60bc648746eb7e2e969c0c494df Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Mon, 24 Sep 2018 20:20:46 +0000 Subject: pst-marble (24sep18) git-svn-id: svn://tug.org/texlive/trunk@48747 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/dvips/pst-marble/pst-marble.pro | 578 ++++++++++++++++++++++ 1 file changed, 578 insertions(+) create mode 100644 Master/texmf-dist/dvips/pst-marble/pst-marble.pro (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 new file mode 100644 index 00000000000..60a36806480 --- /dev/null +++ b/Master/texmf-dist/dvips/pst-marble/pst-marble.pro @@ -0,0 +1,578 @@ +%%Copyright: 2018 Aubrey Jaffer +%%Creator: Aubrey Jaffer +%%For: Voluntocracy +%%CreationDate: 2018-09-13 +/plotdict 70 dict def +plotdict begin + +/pi 3.141592653589793 def +/e 2.718281828459045 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 +{ + /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 +% 0 setlinewidth + reverse-rendering? + { + matrix currentmatrix aload pop 6 {round 6 1 roll} repeat + matrix astore setmatrix newpath + } if +% clippath pathbbox /hiy exch round cvi def /hix exch round cvi def +% /loy exch round cvi def /lox exch round cvi def + reverse-rendering? not {background aload pop setrgbcolor fill} if + /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 + 0 1 acnt -1 add + { + /sdx exch def + actions sdx get aload pop /ct exch def + ct /ink eq + { + pop pop pop /cy exch def /cx exch def + cx cy sdx find-ink-background /bgc exch def + actions sdx get 3 bgc put + } + { + ct /line eq + {pop pop pop pop} + { + ct /stroke eq + {pop pop pop pop pop} + { + ct /circle eq ct /vortex eq or + {pop pop pop} + { + ct /wiggle eq + {pop pop pop} + { + ct /offset eq + {pop pop} + {(unrecognized token) = ct =} + } ifelse + } ifelse + } ifelse + } ifelse + } ifelse + } for + reverse-rendering? + { + do-raster + } + { +% orgx orgy translate + scl 1000. div dup scale + do-inks + } 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 +{ + /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. + { % 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 + /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 + disc 0. le + {rgb exit} + { + /a disc sqrt def + px cx sub a mul cx add + 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 + /cdx cdx -1 add def + } loop +} bind def + +/offset % px py dx dy --> px py +{ + /dy exch def /dx exch 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 +{ + /func exch def + /dy exch def /dx exch def + /py exch def /px exch def + /a py dx mul px dy mul sub func exec 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 +{ + /wid exch def + reverse-rendering? { 4 2 roll } if + /ey exch def /ex exch def + /by exch def /bx exch 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 + {} + { + /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 + /tU tU rpts div 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 + /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 + /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 + } for + } ifelse + px py +} bind def + +/line-deformation % px py dx dy xs ys --> px py +{ + /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 +} bind def + +/circle-deformation % px py cx cy rs --> px py +{ + /rs exch def + /cy exch def /cx exch 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 + a add def + } forall + 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 +{ + /rad exch def + /cy exch def /cx exch 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 + 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 +{ + /rad exch def /cy exch def /cx exch 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 +} bind def + +%% Given x, y coordinates on stack, calculates movement due to +%% subsequent operations. +/composite-map +{ + idx 1 add 1 acnt -1 add + { + actions exch get aload pop /ct exch def + ct /ink 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 + } for +} bind def + +% Given x, y coordinates on stack and eps < 2, leaves x, y on stack +% for next point on the circle centered at origin. +/Minsky-circle +{ + dup 3 1 roll eps mul sub dup eps mul 3 2 roll add +} bind def + +% Draws and fills circle as distorted by composite-map +/do-action +{ + Ir Cx add Cy composite-map moveto + Ir 0 + { + dup /oy exch def + Minsky-circle 2 copy + exch Cx add exch Cy add % shift center of ink + composite-map lineto + dup 0 gt oy 0 lt and {exit} if + } loop + pop pop + closepath Contours +} bind def + +% Fills (distorted) circles. +/do-inks % 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 + { + 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 + do-action + } if + } for +} bind def + +%% Functions used for reverse-rendering: + +/Vmap1 % v1 proc +{ + /proc exch def + /v1 exch def + [ v1 + { + proc exec + } forall + ] +} bind def + +/Vmap2 % v1 v2 proc +{ + /proc exch def + /v2 exch def + /idx 0 def + /res v2 length array def + { + res exch idx exch v2 idx get proc exec put + /idx idx 1 add def + } forall + res +} bind def + +/shade % v[3] pwr +{ + /pwr exch def + {dup 1e-30 lt {} {pwr exp} ifelse} Vmap1 +} bind def + +/sharpen % 0<=x<=1 +{ + .5 sub dup abs 0.00001 lt {} {dup abs .66 exp div .63 mul} ifelse + .5 add +} bind def + +%% Given x, y coordinates on stack, calculates the rgb vector +%% acnt is index +1 of last operation. +/actions2rgb +{ + /cdx acnt -1 add def + { + actions cdx get aload pop /ct exch def + ct /ink eq + % movement due to ink-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 + /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 + /disc exch def + disc 0. le + { + disc -1 le + {rgb} + { + /a disc neg sqrt sharpen def + rgb bgc {1 a sub mul exch a mul add} Vmap2} + ifelse + exit + } + { + /a disc sqrt def + px cx sub a mul cx add + 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 + /cdx cdx -1 add def + cdx 0 lt {pop pop background exit} if + } loop +} bind def + +/do-raster +{ + loy resolution hiy + { + /iy exch def + /fy iy orgy sub scl div 1000. mul def + lox resolution hix + { + /ix exch def + /fx ix orgx sub scl div 1000. mul def + fx fy actions2rgb + % color modifications + % fy dup mul fx dup mul add sqrt dup + % riplim lt + % {180. ripple div mul sin abs .75 mul 1 exch sub shade} + % {pop} + % ifelse + % end color modifications + aload pop setrgbcolor + ix iy resolution dup rectfill + } for + } for +} bind def + +%% Controls and Design: + +% Returns number between 0. and 1. +/random:uniform +{ + rand 2147483647. div +} bind def + +% 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 +/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 + + +/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 + +% 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 + +%%%%% ### norme ### +%% syntaxe : u norme --> |u| +/norme { + dup mul + exch + dup mul + add sqrt +} 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 +} def + +%%%%% ### normalize ### +%% syntaxe : u normalize -> u / ||u|| +/normalize { +2 dict begin + /u defpoint + /n u norme def + u 1 n div mulv +end +} def +end + + + + + -- cgit v1.2.3