Mandelbrot explorer

[B+]

Code: [Select]

'Mandelbrot explorer.bas for SmallBASIC 0.12.2 [B+=MGA] 2016-03-08
'I've seen this before and when JJ showed a version on basicpro,
'I was inspired to try one with SmallBASIC, original screen as basicpro

'miter= max iteration it decides how precise a level to go and the gray scale
' 8 is very crude general outline in 8 shades more or less and fast!
' 256 pretty detailed but very slow  16, 32, 64 are good levels
' press m and you will be asked to >enter a new level under the big screen label

'zoom in, out or stay just press the first letter i,o or s... no capitals

'the mouse click controls when a redraw takes place according to zoom and miter
'the next screen will be centered at the point you click and zoomed in|out|stay

xoff=(xmax-640)\2
rpf="##.00000000"
th=txth("Q")
xl=-2.6667 '<==== to match basicpro numbers
xr=2.6667
yt=-2      '<==== to match basic pro numbers
yb=2
zm=(xr-xl)/640
miter=128
mode="s"

label restart
t=timer          '========= mandelbrot section
color 15,0:cls
y=0
while y<=479
  x=0
  while x<=639
    zx=0
    zy=0
    cx=x*zm+xl
    cy=y*zm+yt
    i = miter
    while zx*zx+zy*zy <4 and i >0
      tmp = zx * zx - zy * zy + cx
      zy = 2 * zx * zy + cy
      zx = tmp
      i=i-1
    wend
    cc=i/miter
    pset x+xoff, y, rgbf(cc,cc,cc)
    x = x + 1
  wend
  y = y + 1
wend

t=(timer-t) '====================== screen labeling
color 0,rgb(255,180,180)
rect 0,482,xmax-2,480+4.5*th-2,rgb(255,180,180) filled
rect 0,482,xmax,480+4.5*th,15
lnum=480+.15*th
printlabel "Mandelbrot 640 x 480 pixel projection by SmallBASIC 0.12.2",lnum
s="x = "+format(rpf,xl)+" to "+format(rpf,xr)+"      y = "+format(rpf,yt)+" to "+format(rpf,yb)
lnum+=th
printlabel s,lnum
lnum+=th
s="Scale X "+str((1/zm+.5)\1)+"    Time = "+str(t)+" secs"
printlabel s,lnum
lnum+=th
s="Key m for Miter = "+str(miter)+"   Keys for Zoom: i=in o=out s=slide  Zoom = "+mode
printlabel s,lnum

' now wait for key press or mouse click
redraw=0
pen on
repeat
  ink=inkey
  if len(ink) then
    reprint=0
    if instr("ios",ink) then mode=ink:reprint=1
    if ink="m" then
      at (xmax-txtw("( <4 quits) New miter "))/2,480+5.5*th: input "( <4 quits) New miter ",mtest
      if mtest>=4 then miter=mtest:reprint=1 else end
    end if   
    if reprint then
      s="Key m for Miter = "+str(miter)+"   Keys for Zoom: i=in o=out s=slide  Zoom = "+mode
      printlabel s,lnum
    end if
  end if 'key press
  if pen(3) then
    mx=pen(4):my=pen(5)
    if mx-xoff<640 and mx-xoff>=0 and my<480 then 'that's what we are waiting for
      redraw=1
      mx=(mx-xoff)*zm+xl:my=my*zm+yt
      if mode="s" then
        dist=(xr-xl)/2:xr=mx+dist:xl=mx-dist
        dist=(yb-yt)/2:yt=my-dist:yb=my+dist
      elif mode="i"
        dist=(xr-xl)/4:xr=mx+dist:xl=mx-dist
        dist=(yb-yt)/4:yt=my-dist:yb=my+dist
        zm=(xr-xl)/640
      elif mode="o"
        dist=(xr-xl):xr=mx+dist:xl=mx-dist
        dist=(yb-yt):yt=my-dist:yb=my+dist
        zm=(xr-xl)/640
      end if
    end if 'mouse in range
  end if 'mouse click
until redraw
pen off
goto restart

sub printlabel(labelstring, y)
  AT (xmax-txtw(labelstring))/2,y:? labelstring
end

[ZXDunny]

Oho

