Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.postscript > #991

The cleft between the abdomen and the cephalothorax

Show all headers | View raw

I snagged AK Dewdney's The Armchair Universe from the used book store,
and spiffed-up by mandelbrot skillz.

I put in the cardioid and bulb2 optimizations from wikipedia, but to
get pretty spectra as you zoom, you have to increase the max-iterations,
so each page gets slower and slower (whilst becoming more and more awesome).

At some point it'll bottom-out the floats and turn into gibberish, but 
I haven't had the patience to get there yet...


%!
/flushpage where{pop}{/flushpage{}def}ifelse

%calculation parameters
/xc -.75 def %real center
/yc .01 def %imaginary center
/side .01 def %length of each side
/M 400 def %rows
/N 400 def %cols
/maxit 1000 def

%drawing parameters
currentlinewidth M 2 mul div setlinewidth 
/fudge 1.1 def
/h 500 def
/w 500 def
/resetx { /x 50 def } def resetx
/resety { /y 150 def } def resety
/preview true def

/colorpixel {
    Q div
    dup .5 mul .5 add
    .5 sethsbcolor
    %dup 1 setrgbcolor
} def

/checkcardioid {
    /q ac .25 sub dup mul
        bc dup mul add def
    ac .25 sub q add q mul
    bc dup mul .25 mul
    lt %{ /count maxit def exit } if
} def

/checkbulb {
    ac 1 add dup mul
    bc dup mul add
    .0625 lt %{ /count maxit def exit } if
} def

/createtable {
/acorner xc side .5 mul sub def %least real % lower-left x value
/bcorner yc side .5 mul sub def %least imaginary % lower-left y value
/gap side N div def
/Q maxit def
/dh h M div def
/dw w N div def
/fdh dh fudge mul def
/fdw dw fudge mul def
resetx
resety
/tab [
    0 1 M 1 sub { /m exch def
        [
            0 1 N 1 sub { /n exch def
                /ac n gap mul acorner add def
                /bc m gap mul bcorner add def
                /az 0 def
                /bz 0 def
                /count 0 def

                checkcardioid
                checkbulb or {
                    /count maxit def
                }{

                    { % loop

                        az dup mul      % z = z^2 + c
                        bz dup mul sub  %  = (az + bzi)^2 + ac + bci
                        ac add          %=az^2 -bz^2 +ac +(2*az*bz+bc)i
                        2 az bz mul mul
                        bc add
                        /bz exch def
                        /az exch def

                        /size az dup mul bz dup mul add sqrt def

                        size 2 ge { exit } if
                        count maxit ge { exit } if
                        /count count 1 add def
                    } loop

                } ifelse

                count
                %dup =
                preview {
                    dup colorpixel
                    dup maxit ge {
                        x y fdw fdh rectfill
                    }{
                        x y fdw fdh rectstroke
                    } ifelse
                    /x x dw add def
                } if
            } for
        ]
        preview {
            resetx
            /y y dh add def
        } if
    } for
] def
} def

/findmaxmin {
/q 2 def /Q 0 def
tab {
    {
        dup maxit lt {
            dup q lt { dup /q exch def } if
            dup Q gt { dup /Q exch def } if
        } if
        pop
    } forall
} forall
} def

/sketch {
resetx
resety
tab {
    {
        dup maxit ge { pop 0 setgray }{
            colorpixel
        } ifelse
        x y fdw fdh rectfill
        /x x dw add def
    } forall
    resetx
    /y y dh add def
} forall
} def

/M 200 def %rows
/N 200 def %cols
/maxit 500 def 
{

%/preview false def
%/M 200 def %rows
%/N 200 def %cols
%/maxit 200 def 
%createtable sketch flushpage 

%/M 200 def %rows
%/N 200 def %cols
%/maxit 500 def 
createtable findmaxmin sketch flushpage

%/M 400 def %rows
%/N 400 def %cols
%/maxit 1000 def 
%createtable sketch flushpage

showpage
/side side 3 div def
/maxit maxit 200 add def
} loop

Back to comp.lang.postscript | Previous | Next — Next in thread | Find similar | Unroll thread

Thread

The cleft between the abdomen and the cephalothorax "luser.droog" <luser.droog@gmail.com> - 2012-10-06 02:37 -0500
  Are trying to say that coconuts migrate? "luser.droog" <luser.droog@gmail.com> - 2012-10-07 15:08 -0500

csiph-web