Mandelbrot/Julia

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Mandelbrot/Julia

Postby duke4e » Feb 19, 2008 11:29

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

Postby tinram » Feb 20, 2008 13:18

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

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests