%!PS-Adobe-2.0 %%Pages: 1 %%Title: Marbling Topological Graphic %%Copyright: 2004 Aubrey Jaffer %%Creator: Aubrey Jaffer %%For: Voluntocracy %%CreationDate: 2004-02-23 %%BoundingBox: 0 0 360 360 %%EndComments /URL (http://swiss.csail.mit.edu/~jaffer/Geometry/Marbling) 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 sub abs c add z.c exch div a add /a exch def } forall } { /py-yf*dx py ys sub dx mul def xs { px sub dy mul py-yf*dx sub abs c add z.c exch div a add /a exch def } forall } ifelse px dx a mul add py dy a mul add } bind def /Show-line { /ys exch def /xs exch def /dy exch def /dx exch def % /py exch def /px exch def ys type /arraytype eq { ys {newpath dup dy scl mul sub xs dx scl mul sub exch moveto xs dx scl mul add exch dy scl mul add lineto stroke} forall } { xs {newpath dup dx scl mul sub ys dy scl mul sub moveto ys dy scl mul add exch dx scl mul add exch lineto stroke} forall } ifelse } 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 z.c.2.pi p-c r abs sub abs c add div 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 /Show-circle { /rs exch def /cy exch def /cx exch def % /py exch def /px exch def rs {/r exch def newpath cx cy r 0 360 arc stroke} forall } bind def /Unitize % dx dy { 2 copy dup mul exch dup mul add sqrt /a exch def a div exch a div exch } bind def % Given x, y coordinates on stack, calculates combed coordinates. /Composite-map { /line-mapper exch def /circle-mapper exch def exch 180 add exch 240 add % offset to center; compensate for upward draw 0 -1 [ 0 25 50 75 100 125 150 175 200 225 250 275 300 325 350 375 ] 0 line-mapper exec dup 2 mul sin 45 mul 3 2 roll add exch % add sinusoidal wiggle 0 1 [ 125 325 ] 0 line-mapper exec dup 2 mul sin -90 mul 3 2 roll add exch % add sinusoidal wiggle -12 add 0 1 [ 25 225 425 ] 0 line-mapper exec dup 2 mul sin 45 mul 3 2 roll add exch % add sinusoidal wiggle } 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 combings. /do-ink { ix 0 {Circle-deformation} {Line-deformation} Composite-map moveto ix 0 { dup /oy exch def Minsky-circle 2 copy {Circle-deformation} {Line-deformation} Composite-map lineto dup 0 gt oy 0 lt and {exit} if } loop pop pop closepath fill % stroke } bind def % Fills concentric (distorted) circles. /do-inks { /eps 0.25 ix div def { {0.960 0.764 0.576 setrgbcolor} {0.316 0.362 0.298 setrgbcolor} {0.200 0.000 0.015 setrgbcolor} {0.023 0.145 0.451 setrgbcolor} {0.866 0.353 0.000 setrgbcolor} {0.200 0.000 0.015 setrgbcolor} } { /clr exch def clr do-ink /ix ix color-width sub def ix minx lt {exit} if } forall } bind def /scl 200 def /color-width scl 50 div def /z scl 3 div def /c scl 30 div def /pi 3.141592653589793 def /z.c z c mul def /z.c.2.pi z.c 180 pi div mul def %%Page: 1 1 gsave false { /fontsize 12 def /Helvetica-Bold fontsize selectfont 0 0 {Show-circle} {Show-line} Composite-map } { 0 setlinewidth /ix scl 1.5 mul def /minx 2 def { do-inks ix minx lt {exit} if } loop } ifelse grestore showpage