Here's mine - it does zooming with the mouse (click and drag a rectangle you want to look at), automatic iteration count, custom palettes (press P to get a new one) and colour cycling (press C to cycle colours). Also has some algorithm optimisations in to speed up drawing, particularly in the main cardioid.

Took days to get this right

Code: [Select]

10 DEF FN r=MIN(INT(RND*5)*64,255)
20 PROC rain: PROC makecursor
30 xmin,ymin=-2,xmax,ymax=2,maxiters=1023: INK 255
40 MOUSE HIDE: GO SUB 60: MOUSE SHOW: PROC getinput: GO TO 40
60 PROC aspect(xmin,xmax,ymin,ymax)
70 maxiters=INT(5*(1.5^(ABS(LN((xmax-xmin)/SCRw))))),xs=(xmax-xmin)/SCRw,ys=(ymax-ymin)/SCRh
80 y1=ymin: FOR y=0 TO SCRh-1: x1=xmin: FOR x=0 TO SCRw-1: u,v,n=0
90 p2y=POWERTWO y1,q=POWERTWO(x1-0.25)+p2y: IF POWERTWO(x1+1)+p2y<1/16 OR q*(q+(x1-0.25))<p2y/4 THEN PLOT x,y: x1+=xs: NEXT x: y1+=ys: NEXT y: RETURN
100 zr=x1,zi=y1,p=0,ptot=8
110 ckr=zr,cki=zi,ptot+=ptot: IF ptot>maxiters THEN ptot=maxiters
120 p+=1,tmp=POWERTWO zr-POWERTWO zi+x1,zi=(zi*2*zr)+y1,zr=tmp
130 IF POWERTWO zr+POWERTWO zi>4 THEN PLOT INK p MOD 255;x,y: x1+=xs: NEXT x: y1+=ys: NEXT y: RETURN
140 IF zr=ckr AND zi=cki THEN PLOT x,y: x1+=xs: NEXT x: y1+=ys: NEXT y: RETURN
150 IF p<ptot THEN GO TO 120 ELSE IF ptot<>maxiters THEN GO TO 110 ELSE PLOT x,y: INC x1,xs: NEXT x: INC y1,ys: NEXT y: RETURN
160 DEF PROC aspect(REF xmin,REF xmax,REF ymin,REF ymax): w=xmax-xmin,h=ymax-ymin,aspect=SCRw/SCRh: IF aspect>w/h THEN nw=h*aspect,xmin-=ABS(w-nw)/2,xmax+=ABS(w-nw)/2 ELSE nh=w*aspect,ymin-=ABS(h-nh)/2,ymax+=ABS(h-nh)/2: END IF: END PROC
170 DEF PROC getinput
180 OVER 1: DO: IF INKEY$="p" THEN PROC rain: DO: LOOP UNTIL INKEY$<>"p" ELSE IF KEYST KEY_C THEN PALETTE SHL 1,0 TO 254: WAIT SCREEN
190 LOOP UNTIL MOUSEBTN=1: x1=MOUSEx,y1=MOUSEy
200 x2=MOUSEx,y2=MOUSEy: RECTANGLE x1,y1 TO x2,y2 FILL
210 DO: WAIT SCREEN: LOOP UNTIL MOUSEdx<>0 OR MOUSEdy<>0 OR MOUSEBTN=0
220 RECTANGLE x1,y1 TO x2,y2 FILL: IF MOUSEBTN<>0 THEN GO TO 200
230 IF xmin>xmax THEN SWAP xmin,xmax
240 IF ymin>ymax THEN SWAP ymin,ymax
250 xs=(xmax-xmin)/SCRw,ys=(ymax-ymin)/SCRh,xa=xmin+(xs*x1),xmax=xmin+(xs*x2),xmin=xa,ya=ymin+(ys*y1),ymax=ymin+(ys*y2),ymin=ya: OVER 0: END PROC
260 DEF PROC makecursor: GRAPHIC NEW CURS,15,15 TRANSPARENT 0: WINDOW GRAPHIC CURS: CLS 0: INK 255: PLOT 0,7: DRAW 15,0: PLOT 7,0: DRAW 0,15: WINDOW 0: MOUSE GRAPHIC CURS POINT 7,7: END PROC
270 DEF PROC rain: b=2 SHL (INT(RND*6)+2),bs=256/b: FOR i=0 TO b-1: PALETTE i*bs,FN r,FN r,FN r: NEXT i: FOR i=0 TO b-1: j=i*bs: RAINBOW j TO j+bs: NEXT i: PALETTE 255,0,0,0: END PROC

