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

% marb_rnd1.psl modification by Don Lancaster and Synergetics
% comments added to the right.
% shows flowpaths in different colors

% additional modifications and comments by Robert Ackermann labelled "RFA"

100 200 translate 0.6 dup scale   % center images -- all are circles transmorgified 

%/random {rand 65536 div 32768 div mul cvi} def  % as in -- 6 random -- from Gonzo.ps    % test for changing color each doink

% RFA  temporarily comment out Don's translation and scale
% 300 300 translate                                                                      % my recentering and caliang 
% 0.7 dup scale

% RFA  my additional translation and scale
120 180 translate % RFA  roughly center on 8.5 x 11 inch page (my GhostScript setup)
1.3 dup scale     % RFA  and mostly fill page with larger image so I can see better what is going on

/URL (http://swiss.csai l.mit.edu/~jaffer/Geometry/Marbling) def                         % his reference document

% RFA  %%%%%%%%%% Line-deformation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% RFA  Line-deformation is called only by Composite-map.

/Line-deformation    % px py dx dy xs ys --> px py
{
  % RFA  6 input parameters passed on the stack:
  /ys exch def  % RFA  this is an array of y coordinates specifying the position of horizontal tines (in current program always set to 0 by Composite-map)
  /xs exch def  % RFA  this is an array of x coordinates specifying the position of vertical tines
  /dy exch def  % RFA  sign (direction) of the y displacement for horizontal tines
  /dx exch def  % RFA  sign (direction) of the x displacement for vertical tines
  /py exch def  % RFA  this is the current y coordinate on the Minsky circle that is to be deformed and then returned on the stack
  /px exch def  % RFA  this is the current x coordinate on the Minsky circle that is to be deformed and then returned on the stack
  /a 0 def      % RFA  a = 0

  % RFA  if type(ys) == array then
  % RFA  horizontal tine
  % RFA  I am going to comment out the horizontal tine code to prove to
  % RFA  myself that it is not used for this marbling image
  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
  }

  % RFA  else (if ys is not an array it is assumed xs must be an array)
  % RFA  therefore, use vertical tine procedure (below)
  {
    /py-yf*dx py ys sub dx mul def  % RFA procedure named "py-yf*dx" calculates dx * (py - ys)
    % RFA for all points in array xs of x coordinate points passed as a parameter (see above) by Composite-map
    % RFA
    % RFA a = a + (z.c / (|(dy * (xs - px)) - (dx * (py - ys))| + c))
    % RFA
    % RFA the PostScript procedure below (which implements the equation above) implements
    % RFA the hyperbolic approximation to y = y + (z * u ^ |xs - px|)
    % RFA
    % RFA discussed here (search on "rough equivalence"): http://people.csail.mit.edu/jaffer/Marbling/Mathematics
    % RFA
    % RFA see http://people.csail.mit.edu/jaffer/Marbling/hyp-vs-exp.png
    % RFA
    % RFA why is hyperbolic approximation used?  Speed?  No PostScript pow operator?
    % RFA 
    xs {
        px sub dy mul py-yf*dx sub abs c add z.c exch div a add /a exch def
    } forall
  } ifelse

  % RFA  put distorted (x, y) coordinate pair on stack for return to 
  % RFA  Composite-map and then to do-ink for build up of current distorted
  % RFA  Minsky circle path using lineto 

  px dx a mul add  % RFA  px + (dx * a)  add to original non-displaced x 
                   % RFA  coordinate px, the accumulated total displacement
                   % RFA  a times the displacement direction left-right sign dx

  py dy a mul add  % RFA  py + (dy * a)  add to original non-displaced y 
                   % RFA  coordinate py, the accumulated total displacement
                   % RFA  a times the displacement direction up-down sign dy
} bind def

% RFA  %%%%%%%%%% Composite-map %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% RFA  Composite-map called only by do-ink  Composite-map combines all the
% RFA  tines into one operation on (x, y) from the perspective of do-ink

% Given x, y coordinates on stack, calculates combed coordinates.

/Composite-map
{
    /line-mapper exch def     % RFA  line-mapper procedure is passed by do-ink as a parameter
    /circle-mapper exch def   % RFA  circle-mapper procedure is passed by do-ink as a parameter 
                              % RFA  (but has been set by me to {} in call by do-ink because it was not used)

    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
%   0  -1 [ 125 ] 0 line-mapper exec  % RFA  put one vertical tine through the concentric circles slightly offset from center
%
    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

% RFA  %%%%%%%%%% Minsky-circle %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% RFA  Minsky-circle called only by do-ink

% RFA  x = x - eps * y
% RFA  y = y + eps * x

% RFA  This is fun!  Reminds me of assembly coding in days
% RFA  long ago when computer technology was fun.

% RFA       stack val                    code
% RFA     --------------------------   --------
% RFA  1)  x  y                        dup
% RFA  2)  x  y  y                     3 1 roll
% RFA  3)  y  x  y                     eps mul
% RFA  4)  y  x  eps*y                 sub
% RFA  5)  y  x-eps*y                  dup
% RFA  6)  y  x-eps*y  x-eps*y         eps mul
% RFA  7)  y  x-eps*y  eps*(x-eps*y)   3 2 roll
% RFA  8)  x-eps*y  eps*(x-eps*y)  y   add
% RFA  9)  x-eps*y  y+eps*(x-eps*y)

/Minsky-circle    % x y --> x' y'
{
  dup 3 1 roll eps mul sub dup eps mul 3 2 roll add
} bind def

% RFA  %%%%%%%%%% do-ink %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% RFA  do-ink called only by do-inks (below)  do-ink is called each time
% RFA  a Minsky circle is to be generated, its points distorted, and
% RFA  then filled.

