% Robert Ackermann 2016-03-23 % Response to Don Lancaster challenge to produce a compact marbling program. % % see http://people.csail.mit.edu/jaffer/Marbling/Mathematics for discussion of mathematics % /scaleby 3.56 def % scale by /pi 3.14159265 def /maxr 100 def /minr 2 def /dr -2 def % define maximum and minimum radii of concentric circles /Lc maxr 2.0 sqrt div round cvi def % Lc = (int) round(maxr / sqrt(2.0)) (length from origin to clipping region) /ci 0 def % color index /colors [[0.960 0.764 0.576] [0.316 0.362 0.298] [0.200 0.000 0.015] [0.023 0.145 0.451] [0.866 0.353 0.000] [0.200 0.000 0.015]] def /tinexys 0 1 6 {Lc 3 div mul Lc neg add} for 7 array astore def % 7 coords equally spaced vert. and horz. tines 72 8.5 mul 2 div 72 11.0 mul 2 div translate scaleby dup scale % center on my 8.5 x 11.0 inch Ghostscript page % Fxy is the composition of F(x,y) for all tine strokes. For the marbled image generated by this program, seven % equally separated tines are stroked north, east, south, and then west. % /Fxy { % x, y --> x', y' /z 20.0 def /u 0.7 def % z = 20.0, u = .7 (see ref to mathematics in header) /y exch def /x exch def % get x and y coordinates of current circle point from stack /y y tinexys {x sub abs u exch exp z mul add} forall def % north y += z * u ^ abs(xs - x) where xs element of tinexys /x x tinexys {y sub abs u exch exp z mul add} forall def % east x += z * u ^ abs(ys - y) where ys element of tinexys /y y tinexys {x sub abs u exch exp z neg mul add} forall def % south y += -z * u ^ abs(xs - x) where xs element of tinexys /x x tinexys {y sub abs u exch exp z neg mul add} forall def % west x += -z * u ^ abs(ys - y) where ys element of tinexys x y % put transformed x' and y' coordinates back on stack } bind def gsave newpath Lc Lc neg moveto Lc Lc lineto Lc neg Lc lineto Lc neg Lc neg lineto closepath clip % clip largest circle by square maxr dr minr { /pnts 2.0 pi mul 2 index scaleby mul mul 3 mul cvi def % pnts = 3.0 * 2.0 * pi * r * scaleby (pnts circle arb inc by 3) /d pi pnts div 180.0 pi div mul sin 2.0 mul def % d = 2.0 * sin(pi / pnts) Minsky algo inc req to complete circle 0 2 copy newpath Fxy moveto % start circle at point (r, 0) (r is on stack from loop) pnts { dup 3 1 roll d mul sub dup d mul 3 2 roll add % calc next Minsky algo point (x = x - d * y, y = y + d * y) 2 copy Fxy lineto % path line to next transformed point } repeat % generate points around circumference of circle colors ci get aload pop setrgbcolor % set fill color from RGB values in colors[ci] /ci ci 1 add 6 mod def % ci = (ci + 1) % 6 (round-robin increment to next color) pop pop closepath fill % remove final (x,y) point, close path, and then fill } for % generate decreasing radius concentric circles grestore showpage