Fast & simple Mandelbrot

Blitz3D Forums/Blitz3D Programming/Fast & simple Mandelbrot

I found this one from KPL (http://www.k-p-l.org/index.php) and converted it to the Blitz3d (some unneeded code is commented out..)
It is quite fast I must say.. even if it traces only edges of set.

How about little "challenge", could you make this faster or improve it otherwise? (like fillingspace between trace edges..)

;Program MandelbrotTria
; This .kpl program runs in KPL - see <a href="http://www.k-p-l.org" target="_blank">http://www.k-p-l.org</a> 

; Triangulate a mandelbrot set, by Michael Hoger
; Idia taken from " Fractals for the Classroom " by Peitgen/jürgens/Saupe.

; This is a different And faster algorithm For approximating And displaying
; a fractal image, compared To a previous KPL example, Mandelbrot.kpl.
; It would be a very interesting exercise of both mathematics And computer
; programming To examine And contrast the two example programs side by side.

; Difficulty level: Advanced (based on the complex math, Not the code)
; Concepts: String manipulation, array abstractions, nested looping, pen drawing
; KPL Lines: 91
; Author: Michael Hoger

; Blitz3d conversion by FinJogi

Graphics 800, 600, 32, 2
Origin 400,300 

; a triangle
Dim trix(3)
Dim triy(3)
;the verts
;vin=0
;vout=0
;vnew=0
;vtemp=0
; a coordinate To find the edge of the fractal
;ix=0
; startcoordinates
;xin=0
;yout=0
; a complex number
;real#=0
;imag#=0
; two helper
;Outside=False
;Closed=False
; iterationindex
k = 0
kend = -50
kstep = 1


scale# = 4.0 / Float( 600 - 30 )
; start the iteration
While k >= kend
		
  ; search the edge of the fractal along the x-axis
  ; For this iteration
  ix = 0
  Outside = False
  While Not Outside
    real# = scale# * Float(ix)
    imag# = 0
    Outside = Mandelbrottest( k, real#, imag# )
    ix = ix + 1
  Wend
			
  ; we found the edge now init the First triangle
  ; a triangle is formed about three points And look
  ;       ....................
  ; like  ..0....0...00...00..
  ;       ..00..00...0.....0..
  ;       ....................
  vin  = 1
  vout = 2
  vnew = 3
  trix(vin)   = ix - 1
  trix(vout)	= ix
  trix(vnew)	= ix
  triy(vin)	= 0
  triy(vout)	= 0
  triy(vnew)	= 1		
			
  ; hold some information To see when we are around
  xin = trix(vin)
  yout = triy(vout)
  ; define the Color And move To First point
  Color( 100 - ( k * 3 Mod 255 ), 0, 128 )
  ;ColorRGB( 100 - ( k * 3 Mod 255 ), 0, 0 )
  ;Pen( False )
  ;MoveTo( trix [ vin ], triy[ vin ] )
  ;Pen( True )				
  Plot( trix(vin), triy(vin) )
					
  ; Now the tricky part. We follow the funktion at this iteration
  ; by mirrorring our triangle along the x- And y- axis.
  ; The mandelbrottest inform us what we have To do Next.
  Closed = False
  While Not Closed
    ; New complex number
    real# = scale# * Float( trix(vnew) )
    imag# = scale# * Float( triy(vnew) )
			
    ; test For outside And mirror triangle
    If Outside = Mandelbrottest( k, real#, imag# ) Then
      vtemp = vout
      vout  = vnew
      vnew  = vtemp
    Else
     ;MoveTo( trix(vnew), triy(vnew) )
     Plot(trix(vnew), triy(vnew))		
     vtemp = vin
     vin   = vnew
     vnew  = vtemp
    End If
				
    ; calculate the New vertex
    trix(vnew) = trix(vin) + trix(vout) - trix(vtemp)
    triy(vnew) = triy(vin) + triy(vout) - triy(vtemp)
				
    ; see If we are closed For this iteration
    If trix(vout) = xin Then
      If triy(vout) = yout Then
        Closed = True
      End If
    End If
				
  Wend	
  kstep = kstep + 2
  k = k - kstep
Wend	
WaitKey()						
End	



; this Function tests If an complex number is in Or outside the mandelbrot set
; depend on the number of iteration.
Function Mandelbrottest(Iter, real#, imag# )
	
	re# = real#
	im# = imag#
	re2#=0
	im2#=0
		
	j = 2
		
	While ( j ) >= Iter
		re2# = re# * re#
		im2# = im# * im#
		
		If ( re2# + im2# ) > 256 Then
			Return True
		End If
			
		im# = 2 * re# * im# + imag#
		re# = re2# - im2# + real#
		j = j - 1
	Wend
		
	Return False
		
End Function		
			
			



you could probably squeeze some speed out of it by turning some floating point variable to integer. But the code looks pretty optimized

Back in 'good old days' I played with fixed point Mandelbrot code with my Amiga (no float HW).. funny how that code kicked ass of some 5x clocked PC's.. 32bit vs. 16bit registers :)

This is the one I like (you can zoom in using the mouse):
;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
largeval#=10000 ;<- edit: set largevalue

leftside#=-2.0 *largeval# ;<- edit: multiply by largevalue
top#=1.2 *largeval#

xside#=2.5 *largeval#
yside#=-2.5 *largeval#

; ------------ 
; 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#
  cx#=cx#/Float(largeval) ;<- edit: divide by largevalue
  cy#=cy#/Float(largeval)
  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#
  cx#=cx#/Float(largeval) ;<- edit: divide by largevalue
  cy#=cy#/Float(largeval)
  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
 Text 0,0,xside+"-"+yside
 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 


Or if you want a really simple one
Graphics 800,600,16,2
SetBuffer BackBuffer()
maxcolor=255
leftside#=-2 : top#=1.25
xside#=2.5 : yside#=-2.5
xmax=800 : ymax=680
xscale# = xside# / xmax
yscale# = yside# / ymax

For y=1 To ymax
	For x=1 To xmax
		cx# = x * xscale# + leftside#
		cy# = y * yscale# + top#
		zx# = 0
		zy# = 0
		colorcounter = 0
		max = 5 ; 4
		While (zx# * zx# + zy# * zy# < max And colorcounter < maxcolor)
			tempx# = zx# * zx# - zy# * zy# + cx#
			zy# = 2 * zx# * zy# + cy#
			zx# = tempx#
			colorcounter=colorcounter+1
		Wend
		Dot(x,y,colorcounter)
	Next
	Flip
Next

WaitKey
End

Function Dot(x,y,colorcounter)
offset = 0
	r = offset + (colorcounter * 8)
	g = offset + (colorcounter * 4)
	b = offset + (colorcounter * 1)
	Color r,g,b
	Plot x,y 
End Function


While ago I messed with the upper one and found little optimazation :) Flip -> Flip False :) Huge boost in small zoom levels.

WritePixelFast are better solutions i guess :)
and if you put flip 0 on the END of the program, he doesnt flip 800x600 times the backbuffer ;)


Graphics 800,600,16,2
SetBuffer BackBuffer()
maxcolor=255
leftside#=-2 : top#=1.25
xside#=2.5 : yside#=-2.5
xmax=800 : ymax=600
xscale# = xside# / xmax
yscale# = yside# / ymax

AppTitle "please wait..."

LockBuffer
For y=0 To ymax - 1
	For x=0 To xmax - 1
		cx# = x * xscale# + leftside#
		cy# = y * yscale# + top#
		zx# = 0
		zy# = 0
		colorcounter = 0
		max = 5 ; 4
		While (zx# * zx# + zy# * zy# < max And colorcounter < maxcolor)
			tempx# = zx# * zx# - zy# * zy# + cx#
			zy# = 2 * zx# * zy# + cy#
			zx# = tempx#
			colorcounter=colorcounter+1
		Wend
		r = colorcounter * 8
		g = colorcounter * 4
		b = colorcounter * 1
		WritePixelFast x, y, r*$10000 + g*$100 + b, GraphicsBuffer()
	Next
Next
UnlockBuffer
Flip

WaitKey
End


cu