D.

[B+]

Hi D,

What is automatic iteration count? Can you zoom back out again with rectangle drawing method?

Are the palettes designed around iterations and max iteration? I was thinking a color method that uses one color for low iterations, and others for mid and another for high, rgb of course, but if there are color schemes that can bring out Mandelbrot features better I'd be happy to learn.

I'd try your program but I will bet real money there has been an update or two since the code was written rendering the need for the version of SpecBAS it was written for. Might include a label in your programs with such info.

I have to say, I had never suspected so many mini Mandelbrots pointed in every direction all around a little dot in number space!

[B+]

Hi again D,

OK I tried yours and it works just fine from a copy paste of code. The color is gorgeous and all palettes are instantly updated with p key press, very nice! Runs much faster too! 

The difference is night and day:

[ZXDunny]

Hi D,

What is automatic iteration count? Can you zoom back out again with rectangle drawing method?

As you zoom in, you need more and more iterations to discern detail. With this algorithm:

maxiters=INT(5*(1.5^(ABS(LN((xmax-xmin)/SCRw)))))

It will predict how many iterations are needed (more or less) for the zoom level to look as detailed as the current view does. You can't zoom out, but if you use this code instead:

Code: [Select]

10 DEF FN r=MIN(INT(RND*5)*64,255)
20 PROC rain;makecursor
30 xmin=-2,ymin=-1.5,xmax=1.5,ymax=1.5,hs=0: INK 255: DIM xm(),ym(),xn(),yn()
40 OVER 0: GO SUB 50: PROC getinput: GO TO 40
50 PROC aspect(xmin,xmax,ymin,ymax): hs+=1: xn(hs)=xmin,yn(hs)=ymin,xm(hs)=xmax,ym(hs)=ymax
60 maxiters=INT(5*(1.5^(ABS(LN((xmax-xmin)/SCRw))))),xs=(xmax-xmin)/SCRw,ys=(ymax-ymin)/SCRh
70 y1=ymin: FOR y=0 TO SCRh-1: x1=xmin: FOR x=0 TO SCRw-1: u,v,n=0: p2y=POWERTWO y1,q=POWERTWO(x1-0.25)+p2y: IF POWERTWO(x1+1)+p2y<1/16 OR q*(q+(x1-0.25))<p2y/4 THEN PLOT x,y: x1+=xs: NEXT x: y1+=ys: NEXT y: RETURN ELSE zr=x1,zi=y1,p=0,ptot=8
80 ckr=zr,cki=zi,ptot+=ptot: IF ptot>maxiters THEN ptot=maxiters
90 p+=1,tmp=POWERTWO zr-POWERTWO zi+x1,zi=(zi*2*zr)+y1,zr=tmp
100 IF POWERTWO zr+POWERTWO zi>4 THEN PLOT INK p;x,y: x1+=xs: NEXT x: y1+=ys: NEXT y: RETURN ELSE IF zr=ckr AND zi=cki THEN PLOT x,y: x1+=xs: NEXT x: y1+=ys: NEXT y: RETURN ELSE IF p<ptot THEN GO TO 90 ELSE IF ptot<>maxiters THEN GO TO 80 ELSE PLOT x,y: INC x1,xs: NEXT x: INC y1,ys: NEXT y: RETURN
110 DEF PROC aspect(REF xmin,REF xmax,REF ymin,REF ymax): w=xmax-xmin,h=ymax-ymin,aspect=SCRw/SCRh: IF aspect>w/h THEN nw=h*aspect,xmin-=ABS(w-nw)/2,xmax+=ABS(w-nw)/2 ELSE IF aspect<w/h THEN nh=w*aspect,ymin-=ABS(h-nh)/2,ymax+=ABS(h-nh)/2: END IF: END IF: END PROC
120 DEF PROC getinput
130 OVER 1: DO: IF INKEY$="p" THEN PROC rain: DO: LOOP UNTIL INKEY$<>"p" ELSE IF KEYST KEY_C THEN PALETTE SHL 1,0 TO 254: WAIT SCREEN
140 LOOP UNTIL MOUSEBTN<>0: x1=MOUSEx,y1=MOUSEy
150 IF MOUSEBTN=2 THEN IF hs>1 THEN hs-=1,xmin=xn(hs),ymin=yn(hs),xmax=xm(hs),ymax=ym(hs),hs-=1: GO TO 210 ELSE GO TO 130
160 x2=MOUSEx,y2=MOUSEy: RECTANGLE x1,y1 TO x2,y2 FILL
170 DO: WAIT SCREEN: LOOP UNTIL MOUSEdx<>0 OR MOUSEdy<>0 OR MOUSEBTN=0
180 RECTANGLE x1,y1 TO x2,y2 FILL: IF MOUSEBTN<>0 THEN GO TO 160
190 IF x1>x2 THEN SWAP x1,x2: END IF: IF y1>y2 THEN SWAP y1,y2
200 xs=(xmax-xmin)/SCRw,ys=(ymax-ymin)/SCRh,xa=xmin+(xs*x1),xmax=xmin+(xs*x2),xmin=xa,ya=ymin+(ys*y1),ymax=ymin+(ys*y2),ymin=ya
210 END PROC
220 DEF PROC makecursor: GRAPHIC NEW CURS,15,15 TRANSPARENT 0: WINDOW GRAPHIC CURS: CLS 0: INK 255: PLOT 0,7: DRAW 15,0: PLOT 7,0: DRAW 0,15: WINDOW 0: MOUSE GRAPHIC CURS POINT 7,7: END PROC
230 DEF PROC rain: b=2 SHL (INT(RND*4)+2),bs=256/b: FOR i=0 TO b-1: PALETTE i*bs,FN r,FN r,FN r: NEXT i: FOR i=0 TO b-1: j=i*bs: RAINBOW j TO j+bs: NEXT i: PALETTE 255,0,0,0: END PROC

