%%Copyright: 2018, 2019 Aubrey Jaffer %%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 % directory macros/latex/base/lppl.txt; either version 1.3c of the % License, or (at your option) any later version. /plotdict 100 dict def 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 { /max { /arg1 exch def/arg2 exch def arg1 arg2 gt {arg1}{arg2}ifelse } def /min { /arg1 exch def/arg2 exch def arg1 arg2 lt {arg1}{arg2}ifelse } def } if % dps asin definition from mst-math.pro used here 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 } bind def /cos-sin % th --> sin-th cos-th { dup cos exch sin } bind def % negative viscosity for (raster) reverse-marbling /marble % nu (viscosity) { % dup /nu exch 1e-6 mul abs def % /reverse-rendering? oversample 0 gt def % 0 setlinewidth oversample 0 gt { 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 % oversample 0 gt not {background aload pop setrgbcolor fill} if /scl hiy loy sub hix lox sub max overscan div def /acnt actions length def /pcnt spractions 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 /drop eq { % 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 } { ct /rake eq {pop pop pop pop pop pop} { ct /jiggle eq {pop pop pop pop pop pop pop pop pop} { ct /offset eq {pop pop} { ct /turn eq {pop pop pop} { ct /vortex eq {pop pop pop pop} { 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 } ifelse } ifelse } ifelse } for oversample 0 gt { do-raster } { gsave scl dup scale do-drops grestore } ifelse % post-actions pcnt 0 gt { gsave scl 1000 div dup scale 0 1 pcnt -1 add { /idx exch def spractions idx get aload pop /ct exch def ct /normal-spray eq {normal-spray-do} { ct /uniform-spray eq {uniform-spray-do} {(unrecognized post token) = ct =} ifelse } ifelse } for grestore } if overscan 1 gt { gsave 1 setlinewidth 1 overscan div dup scale 0 setgray [ 10 10 ] 0 setdash lox loy hix lox sub hiy loy sub rectstroke 1 setgray [ 10 10 ] 10 setdash lox loy hix lox sub hiy loy sub rectstroke grestore } if } bind def /ct-dispatch { ct /offset eq {offset-deformation} { ct /turn eq {do-turn} { ct /jiggle eq {jiggle-deformation} { ct /rake eq {rake-deformation} { ct /vortex eq {vortex-deformation} { ct /stir eq {stir-deformation} { ct /wriggle eq {wriggle-deformation} { ct /stylus eq {stylus-deformation} {(unrecognized token) = ct =} ifelse } ifelse } 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 /drop eq % movement due to drop. { % px py cx cy rad^2 bgc rgb sr^-2 gc pop pop /rgb exch def pop % /bgc exch def /rad^2 exch 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-dispatch} ifelse /cdx cdx -1 add def } loop } bind def /offset-deformation % px py dx dy --> px py { /dy exch def /dx exch def dy add exch dx add exch } bind def /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 { /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 { 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 [ trv aload pop px py ] transform } bind def /tines % cnt spacing ofst { /ofst exch def /spacing exch def /cnt exch def /hint cnt 1 sub -2 div cvi def hint 1 cnt 1 sub hint add { spacing mul ofst add } for } bind def /stylus-deformation % px py bx by ex ey L tU rpts nx ny stpx stpy --> px py { /stpy exch def /stpx exch def /ny exch def /nx exch def /rpts exch def /tU exch def /L exch def /ey exch def /ex exch def /by exch def /bx exch def /py exch def /px exch def /inx 0 def /iny 0 def 1 1 rpts { pop /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 /denr r L div def denr 6 lt denr 0 gt and { /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 denr 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 } if /bx ex def /by ey def /ex ex stpx add def /ey ey stpy add def } for px py } bind def /rake-deformation % [ dx dy [ rs ] V tU L^-1 /rake ] { /L^-1 exch def /tU exch def /V exch def /rs exch def /dy exch def /dx exch def /py exch def /px exch def /a 0 def rs { /r exch 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 px dx a mul add py dy a mul add } bind def /stir-deformation % [ cx cy [ rs ] th L^-1 /stir ] { /L^-1 exch def /th exch def /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 1e-6 p-c lt { rs { /r exch def /a p-c r abs sub abs L^-1 r abs div mul e^-1 exch exp th mul r 0 gt {neg} if a add def } forall oversample 0 gt {/a a neg def} if px cx sub py cy sub [ a cos-sin 2 copy neg exch cx cy ] transform } {px py} ifelse } bind def % An irrotational vortex. circ is circulation; t is time in seconds /vortex-deformation % px py cx cy circ t --> px py { /tcoef exch def /circ 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 1e-6 lt { px py } { /a nuterm p-c^2 tcoef mul .75 exp add m4o3 exp circ mul def px cx sub py cy sub [ a cos-sin 2 copy neg exch cx cy ] transform } ifelse } bind def %% Functions used for forward rendering: % movement due to drop. /spread % px py cx cy rad^2 --> px py { /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 /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 %% subsequent operations. /composite-map { idx 1 add 1 acnt -1 add { actions exch get aload pop /ct exch def ct /drop eq {pop pop pop pop spread} % pop sr^-2 gc and rgb-vectors {ct-dispatch} 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-drops % acnt = index of last action + 1 { 0 1 acnt -1 add { /idx exch def actions idx get aload pop /act exch def /drop act eq { 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 { dup /oy exch def Minsky-circle 2 copy exch Cx add exch Cy add % shift center of drop composite-map lineto dup 0 gt oy 0 lt and {exit} if } loop pop pop closepath Contours } 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 /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 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 { .5 sub dup abs 1e-8 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 /drop eq % movement due to drop. { % 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 /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 /disc a^2 1e-10 lt {0} {1 rad^2 a^2 div sub} ifelse def disc 0 le { 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 bgc {1 a sub mul exch a mul add} Vmap2 } if exit } { /a disc sqrt def px cx sub a mul cx add py cy sub a mul cy add } ifelse } {ct-dispatch} ifelse /cdx cdx -1 add def cdx 0 lt {pop pop background exit} if } 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 loy sampleover hiy { /iy exch def /fy iy scl div def lox sampleover hix { /ix exch def /fx ix scl div def fx fy actions2rgb do-shadings % color modifications aload pop setrgbcolor newpath ix iy moveto sampleover 0 rlineto 0 sampleover rlineto sampleover neg 0 rlineto closepath FILL } for } for } bind def % [ 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 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 2 index length add string dup dup 4 2 roll copy length 4 -1 roll putinterval } bind def /color-norm % rgb { /rgb exch def rgb type /stringtype eq { /rgb (16#) rgb concatstrings cvi def /rgb [ rgb 65536 idiv 255 div rgb 256 idiv 256 mod 255 div rgb 256 mod 255 div ] def } if 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* { /clr* exch def clr* 0 get type dup /arraytype ne exch /stringtype ne and { /clr* [ clr* ] def } if [ clr* {color-norm} forall ] } bind def /edgy-color { 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 /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 { /t exch def /circ exch -1e-6 mul 180 pi div mul oversample 0 gt {neg} if def /cy exch .001 mul def /cx exch .001 mul def /tcoef 2 pi mul t div def /nuterm visc 1e-6 mul abs 4 mul .75 exp def [ cx cy circ tcoef /vortex ] } bind def /stylus % bx by ex ey V D { /D exch .001 mul def /V exch .001 mul abs def oversample 0 gt { 4 2 roll } if % reverse-rendering? /ey exch .001 mul def /ex exch .001 mul def /by exch .001 mul def /bx exch .001 mul def /L V D dup mul mul visc 1e-6 mul abs div def /tU ex bx sub dup mul ey by sub dup mul add sqrt def /rpts tU L div ceiling cvi def /nx ex bx sub tU div def /ny ey by sub tU div def /tU tU rpts div 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 1e-6 tU le { [ bx by ex ey L tU rpts nx ny stpx stpy /stylus ] } if } bind def /stroke {stylus} bind def /stir % cx cy [ r ] w th D { /D exch .001 mul def /th exch def /w exch abs def /rs exch def /cy exch .001 mul def /cx exch .001 mul def /L^-1 visc 1e-6 mul abs w pi 180 div mul D dup mul mul div def [ cx cy [ rs {.001 mul} forall ] th L^-1 /stir ] } bind def /rake % angle [ r ] V tU D { /D exch .001 mul def /tU exch .001 mul def /V exch .001 mul abs def /rs exch def /ang exch def [ ang cos-sin exch [ rs {.001 mul} forall ] V tU oversample 0 gt {neg} if visc 1e-6 mul abs V D dup mul mul div % L^-1 /rake ] } bind def /wiggle % angle period ofst depth { /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 { /r exch .001 mul def /th exch def /dx th sin r mul oversample 0 gt {neg} if def /dy th cos r mul oversample 0 gt {neg} if def [ 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 /clra exch color-norm* def /rinc exch def /yc exch def /xc exch def /nclr clra length def cnt 1 sub -1 0 { /cnt exch def cnt 0 le { xc yc rinc clra 0 get drop } { xc yc cnt 2 mul 1 add sqrt rinc mul clra cnt nclr mod get drop } ifelse } for } bind def /coil-drops % xc yc r ang-strt arcinc rinc [ rgb ] cnt drad { /drad exch def /cnt exch def /clra exch color-norm* def /rinc exch def /arcinc exch def /th exch def /r exch def /yc exch def /xc exch def /nclr clra length def /cdx 0 def cnt { th cos-sin r mul xc add exch r mul yc add drad clra cdx nclr mod get drop /th th arcinc r div -1 max 1 min arcsin add def /r r rinc add def /cdx cdx 1 add def } repeat } bind def /line-drops % xc yc ang [ r ] [ rgb ] drad { /drad exch def /clra exch color-norm* def /rs exch def /th exch def /yc exch def /xc exch def /nclr clra length def /cdx 0 def rs { /r exch def th cos-sin r mul xc add exch r mul yc add drad clra cdx nclr mod get drop /cdx cdx 1 add def } forall } bind def % Copyright (C) 1996-1998 Geoffrey Keating. % This file may be freely distributed with or without modifications, % so long as modified versions are marked as such and copyright % notices are not removed. % Modified for PRNG use by Aubrey Jaffer 2019. % An implementation of an algorithm compatible with the RSA Data Security % Inc. RC4 stream encryption algorithm. % rc4setkey /rc4setkey { 6 dict begin /k exch def /a 256 string def 0 1 255 { a exch dup put } for /l k length def /j 0 def 0 1 255 { /i exch def /j a i get k i l mod get add j add 255 and def a i a j get a j a i get put put } for 3 dict dup begin /a a def /x 0 def /y 0 def end end } bind def % rc4 /rc4 { 1 index begin dup dup length 1 sub 0 exch 1 exch { /x x 1 add 255 and def /y a x get y add 255 and def a x a y get a y a x get put put % stack: string string index 2 copy get a dup x get a y get add 255 and get xor put dup } for pop end } bind def % Returns number between 0 and 1 /random:uniform { /str 7 string def 0 1 str length -1 add { str exch 0 put } for seed str rc4 exch pop 0 exch {add 256. div} forall } bind def % Returns pair of normally distributed numbers. /random:normal2 { /rnt random:uniform 360 mul def /rnr random:uniform ln -2 mul sqrt def rnt cos-sin exch rnr mul exch rnr mul } bind def /Gaussian-drops % xc yc r angle eccentricity [ rgb ] cnt drad { /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 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_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 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 } repeat } bind def /Gaussian-spray % xc yc r angle eccentricity [ rgb ] cnt drad { /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 /normal-spray-do % 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_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 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 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 /uniform-drops % xc yc xsid ysid angle [ rgb ] cnt drad { /drad exch def /cnt exch def /clra exch color-norm* def /angle exch neg def /ysid exch def /xsid exch def /yc exch def /xc exch def /nclr clra length def /cdx 0 def cnt { random:uniform 0.5 sub xsid mul random:uniform 0.5 sub ysid mul [ angle cos-sin 2 copy neg exch xc yc ] transform drad clra cdx nclr mod get drop /cdx cdx 1 add def } repeat } bind def /uniform-spray % xc yc xsid ysid angle [ rgb ] cnt drad { /uniform-spray 9 array astore } bind def /uniform-spray-do % xc yc xsid ysid angle [ rgb ] cnt drad { /drad exch def /cnt exch def /clra exch color-norm* def /angle exch neg 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 { 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 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 /serpentine-drops % xc yc [ xrs ] [ yrs ] th [ rgb ] drad { /drad exch def /clra exch color-norm* def /th exch neg def /yrs exch def /xrs exch def /yc exch def /xc exch def /nclr clra length def /par 0 def /cdx 0 def yrs { /yr exch def par 0 eq { 0 1 xrs length 1 sub } { xrs length 1 sub -1 0 } ifelse { /xdx exch def /xr xrs xdx get def xr yr [ th cos-sin 2 copy neg exch xc yc ] transform drad clra cdx nclr mod get drop /cdx cdx 1 add def } for /par 1 par sub def } forall } bind def end % Local Variables: % mode: PS % End: