From 6996a78884ca937b79a5cb3bd7da0d8ca982af98 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Thu, 2 May 2019 21:11:11 +0000 Subject: pst-marble (2may19) git-svn-id: svn://tug.org/texlive/trunk@50925 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/dvips/pst-marble/pst-marble.pro | 569 ++++++++++++++++++---- 1 file changed, 465 insertions(+), 104 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 9d02b0355d0..ca534b4d459 100644 --- a/Master/texmf-dist/dvips/pst-marble/pst-marble.pro +++ b/Master/texmf-dist/dvips/pst-marble/pst-marble.pro @@ -1,5 +1,7 @@ %%Copyright: 2018, 2019 Aubrey Jaffer -%%CreationDate: 2019-02-20 +%%CreationDate: 2019-04-16 + +% pst-marble-v1.6 % This program can redistributed and/or modified under the terms of % the LaTeX Project Public License Distributed from CTAN archives in @@ -11,9 +13,11 @@ plotdict begin /URL (http://people.csail.mit.edu/jaffer/Marbling) def /pi 3.141592653589793 def +/pio180 pi 180 div def /e 2.718281828459045 def /e^-1 1 e div def /m4o3 -4 3.0 div def +/p1o3 1 3 div def % dps define max, if not already defined systemdict /max known not { @@ -29,6 +33,8 @@ systemdict /arcsin known not { /arcsin {neg dup dup mul neg 1 add sqrt neg atan 180 sub} bind def } if +/asin { dup dup mul 1 sub neg 0 max sqrt atan } bind def + /numeric? % x --> bool { type dup /realtype eq exch /integertype eq or @@ -63,7 +69,8 @@ systemdict /arcsin known not { actions sdx get aload pop /ct exch def ct /drop eq { - pop pop pop /cy exch def /cx exch def + % cx cy rad^2 bgc rgb sr^-2 gc + pop pop pop pop pop /cy exch def /cx exch def cx cy sdx find-drop-background /bgc exch def actions sdx get 3 bgc put } @@ -71,21 +78,29 @@ systemdict /arcsin known not { ct /rake eq {pop pop pop pop pop pop} { - ct /wiggle eq - {numeric? {pop pop pop} if pop} + ct /jiggle eq + {pop pop pop pop pop pop pop pop pop} { ct /offset eq {pop pop} { - ct /vortex eq - {pop pop pop pop} + ct /turn eq + {pop pop pop} { - ct /stir eq - {pop pop pop pop pop} + ct /vortex eq + {pop pop pop pop} { - ct /stylus eq - {pop pop pop pop pop pop pop pop pop pop} - {(unrecognized token) = ct =} ifelse + ct /stir eq + {pop pop pop pop pop} + { + ct /wriggle eq + {pop pop pop pop pop pop pop} + { + ct /stylus eq + {pop pop pop pop pop pop pop pop pop pop pop} + {(unrecognized token) = ct =} ifelse + } ifelse + } ifelse } ifelse } ifelse } ifelse @@ -112,8 +127,8 @@ systemdict /arcsin known not { { /idx exch def spractions idx get aload pop /ct exch def - ct /Gaussian-spray eq - {Gaussian-spray-do} + ct /normal-spray eq + {normal-spray-do} { ct /uniform-spray eq {uniform-spray-do} @@ -139,24 +154,32 @@ systemdict /arcsin known not { /ct-dispatch { - ct /wiggle eq - {wiggle-deformation} + ct /offset eq + {offset-deformation} { - ct /offset eq - {offset-deformation} + ct /turn eq + {do-turn} { - ct /rake eq - {rake-deformation} + ct /jiggle eq + {jiggle-deformation} { - ct /vortex eq - {vortex-deformation} + ct /rake eq + {rake-deformation} { - ct /stir eq - {stir-deformation} + ct /vortex eq + {vortex-deformation} { - ct /stylus eq - {stylus-deformation} - {(unrecognized token) = ct =} ifelse + ct /stir eq + {stir-deformation} + { + ct /wriggle eq + {wriggle-deformation} + { + ct /stylus eq + {stylus-deformation} + {(unrecognized token) = ct =} ifelse + } ifelse + } ifelse } ifelse } ifelse } ifelse @@ -174,7 +197,9 @@ systemdict /arcsin known not { actions cdx get aload pop /ct exch def ct /drop eq % movement due to drop. - { % px py cx cy rad^2 bgc rgb + { % px py cx cy rad^2 bgc rgb sr^-2 gc + pop + pop /rgb exch def pop % /bgc exch def /rad^2 exch def @@ -203,26 +228,110 @@ systemdict /arcsin known not { dx add exch } bind def -/wiggle-deformation % px py dx dy period ofst depth --> px py +/do-turn % cx cy [trv] +{ + /trv exch def + /cy exch def /cx exch def + cy sub exch cx sub exch trv transform +} bind def + +% /Round {0.5 add floor} bind def + +/symmod % x m --> x +{ + 2 copy div round mul sub +} bind def + +% /cbrt % x --> x +% { +% /x exch def +% x 0 lt { -1 } { 1 } ifelse x abs p1o3 exp mul +% } bind def + +/g_1 % common code to compute inverse of non-linear deformation +{ + mdls 2 div + a 0 lt { neg } if + mf 0 gt + {1 1 af 180 div abs sub 0 max pw exp sub} + {af 180 div abs pw exp} ifelse + mul + + %% one iteration of Newton-Raphson + %% g_1=g_0-(g_0-a+(m/2)*sin(g_0*f))/(1+pi*m*f/360*cos(g_0*f)) + /g exch def + /gf g freq mul def + g + g a sub major gf sin mul add + 1 mf 2 div gf cos mul add + div + sub +} bind def + +/wriggle-deformation % px py cx cy freq major minor mf mdls pw --> px py +{ + /pw exch def + /mdls exch def + /mf exch def + /minor exch def + /major exch def + /freq exch def + /cy exch def /cx exch def + /py exch def /px exch def + /rd px cx sub dup mul py cy sub dup mul add sqrt def + /a rd mdls symmod def + /af a freq mul def + 1e-6 rd lt + { + mf 0 ne + { + g_1 + + dup a sub exch + % find the minor axis displacement from the major axis value + % where it was moved from. + freq mul cos minor mul + } + { + af cos-sin exch neg + exch major mul exch minor mul + } ifelse + % on stack are radial and angular displacements from cx,cy + px cx sub py cy sub atan add /ang exch def + rd add /rd exch def + ang cos-sin rd mul cx add exch rd mul cy add + } + { px py } ifelse +} bind def + +/jiggle-deformation % px py dx dy freq ofst [trv] major minor mf mdls pw --> px py { - dup numeric? + /pw exch def + /mdls exch def + /mf exch def + /minor exch def + /major exch def + /trv exch def + /ofst exch def + /freq exch def + /dy exch def /dx exch def + /py exch def /px exch def + /a py dx mul px dy mul add ofst add mdls symmod def + /af a freq mul def + mf 0 ne { - /depth exch def - /ofst exch def - /period exch def - /dy exch def /dx exch def - /py exch def /px exch def - /a py dx mul px dy mul sub period mul ofst add sin depth mul def + g_1 + + dup a sub exch + % find the minor axis displacement from the major axis value + % where it was moved from. + freq mul cos minor mul } { - % old-style: px py ang {func} --> px py - /func exch def /ang exch 90 sub def - /dy ang cos def /dx ang sin def - /py exch def /px exch def - /a py dx mul px dy mul sub 1000 mul func exec - 1e-3 mul oversample 0 gt {neg} if def + af cos-sin exch neg + % exch major mul exch minor mul } ifelse - px dx a mul add py dy a mul add + [ trv aload pop px py ] transform } bind def /tines % cnt spacing ofst @@ -336,13 +445,8 @@ systemdict /arcsin known not { /rad^2 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 - % p-c^2 rad^2 4096 mul gt - % { px py } - % { - /a rad^2 p-c^2 div 1 add sqrt def - py cy sub px cx sub a mul cx add exch a mul cy add - % } - % ifelse + /a rad^2 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 @@ -353,7 +457,7 @@ systemdict /arcsin known not { { actions exch get aload pop /ct exch def ct /drop eq - {pop pop spread} % pop rgb-vectors + {pop pop pop pop spread} % pop sr^-2 gc and rgb-vectors {ct-dispatch} ifelse } for } bind def @@ -374,12 +478,12 @@ systemdict /arcsin known not { actions idx get aload pop /act exch def /drop act eq { - aload pop setrgbcolor pop - /rad exch sqrt def /Cy exch def /Cx exch def - /eps 0.005 scl sqrt rad mul acnt idx sub 1 add log mul div def + pop pop aload pop setrgbcolor pop + /Rad exch sqrt def /Cy exch def /Cx exch def + /eps 0.005 scl sqrt Rad mul acnt idx sub 1 add log mul div def - rad Cx add Cy composite-map moveto - rad 0 + Rad Cx add Cy composite-map moveto + Rad 0 { dup /oy exch def Minsky-circle 2 copy @@ -415,10 +519,51 @@ systemdict /arcsin known not { res } bind def -/shade % v[3] pwr +/do-tint % v[3] pwr +{ + /pwr exch 2 exch sub def + { dup 1e-30 lt {} {pwr exp} ifelse } Vmap1 +} bind def +/do-shade % v[3] pwr { + /pwr exch 2 exch sub def + { 1 exch sub dup 1e-30 lt {} {pwr exp} ifelse 1 exch sub } Vmap1 +} bind def + +/paper-shading % v[3] pwr +{ + % /pwr exch def + % {dup 1e-30 lt {} {pwr exp} ifelse} Vmap1 /pwr exch def - {dup 1e-30 lt {} {pwr exp} ifelse} Vmap1 + paper + { + /c2 exch def + /c1 exch def + % c2 pwr mul c1 2 pwr sub mul add 2 div + c2 c1 ge + { 1 1 c1 c2 div sub dup 1e-30 lt {} {pwr exp} ifelse sub c2 mul } + { + 1 c1 sub 1 c2 sub div dup + 1e-30 lt {} {2 pwr sub exp} ifelse 1 c2 sub mul 1 exch sub + } ifelse + } Vmap2 +} bind def + +% Exposed to user +/tint % v[3] pwr +{ + dup 0 lt + { neg exch color-norm exch do-shade } + { exch color-norm exch do-tint } + ifelse +} bind def +% Exposed to user +/shade % v[3] pwr +{ + dup 0 lt + { neg exch color-norm exch do-tint } + { exch color-norm exch do-shade } + ifelse } bind def /sharpen % 0<=x<=1 @@ -436,7 +581,9 @@ systemdict /arcsin known not { actions cdx get aload pop /ct exch def ct /drop eq % movement due to drop. - { % px py cx cy rad^2 bgc rgb + { % px py cx cy rad^2 bgc rgb sr^-2 gc + /gc exch def + /sr^-2 exch def /rgb exch def /bgc exch def /rad^2 exch def @@ -446,12 +593,17 @@ systemdict /arcsin known not { /disc a^2 1e-10 lt {0} {1 rad^2 a^2 div sub} ifelse def disc 0 le { - disc -0.001 le - {rgb} + rgb gc 0 ne + { + e a^2 sr^-2 mul exp gc mul paper-shading + } + if + disc -0.001 gt { /a disc neg sqrt sharpen def - rgb bgc {1 a sub mul exch a mul add} Vmap2} - ifelse + bgc {1 a sub mul exch a mul add} Vmap2 + } + if exit } { @@ -466,6 +618,61 @@ systemdict /arcsin known not { } loop } bind def +% At this point, fx and fy contain the raster coordinates; +% [ r g b ] is on top of the stack. +/do-shadings +{ + /scnt shadings length def + scnt 0 gt + { + 0 1 scnt -1 add + { + /idx exch def + shadings idx get aload pop /ct exch def + ct /jiggle-shade eq + { + % [ dx dy freq ofst major mf mdls pw ] + /pw exch def + /mdls exch def + /mf exch def + /major exch def + /ofst exch def + /freq exch def + /dy exch def /dx exch def + /a fy dx mul fx dy mul add ofst add mdls symmod def + /af a freq mul def + mf 0 ne + { + g_1 + freq mul cos mf mul 1 add 0 max paper-shading + } if + } + { + ct /wriggle-shade eq + { + % [ cx cy freq ofst major mf mdls pw ] + /pw exch def + /mdls exch def + /mf exch def + /major exch def + /ofst exch def + /freq exch def + /cy exch def /cx exch def + /a fx cx sub dup mul fy cy sub dup mul add sqrt + ofst add mdls symmod def + /af a freq mul def + mf 0 ne + { + g_1 + freq mul cos mf mul 1 add 0 max paper-shading + } if + } + {(unrecognized shade token) = ct =} ifelse + } ifelse + } for + } if +} bind def + /do-raster { /sampleover 1 oversample div def @@ -478,13 +685,9 @@ systemdict /arcsin known not { /ix exch def /fx ix scl div 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 + + do-shadings % color modifications + aload pop setrgbcolor newpath ix iy moveto sampleover 0 rlineto 0 sampleover rlineto sampleover neg 0 rlineto closepath FILL @@ -492,13 +695,15 @@ systemdict /arcsin known not { } for } bind def -% [ cx cy rad^2 [ bgc ] [ rgb ] /drop ] +% [ cx cy rad^2 bgc rgb sr^-2 gc /drop ] % [ cx cy [ r ] th L^-1 /stir ] % [ cx cy circ t /vortex ] % [ bx by ex ey L tU rpts nx ny stpx stpy /stylus ] % [ dx dy [ rs ] V tU L^-1 /rake ] -% [ dx dy period ofst depth /wiggle ] +% [ dx dy freq ofst [trv] major minor mf mdls pw /jiggle ] +% [ cx cy freq major minor mf mdls pw /wriggle ] % [ dx dy /offset ] +% [ cx cy [trv] /turn ] /concatstrings % (a) (b) -> (ab) { exch dup length @@ -518,7 +723,13 @@ systemdict /arcsin known not { rgb 256 mod 255 div ] def } if - rgb {1 gt} forall or or { [ rgb {255 div} forall ] } { rgb } ifelse + rgb length 2 eq + { [ rgb aload pop color-norm ] } + { + rgb {1 gt} forall or or { [ rgb {255 div} forall ] } { rgb } ifelse + {1e-9 max 0.999 min} Vmap1 + } + ifelse } bind def /color-norm* @@ -528,13 +739,26 @@ systemdict /arcsin known not { [ clr* {color-norm} forall ] } bind def -/drop % cx cy rad^2 rgb +/edgy-color { - /rgb exch def + exch color-norm 2 array astore +} bind def + +/drop % cx cy rad rgb +{ + /rgb exch color-norm def /rad^2 exch .001 mul dup mul def /cy exch .001 mul def /cx exch .001 mul def - [ cx cy rad^2 -1 rgb color-norm /drop ] + /es rgb length 2 eq { rgb 0 get } { 0 } ifelse def + % [ cx cy rad^2 bgc rgb sr^-2 gc /drop ] + [ cx cy + rad^2 + -1 % bgc + rgb length 2 eq { rgb 1 get } { rgb } ifelse % rgb + es rad^2 div % sr^-2 + es 0 gt { e es exp 1 sub es div e es exp div } { 1 } ifelse % gc + /drop ] } bind def /vortex % cx cy circ tcoef @@ -587,18 +811,105 @@ systemdict /arcsin known not { /wiggle % angle period ofst depth { - dup numeric? - { - /depth exch def - /ofst exch def - /period exch def - /ang exch 90 sub def - [ ang cos-sin exch - 1000 360 div period mul - ofst - depth 1e-3 mul oversample 0 gt {neg} if /wiggle ] } - { /wiggle 3 array astore } - ifelse + /depth exch def + /ofst exch 90 add def + /period exch 360 dup mul exch div def + /ang exch def + ang period ofst 0.75 div depth 2 mul 0 exch jiggle +} bind def + +/jiggle % angle period ofst major minor +{ + /minor exch -0.5e-3 mul def + /major exch 0.5e-3 mul def + /ofst exch 1e-3 mul def + /period exch def + /freq 360e3 period div def + /ang exch def + /mf oversample 0 le { 0 } { major freq mul pio180 mul } ifelse def + /pw 4 3 div 1 mf abs add div def + % [ dx dy freq ofst [trv] major minor mf mdls pw ] + [ ang cos-sin % dx, dy + freq + ofst + mf 0 ne + { [ ang cos-sin exch 2 copy neg exch ] } + { [ ang cos-sin major mul exch major mul + ang cos-sin minor mul exch minor mul + neg exch ] } + ifelse % [ trv ] + major + minor + mf + 360 freq div abs % mdls + pw + /jiggle ] +} bind def + +/wriggle % cx cy period major minor +{ + /minor exch -0.5 mul def % is angular range + /major exch 0.5e-3 mul def + /period exch def + /freq 360e3 period div def + /cy exch 1e-3 mul def /cx exch 1e-3 mul def + /mf oversample 0 le { 0 } { major freq mul pio180 mul } ifelse def + /pw 4 3 div 1 mf abs add div def + % [ cx cy freq major minor mf mdls pw ] + [ cx + cy + freq + major + minor + mf + 360 freq div abs % mdls + pw + /wriggle ] +} bind def + +/wriggle-shade % cx cy period ofst major +{ + /major exch 0.5e-3 mul def + /ofst exch 1e-3 mul def + /period exch def + /freq 360e3 period div def + /cy exch 1e-3 mul def /cx exch 1e-3 mul def + /mf major freq mul pio180 mul def + /pw 4 3 div 1 mf abs add div def + % [ cx cy freq ofst major mf mdls pw ] + [ cx + cy + freq + ofst + major + mf + 360 freq div abs % mdls + pw + /wriggle-shade ] +} bind def + +/jiggle-shade % angle period ofst major +{ + /major exch 0.5e-3 mul def + /ofst exch 1e-3 mul def + /period exch def + /freq 360e3 period div def + /ang exch def + /mf major freq mul pio180 mul def + /pw 4 3 div 1 mf abs add div def + % [ dx dy freq ofst major mf mdls pw ] + [ ang cos-sin % dx, dy + freq + ofst + major + mf + 360 freq div abs % mdls + pw + /jiggle-shade ] +} bind def +/shading % angle period ofst major +{ + jiggle-shade } bind def /shift % angle r @@ -610,6 +921,19 @@ systemdict /arcsin known not { [ dx dy /offset ] } bind def +/turn % cx cy angle +{ + /th exch def + /cy exch .001 mul def + /cx exch .001 mul def + % [ cx cy [ trv ] ] + [ cx + cy + [ th oversample 0 gt {neg} if neg cos-sin 2 copy neg exch cx cy ] + /turn + ] +} bind def + /concentric-rings % xc yc thick [ color ] count { /cnt exch def @@ -741,15 +1065,30 @@ systemdict /arcsin known not { /cnt exch def /clra exch color-norm* def /eccentricity exch sqrt def + /angle exch def + /r exch 2 mul def + /yc exch def + /xc exch def + xc yc + r eccentricity div r eccentricity mul + angle clra cnt drad normal-drops +} bind def + +/normal-drops % xc yc L_x L_y angle [ rgb ] cnt drad +{ + /drad exch def + /cnt exch def + /clra exch color-norm* def /angle exch neg def - /r exch 2 sqrt div def + /R_y exch 8 sqrt div def + /R_x exch 8 sqrt div def /yc exch def /xc exch def /nclr clra length def /cdx 0 def cnt { - random:normal2 eccentricity div r mul exch eccentricity mul r mul + random:normal2 R_x mul exch R_y mul [ angle cos-sin 2 copy neg exch xc yc ] transform drad clra cdx nclr mod get drop /cdx cdx 1 add def @@ -758,28 +1097,47 @@ systemdict /arcsin known not { /Gaussian-spray % xc yc r angle eccentricity [ rgb ] cnt drad { - /Gaussian-spray 9 array astore + /drad exch def + /cnt exch def + /clra exch color-norm* def + /eccentricity exch sqrt def + /angle exch def + /r exch 2 mul def + /yc exch def + /xc exch def + xc yc + r eccentricity div r eccentricity mul + angle clra cnt drad 1 3 div exp normal-spray +} bind def + +/normal-spray % xc yc L_x L_y angle [ rgb ] cnt drad +{ + /normal-spray 9 array astore } bind def -/Gaussian-spray-do % xc yc r angle eccentricity [ rgb ] cnt drad +/normal-spray-do % xc yc L_x L_y angle [ rgb ] cnt drad { /drad exch def /cnt exch def /clra exch color-norm* def - /eccentricity exch sqrt def /angle exch neg def - /r exch 2 sqrt div def - /yc exch def - /xc exch def + /R_y exch 8 sqrt div .001 mul def + /R_x exch 8 sqrt div .001 mul def + /yc exch .001 mul def + /xc exch .001 mul def /nclr clra length def /cdx 0 def cnt { - random:normal2 eccentricity div r mul exch eccentricity mul r mul + % random:normal2 eccentricity div r mul exch eccentricity mul r mul + random:normal2 R_x mul exch R_y mul [ angle cos-sin 2 copy neg exch xc yc ] transform + /fy exch def /fx exch def + clra cdx nclr mod get + do-shadings aload pop setrgbcolor newpath - clra cdx nclr mod get aload pop setrgbcolor - e random:normal2 pop drad log 3 mul add 3 div exp 0 360 arc fill + fx 1000 mul fy 1000 mul + e random:normal2 pop drad log 9 mul add 3 div exp 0 360 arc fill /cdx cdx 1 add def } repeat } bind def @@ -817,10 +1175,10 @@ systemdict /arcsin known not { /cnt exch def /clra exch color-norm* def /angle exch neg def - /ysid exch def - /xsid exch def - /yc exch def - /xc exch def + /ysid exch .001 mul def + /xsid exch .001 mul def + /yc exch .001 mul def + /xc exch .001 mul def /nclr clra length def /cdx 0 def cnt @@ -828,9 +1186,12 @@ systemdict /arcsin known not { random:uniform 0.5 sub xsid mul random:uniform 0.5 sub ysid mul [ angle cos-sin 2 copy neg exch xc yc ] transform + /fy exch def /fx exch def + clra cdx nclr mod get + do-shadings aload pop setrgbcolor newpath - clra cdx nclr mod get aload pop setrgbcolor - e random:normal2 pop drad log 3 mul add 3 div exp 0 360 arc fill + fx 1000 mul fy 1000 mul + e random:normal2 pop drad log 9 mul add 3 div exp 0 360 arc fill /cdx cdx 1 add def } repeat } bind def -- cgit v1.2.3