> Even if you can't infinite zoom, is there any way to zoom any farther?
it sounds like you haven't noticed there already is a zoom tool in the code. you have to leftclick and drag to see the rectangle.
I decided to neaten the code up a bit, so try this instead. I added zoom out on rightclick and an Esc key.
edit: oops, just noticed a mistake. the rectangle was a square but should have been a rectangle same dimensions as the screen, so zoom was distorting the image. I've updated the code below now.
;Mandelbrot Fractal code, edit by muk on 8/2/06
Screen_Width=800
Screen_Height=600
AppTitle "Mandelbrot Fractal"
Graphics Screen_Width,Screen_Height,32,2
SetBuffer BackBuffer()
; ------------------
; Make palette
; ------------------
;Px,Py,Tx,Ty,StartRed#,StartGrn#,StartBlu#,EndRed#,EndGrn#,EndBlu#,Dir
Procedure_DrawGradientBlock(0,0,255,5,50,0,255,0,0,0,0)
Dim col(256)
LockBuffer
For i=0 To 255
col(i)=ReadPixelFast(i,2)*8 And $FFFFFF ;<- edit: use readpixelfast
Next
UnlockBuffer
.reset ;<- edit: reset zoom
maxcolor=255
leftside#=-2.0
top#=1.2
xside#=2.5
yside#=-2.5
; ------------
; Redraw
; ------------
.again
Cls ;<- edit: clear screen before redraw
xmax#=Screen_Width
ymax#=Screen_Height
xscale#=xside#/Float(xmax)
yscale#=yside#/Float(ymax)
For y=0 To ymax-1
LockBuffer
For x=0 To xmax-1
cx#=x*xscale#+leftside#
cy#=y*yscale#+top#
zx#=0
zy#=0
colorcounter=0
While (zx#*zx#+zy#*zy#<4 And colorcounter<maxcolor)
tempx#=zx#*zx#-zy#*zy#+cx#
zy#=2*zx#*zy#+cy#
zx#=tempx#
colorcounter=colorcounter+1
Wend
WritePixelFast x,y,Col(colorcounter) ;<- edit: use writepixelfast
If KeyDown(1) Then End ;<- edit: escape while redrawing
Next
UnlockBuffer
Flip ;<- nb: in fullscreen flip only draws every other line?
Text 0,0,"Redrawing, Please Wait..." ;<- edit: text message
Next
For y=0 To 12 ;<- edit: oops, ok draw over the text message again
LockBuffer
For x=0 To 200
cx#=x*xscale#+leftside#
cy#=y*yscale#+top#
zx#=0
zy#=0
colorcounter=0
While (zx#*zx#+zy#*zy#<4 And colorcounter<maxcolor)
tempx#=zx#*zx#-zy#*zy#+cx#
zy#=2*zx#*zy#+cy#
zx#=tempx#
colorcounter=colorcounter+1
Wend
WritePixelFast x,y,Col(colorcounter)
Next
UnlockBuffer
Next
; ----------------------------------------------------
; Wait for rectangular selection for zoom
; ----------------------------------------------------
mandel=CreateImage(Screen_Width,Screen_Height) ;<- edit: draw full screen
CopyRect 0,0,Screen_Width,Screen_Height,0,0,BackBuffer(),ImageBuffer(mandel)
SetBuffer BackBuffer()
Color 255,255,255
mousepress=False
selection=False
MouseHit(1)
MouseHit(2)
Repeat
Cls ;<- edit: to clear rect in fullscreen
DrawImage mandel,0,0
Color 255,255,255
Plot MouseX(),MouseY() ;<- edit: show mouse position in fullscreen
If Not mousepress
If MouseHit(1)
sx=MouseX()
sy=MouseY()
mousepress=True
End If
If MouseHit(2) ;<- edit: reset on rightclick
selection=2
End If
If KeyDown(1) Then End ;<- edit: escape
Else
If MouseDown(1)
ex=MouseX()
ey=sy+(ex-sx)*3/4 ;<- edit: true screen rect box, instead of MouseY()
If sx>ex
startx=ex
endx=sx
Else
startx=sx
endx=ex
End If
If sy>ey
starty=ey
endy=sy
Else
starty=sy
endy=ey
End If
Rect startx,starty,endx-startx,endy-starty,False
Else
LockBuffer ;<- edit: prevent redraw if selected pixels all same color
startcolor=ReadPixelFast(startx,starty) And $FFFFFF
For iy=starty To endy
For ix=startx To endx
currcolor=ReadPixelFast(ix,iy) And $FFFFFF
If currcolor<>startcolor
selection=True
Exit
End If
Next
Next
UnlockBuffer
If Not selection Then mousepress=False
End If
End If
Flip
Until selection
FreeImage mandel
newxside#=xside#*Float((endx-startx)/Float(xmax))
newyside#=yside#*Float((endy-starty)/Float(ymax))
newleftside#=leftside#+(xside#*Float(startx/Float(xmax)))
newtop#=top#+(yside#*Float(starty/Float(ymax)))
leftside#=newleftside
top#=newtop
xside#=newxside
yside#=newyside
Cls ;<- edit: to clear in fullscreen
Flip
If selection=2
Goto reset
Else
Goto again
End If
; ----------------------------
; Draw Gradient block
; ----------------------------
Function Procedure_DrawGradientBlock(Px,Py,Tx,Ty,StartRed#,StartGreen#,StartBlue#,EndRed#,EndGreen#,EndBlue#,Dir=0)
If Dir=0
Direction=Tx
Temp_X=Px
Temp_Y=Tx
Else
Direction=Ty
Temp_X=Py
Temp_Y=Ty
EndIf
GradientRed#=(EndRed-StartRed)/Direction
GradientGreen#=(EndGreen-StartGreen)/Direction
GradientBlue#=(EndBlue-StartBlue)/Direction
For Grad=Temp_X To Temp_X+Temp_Y
Color StartRed,StartGreen,StartBlue
If Dir=0
Line Grad,Py,Grad,Py+Ty
Else
Line Px,Grad,Px+Tx,Grad
EndIf
StartRed=StartRed+GradientRed
StartGreen=StartGreen+GradientGreen
StartBlue=StartBlue+GradientBlue
Next
End Function