## Mandelbrot/Julia

duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

### Mandelbrot/Julia

Here's my attempt at doing some basic fractals.

Mandelbrot:

Code: Select all

#include "fbgfx.bi"
Using FB

Const xres = 320
Const yres = 240
Const midx = xres / 2
Const midy = yres / 2

Screenres xres, yres, 32

Dim As Double pr, pi
Dim As Double newRe, newIm, oldRe, oldIm
Dim As Double zoom = 1, moveX = -0.5, moveY = 0
Dim As Integer maxIterations = 128

Function FractalColour(v As Integer) As Integer
Dim As Ubyte r, g, b
v = (v + v + v) Mod 1024

If v < 256 Then
r = v
g = v
b = 0
Elseif v < 512 Then
r = 255
g = 255 - (v - 256)
b = 0
Elseif v < 768 Then
r = 255 - (v - 512)
g = 0
b = v - 512
Elseif v < 1024 Then
r = 0
g = 0
b = 255 - (v - 768)
End If

FractalColour = Rgb(r, g, b)
End Function

Dim As Uinteger Ptr buffer = Screenptr()
Dim As Integer redraw = 1
Dim As Double zoomx, zoomy
Do
If redraw = 1 Then
redraw = 0
zoomx = 1.5 / (zoom * midx)
zoomy = 1 / (zoom * midy)
Screenlock
For x As Integer = 0 To xres - 1
For y As Integer = 0 To yres - 1
pr = (x - midx) * zoomx + moveX
pi = (y - midy) * zoomy + moveY

newRe = 0
newIm = 0
oldRe = 0
oldIm = 0
Dim i As Integer
For i = 0 To maxIterations - 1
oldRe = newRe
oldIm = newIm
newRe = (oldRe * oldRe) - (oldIm * oldIm) + pr
newIm = 2 * oldRe * oldIm + pi
If (newRe * newRe + newIm * newIm) > 4 Then Exit For
Next
buffer[x + xres * y] = FractalColour(maxIterations - i)
Next
Next
Locate 1, 1 : Print zoom
Screenunlock
End If

If Multikey(SC_Q) Then zoom *= 2 : redraw = 1
If Multikey(SC_A) Then zoom /= 2 : redraw = 1

If Multikey(SC_W) Then maxIterations *= 2 : redraw = 1
If Multikey(SC_S) Then maxIterations /= 2 : redraw = 1

If Multikey(SC_DOWN)  Then moveY += (1 / zoom) * 0.3 : redraw = 1
If Multikey(SC_UP)    Then moveY -= (1 / zoom) * 0.3 : redraw = 1
If Multikey(SC_RIGHT) Then moveX += (1 / zoom) * 0.3 : redraw = 1
If Multikey(SC_LEFT)  Then moveX -= (1 / zoom) * 0.3 : redraw = 1
Loop Until Multikey(SC_ESCAPE)

Julia:

Code: Select all

#include "fbgfx.bi"
Using FB

Const xres = 320
Const yres = 240
Const midx = xres / 2
Const midy = yres / 2

Screenres xres, yres, 32

Dim As Double cre = -0.7, cim = 0.27015
Dim As Double newRe, newIm, oldRe, oldIm
Dim As Double zoom = 1, moveX = 0, moveY = 0
Dim As Integer maxIterations = 128

Function FractalColour(v As Integer) As Integer
Dim As Ubyte r, g, b
v = (v + v + v) Mod 1024

If v < 256 Then
r = v
g = v
b = 0
Elseif v < 512 Then
r = 255
g = 255 - (v - 256)
b = 0
Elseif v < 768 Then
r = 255 - (v - 512)
g = 0
b = v - 512
Elseif v < 1024 Then
r = 0
g = 0
b = 255 - (v - 768)
End If

FractalColour = Rgb(r, g, b)
End Function

Dim As Uinteger Ptr buffer = Screenptr()
Dim As Integer redraw = 1
Dim As Double zoomx, zoomy
Do
If redraw = 1 Then
redraw = 0
zoomx = 1.5 / (zoom * midx)
zoomy = 1 / (zoom * midy)

Screenlock
For x As Integer = 0 To xres - 1
For y As Integer = 0 To yres - 1
newRe = (x - midx) * zoomx + moveX
newIm = (y - midy) * zoomy + moveY

Dim i As Integer
For i = 0 To maxIterations - 1
oldRe = newRe
oldIm = newIm
newRe = oldRe * oldRe - oldIm * oldIm + cRe
newIm = 2 * oldRe * oldIm + cIm
If (newRe * newRe + newIm * newIm) > 4 Then Exit For
Next
buffer[x + xres * y] = FractalColour(maxIterations - i)
Next
Next
Locate 1, 1 : Print zoom
Screenunlock
End If

If Multikey(SC_Q) Then zoom *= 2 : redraw = 1
If Multikey(SC_A) Then zoom /= 2 : redraw = 1

If Multikey(SC_W) Then maxIterations *= 2 : redraw = 1
If Multikey(SC_S) Then maxIterations /= 2 : redraw = 1

If Multikey(SC_DOWN)  Then moveY += (1 / zoom) * 0.3 : redraw = 1
If Multikey(SC_UP)    Then moveY -= (1 / zoom) * 0.3 : redraw = 1
If Multikey(SC_RIGHT) Then moveX += (1 / zoom) * 0.3 : redraw = 1
If Multikey(SC_LEFT)  Then moveX -= (1 / zoom) * 0.3 : redraw = 1
Loop Until Multikey(SC_ESCAPE)

Function FractalColour taken from mambazo's Mandelbrot function. Hope he doesn't mind.
tinram
Posts: 88
Joined: Nov 30, 2006 13:35
Location: UK
Nice - achieves a lot in a small amount of code.
But on Windows, I needed to add a sleep for the program to be responsive:

Code: Select all

End If

SLEEP

If Multikey(SC_Q) Then zoom *= 2 : redraw = 1