%%Creator: Aubrey Jaffer %%For: Voluntocracy %%Copyright: 2018 Aubrey Jaffer %%Creator: Aubrey Jaffer %%For: Voluntocracy %%CreationDate: 2018-10-19 /plotdict 100 dict def plotdict begin /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 viscosity for (raster) reverse-marbling /marble % nu (viscosity) { dup /nu exch 1e-6 mul abs def /reverse-rendering? exch 0 lt 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 /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 /drop eq { 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 /vortex eq {pop pop pop pop} { ct /stroke eq ct /rake eq or {pop pop pop pop pop} { ct /stir eq {pop pop pop pop pop pop} { ct /wiggle eq {pop pop} { ct /offset eq {pop pop} {(unrecognized token) = ct =} ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } for reverse-rendering? { do-raster } { orgx orgy translate scl 1.0 div dup scale do-drops } ifelse } bind def /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 /drop eq % movement due to drop. { % px py cx cy rad rgb /rgb exch def pop % /bgc 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 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 % px py dx dy --> px py { /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 ang {func} --> px py { /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 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 V D --> px py { /D exch .001 mul def /V exch .001 mul abs def reverse-rendering? { 4 2 roll } if /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 /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 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 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 /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 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 } for } if px py } bind def /rake-deformation % [ ang [ rs ] V tU D /rake ] { /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 /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 .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 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 /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 % An irrotational vortex. circ is circulation; t is time in seconds /vortex-deformation % px py cx cy circ t --> px py { /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^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 drop. /spread % px py cx cy rad --> px py { /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 } 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 spread} % pop 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-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 drop composite-map lineto dup 0 gt oy 0 lt and {exit} if } loop pop pop closepath Contours } bind def % Fills (distorted) circles. /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 { aload pop setrgbcolor pop /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 } 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 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 rgb /rgb exch def /bgc 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 disc 0. le { disc -1e-3 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-dispatch} ifelse /cdx cdx -1 add def cdx 0 lt {pop pop background exit} if } loop } bind def /do-raster { loy 1 hiy { /iy exch def /fy iy orgy sub scl div 1.0 mul def lox 1 hix { /ix exch 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 % riplim lt % {180. ripple div mul sin abs .75 mul 1 exch sub shade} % {pop} % ifelse % end color modifications aload pop setrgbcolor ix iy 1 1 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. /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 % Global: viscosity % [ 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 ] /Q 1 def /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 /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 /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