Then you can zoom out through your exploration history with a right mouse button click.

Are the palettes designed around iterations and max iteration? I was thinking a color method that uses one color for low iterations, and others for mid and another for high, rgb of course, but if there are color schemes that can bring out Mandelbrot features better I'd be happy to learn.

No, this is just a simple algorithm that chooses a number of points on the palette, sets them to (constrained) random RGB values and then shades between them. Pixels are coloured in a modulus 256 fashion.

I'd try your program but I will bet real money there has been an update or two since the code was written rendering the need for the version of SpecBAS it was written for. Might include a label in your programs with such info.

Possibly

Latest bleeding-edge version (which has some unfinished features regarding loading and saving banks) is here:

https://sites.google.com/site/pauldunn/specbas.zip

I have to say, I had never suspected so many mini Mandelbrots pointed in every direction all around a little dot in number space!

You can zoom in forever (assuming your PC has unlimited accuracy, which it doesn't) and still see new stuff. It's very, very addictive.

D.

[B+]

Hi D,

Ah-ha! I like automatic miter idea and that would save me the pesky input item at the bottom of the screen and the little bug fix needed for clearing the old miter label before printing the update.

Well no secret formulas for coloring, maybe, for random palettes they are very nice, I will have to check into that "constrained" random rgb method and I've yet to try C key.

Addictive! I spent some time last night making slideshow of screen shots moving back out from a point deep into one section (20 mins at least) from first screen and that was in grays. About an hour setup for 3 secs of movie!

[ScriptBasic]

You can zoom in forever (assuming your PC has unlimited accuracy, which it doesn't) and still see new stuff. It's very, very addictive.

Yes it is.

Deepest Mandelbrot Set Zoom Animation ever - a New Record!

[B+]

That was hypnotic. Thanks

[ScriptBasic]

It's been a few years but it was great to pulling that old thread out of the closet again. Did you also watch the fractal documentary in the last post? Everything is a fractal in some shape of form. 

[B+]

Everything is a fractal in some shape of form. 

Yes! after watching the link and playing with ZXDunny's explorers, I am seeing fractals everywhere, specially natural settings. It is cool!

Well fractal exploration is in good hands, I found another project calling my name.