%!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 in this version (stoner1x-1-line-no-wiggles.psl) it
% RFA is not used
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)
% RFA for this version of the program (stoner1x-1-line-no-wiggles.psl) I
% RFA have commented out (below) the sinusoidal wiggles and reduced the numbers of
% RFA tines to one tine slightly offset from the center. This is done
% RFA temporarily for learning/instructional purposes and to simplify things
% RFA in case I put trace code (print) in the difficult to understand Line-deformation.
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