%!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

                                                                            %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                                                                            %      Don's comments appear in this column
                                                                            %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/URL (http://swiss.csail.mit.edu/~jaffer/Geometry/Marbling) def

/Line-deformation	% px py dx dy xs ys --> px py                             % line service utility to nonlinearly transform points px py
{                                                                           % only used by Composite Map not yet analyzed
  /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                                                                 % line service utility only used by Composite Map not yet analyzed
{
  /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                           % circle service utility to nonlinearly transform points 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                                                                % show circle diagnostic not yet analyzed.                                                               
{
    /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                                                         % service sub normalizes to unit vector
{
    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.            % service sub to calculate position
/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        % service sub to find next point on circle
% 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



                                                                            %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                                                                            % paint one color 
                                                                            %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


% Draws and fills circle as distorted by combings.
/do-ink
{
  ix 0 {Circle-deformation} {Line-deformation} Composite-map moveto         % position start of color lines
  ix 0
  {                                                                           % create path of successive color lines
    dup /oy exch def
    Minsky-circle 2 copy                                                      % calculate line positions
    {Circle-deformation} {Line-deformation} Composite-map lineto              % calculate length of successive color line
    dup 0 gt oy 0 lt and {exit} if                                            % exit when no more lines in path
  } loop
  pop pop
  closepath fill % stroke                                                     % fill created path
} bind def


                                                                            %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                                                                            % paint all colors
                                                                            %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Fills concentric (distorted) circles.
/do-inks
{
  /eps 0.25 ix div def                    % convenience operator eps
  {
    {0.960 0.764 0.576 setrgbcolor}       % color list goes here, one per line
    {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                % paint one color using do-ink
    /ix ix color-width sub def              % exit when color-width complete
    ix minx lt {exit} if
  } forall                                  % repeat for all colors in color list.
} bind def


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% start of high level code
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


                                                                            

/scl 200 def                        % define sci, z, and c. These hl parameters
/color-width scl 50 div def         % set the overall characteristics of the plot. 
/z scl 3 div def
/c scl 30 div def
/pi 3.141592653589793 def           % define convenienc ops of color-width, pi, z.c etc
/z.c z c mul def
/z.c.2.pi z.c 180 pi div mul def

%%Page: 1 1                         % begin actual imaging operation
gsave
false                               % a false here does the plot; true is some sort of
{                                   % reporting map diagnostic not yet analyzed.
    /fontsize 12 def /Helvetica-Bold fontsize selectfont                   
    0 0 {Show-circle} {Show-line} Composite-map
}
{                                   % set the limits of the painting loop to ix and minx.
    0 setlinewidth
    /ix scl 1.5 mul def
    /minx 2 def
    {
      do-inks                       % paint each color in order with do-inks
      ix minx lt {exit} if          % exit when done
    } loop
} ifelse
grestore

showpage                            % and show the page.