/do-ink
{
% ix 0 {Circle-deformation} {Line-deformation} Composite-map moveto  % RFA  Circle-deformation is not called by Composite-map
  ix 0 {} {Line-deformation} Composite-map moveto                    % RFA  so remove, for now, to simplify
  ix 0                     % RFA  start circle at (x, y) coordinate (ix, 0)

  % RFA  set (above) initial Minsky circle coordinate to (ix, 0) then call
  % RFA  Composite-map to do deformation.  Then (below) work our way around
  % RFA  the circle calling Composite-map on each point while doing a lineto
  % RFA  to build-up the deformed path.

  % RFA  loop until (y > 0) and (oy < 0)  -- could this with very bad luck go around more than once, should there be a "=" in the test?
  {
    dup /oy exch def       % RFA  oy = previous y value from stack
    Minsky-circle 2 copy   % RFA  compute next Minsky circle point then make a copy of the x and y coordinates on the stack that are to be deformed 
%   {Circle-deformation} {Line-deformation} Composite-map lineto     % RFA  Circle-deformation is not called by Composite-map
    {} {Line-deformation} Composite-map lineto                       % RFA  so remove, for now, to simplify
%   dup 0 gt oy 0 lt and {exit} if  % RFA  tested here are the non-copied and non-deformed Minsky circle coordinates 
    dup 0 ge oy 0 lt and {exit} if  % RFA  going to give this test with "ge" substituted for "gt" a try  
  } loop

  pop pop                  % RFA  remove final Minsky circle (x, y) point coordinates from stack

  closepath fill % stroke  % RFA  fill distorted circle (there was a commented out stroke which
                           % RFA  I gather would put a perimeter on the circle?  But, then again,
                           % RFA  line width is set to zero below.)
} bind def

% RFA  %%%%%%%%%% do-inks %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% RFA  do-inks called only by main code (below)

% RFA  do-inks is called multiple times from the main loop while ix is
% RFA  greater than or equal to minx.  This means the six colors defined
% RFA  in the procedure list below are set round-robin while a series of
% RFA  concentric circles -- decreasing in size -- are generated,
% RFA  distorted, and filled. 

/do-inks
{
  /eps 0.25 ix div def               % RFA  eps = 0.25 / ix  (eps is the x and y delta used by the Minsky circle algorithm)

  {
    {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}
  }
  % RFA  for each of the six procedures above, put procedure on stack
  % RFA  as a parameter and then call the procedure below 
  {
    /clr exch def clr do-ink         % RFA  call passed in procedure from list above (which does setrgbcolor) and then call do-ink
    /ix ix color-width sub def       % RFA  ix = ix - color-width  (color-width = scl / 50 = 200 / 50 = 4)  so ix = ix - 4
    ix minx lt {exit} if             % RFA  if (ix < minx) exit
  } forall
} bind def


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% RFA  Main program starts here.  Procedure definitions above.

/scl 200 def                      % RFA  scl = 200
/color-width scl 50 div def       % RFA  color-width = scl / 50
/z scl 3 div def                  % RFA  z = scl / 3
/c scl 30 div def                 % RFA  c = scl / 30
/z.c z c mul def                  % RFA  z.c = z * c

% RFA  pi and z.c.2.pi not used so comment out for now
%/pi 3.141592653589793 def         % RFA  pi = 3.141592653589793
%/z.c.2.pi z.c 180 pi div mul def  % RFA  z.c.2.pi = (180 / pi) * z.c

%%Page: 1 1

gsave                               

0 setlinewidth          % RFA  why is line width set to 0?  If this is some sort of PostScript trick, Don would know about it.
/ix scl 1.5 mul def     % RFA  ix = 1.5 * scl
/minx 2 def             % RFA  minx = 2

% RFA  ix is the radius of the current circle.  Each circle, generated
% RFA  by the Minsky algorithm, starts at coordinate (ix, 0)

% RFA  minx is the smallest radius circle that will be generated

% RFA  call do-inks until ix < minx
{                       
  do-inks               % RFA  call do-inks
  ix minx lt {exit} if  % RFA  if (ix < minx) exit
} loop

grestore
showpage

% RFA %%%%%%%%%% code removed from program stored below %%%%%%%%%%%%%%%%%%

% RFA  removed from main and then simplified

%false     % pop true                                                % activate other half? This either provides a
%{                                                                   % prediction chart of vertical lines or else
%    /fontsize 12 def /Helvetica-Bold fontsize selectfont            % does the actual marbelling Not yet sure what
%    0 0 {Show-circle} {Show-line} Composite-map                     % the prediction is predicting.
%}
%{                                                                   % begin actual marbelling of five progressively
%    0 setlinewidth                                                  % narrower colors. Each new color apparently
%    /ix scl 1.5 mul def                                             % overwrites a portion of the previous one.
%    /minx 2 def
%    {
%      do-inks
%      ix minx lt {exit} if
%    } loop
%} ifelse

% RFA  removed from do-inks  (Don code tracing and experimentation)

%      256 random 256 div
%      256 random 256 div
%      256 random 256 div    
%      setrgbcolor 

%(\nentered do-inks) print

% RFA  Circle-deformation was not called (should be studied to see what it does)

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

% RFA  Unitize was not called

%/Unitize	% dx dy
%{
%    2 copy
%    dup mul exch dup mul add sqrt /a exch def
%    a div exch a div exch
%} bind def

% RFA  Show-circle was only called from a diagnostic branch of the
% RFA  code I have yet to understand.  My intuition is that it 
% RFA  has to do with showing the deformation outlines alone 
% RFA  without actually applying them to the Minsky circles.  

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

% RFA  Show-line was only called from a diagnostic branch of the
% RFA  code.  See Show-circle comment (above) 

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