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

Groups > comp.lang.postscript > #991 > unrolled thread

The cleft between the abdomen and the cephalothorax

Back to article view | Back to comp.lang.postscript

Contents

  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

#991 — The cleft between the abdomen and the cephalothorax

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

[toc] | [next] | [standalone]

#994 — Are trying to say that coconuts migrate?

luser.droog wrote:

> 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...

I've evolved this into an "interactive" Mandelbrot-set Explorer.

After rendering, it prints a menu and offers a prompt.
At this prompt, you may type the single-letter commands presented.
Or redefine any parameters with normal postscript (> /maxit 20000 def).

If you enter a blank line, the menu exits, showpage is called and
the process repeats by first rendering the image using the current
parameters (hereafter called the Current Config).

Quit with Interrupt (Ctrl-C).


508(0)03:05 PM:ps 0> cat mandel2.ps
%!
/flushpage where{pop}{/flushpage{}def}ifelse
/rshow { dup stringwidth exch neg exch rmoveto show } def

/commands <<
    /help {
        (x:eXplore r:Render i:zoom-In  o:zoom-Out  hjkl:left-down-up-right)=
        (az:increase-decrease resolution and iterations)=
    }
    /a { /M M 1.5 mul def /N N 1.5 mul def /maxit maxit 2 mul def }
    /z { /M M .75 mul cvi def /N N .75 mul cvi def /maxit maxit 2 idiv def }
    /x { /M 50 def /N 50 def /maxit 200 def }
    /r { /M 400 def /N 400 def /maxit 2000 def }
    /i { /side side mag div def /maxit maxit 1.2 mul def }
    /o { /side side mag mul def /maxit maxit .8 mul cvi def }
    /h { /xc xc side step div sub def }
    /j { /yc yc side step div sub def }
    /k { /yc yc side step div add def }
    /l { /xc xc side step div add def }
>> def
commands begin

%calculation parameters
/xc
-.251
def %real center
/yc
.025
def %imaginary center
/side
3.5
%.01
def %length of each side
/M 50 def %rows
/N 50 def %cols
/maxit 200 def

%drawing parameters
currentlinewidth M 2 mul div setlinewidth
/fudge 1.09 def
/ht 500 def
/w 500 def
/resetx { /xloc 50 def } def resetx
/resety { /y 150 def } def resety
/preview true def

%interaction parameters
/mag 3 def %magnification factor
/step 3 def %fraction of view to move by

/menu {
    %{
    { %loop until blank line

        (Current Config)=
        {/xc/yc/side/M/N/maxit} {
            dup =string cvs (/) print print ( ) print
            load =string cvs print ( def) =
        } forall
        help
        flush

        mark
        {
            %pstack
            %count =string cvs print
            (> )print flush
            (%lineedit)(r)file dup bytesavailable
            %dup = flush
            dup 0 eq {pop stop}if %blank line: bust an exit
            string readline pop
            %0 1 index length 1 sub getinterval % chop
            %commands 1 index known { commands exch get } if
            cvx exec
        } stopped {exit}if
        cleartomark

    } loop
    %} stopped { quit } if
} def

/colorpixel {
    q sub Q div
    %dup .3 mul .7 add
    .8
    %dup 1 exch sub
    %.5
    1 index 1 exch sub
    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 {
/M M abs def % just in case the explorer flubbed it
/N N abs def %
/maxit maxit abs ceiling def %
M 0 eq { /M 50 def } if
N 0 eq { /N 50 def } if
maxit 0 eq { /maxit 200 def } if
/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 ht M div def
/dw w N div def
/fdh dh fudge mul def
/fdw dw fudge mul def
resetx
resety

/Courier 9 selectfont
% LL coords
xloc 5 sub y moveto bcorner =string cvs rshow
xloc y 12 sub moveto acorner =string cvs show

% LR
xloc w add 5 add y moveto bcorner =string cvs show
xloc w add y 12 sub moveto acorner side add =string cvs rshow

% UL
xloc 5 sub y ht add 12 sub moveto bcorner side add =string cvs rshow
xloc y ht add 3 add moveto acorner =string cvs show

% UR
xloc w add y ht add 3 add moveto acorner side add =string cvs rshow
xloc w add 5 add y ht add 12 sub moveto bcorner side add =string cvs show

/Courier-Bold [ dw maxit log ceiling div 2 mul 0 0 dh 1.2 mul 0 0]
selectfont

/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 {
                        xloc y fdw dh rectfill
                    }{
                        xloc y dw fdh rectstroke
                        xloc y moveto
                        dup =string cvs show
                    } ifelse
                    /xloc xloc 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
        xloc y fdw fdh rectfill
        /xloc xloc dw add def
    } forall
    resetx
    /y y dh add def
} forall
} def

% The Main Loop
% - draw the object according to current parameters
% - enter menu loop
% - showpage
{
    createtable findmaxmin sketch flushpage
    menu
    showpage
} loop
                     

[toc] | [prev] | [standalone]

Back to top | Article view | comp.lang.postscript

csiph-web