QB64 Phoenix Edition
Fractal Explorer - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Fractal Explorer (/showthread.php?tid=106)



Fractal Explorer - vince - 04-22-2022

left click to zoom in
right click to zoom out
mouse wheel to change zoom window
'+' or '-' key to increase or decrease iterations

Code: (Select All)
defint a-z

const sw = 800
const sh = 600

dim shared pi as double
pi = 4*atn(1)

dim shared mx,my,mbl,mbr,mw

dim u as double, v as double
dim uu as double, vv as double
dim xx as double, yy as double
dim x0 as double, y0 as double
dim z as double, zz as double
dim c as single
z = 0.004
zz = 0.1
x0 = -0.5

dim p1 as long
p1 = _newimage(sw, sh, 32)
screen _newimage(sw, sh, 32)

redraw = -1
iter = 100

do
        mw = 0
        getmouse

        if redraw then
                for y = 0 to sh-1
                for x = 0 to sw-1
                        u = 0
                        v = 0

                        xx = (x - sw/2)*z + x0
                        yy = (y - sh/2)*z + y0

                        for i = 0 to iter
                                '''mandelbrot
                                uu = u*u - v*v + xx
                                vv = 2*u*v + yy
                                '''

                                '''burning ship
                                'u = abs(u)
                                'v = abs(v)
                                'uu = u*u - v*v + xx
                                'vv = 2*u*v + yy
                                '''

                                '''tricorn
                                'u = u
                                'v = -v
                                'uu = u*u - v*v + xx
                                'vv = 2*u*v + yy
                                '''

                                '''tetration
                                'u = u
                                'v = v
                                'cexp uu, vv, u, v, u, v
                                'cexp uu, vv, uu, vv, xx, yy
                                '''

                                u = uu
                                v = vv

                                if (u*u + v*v) > 4 then exit for
                        next
                        if i > iter then
                                pset(x, y), _rgb(0,0,0)
                        else
                                c = i/iter
                                r =  80 - 80*sin(2*pi*c - pi/2)
                                g = (114 + 114*sin(2*pi*c*1.5 - pi/2)) * -(c < 0.66)
                                b = (114 + 114*sin(2*pi*c*1.5 + pi/2)) * -(c > 0.33)

                                pset(x, y), _rgb(r, g, b)
                        end if
                next
                next

                'locate 1,1
                'print "iter =";iter
                _title str$(iter)

                _dest p1
                _putimage , 0
                _dest 0

                _putimage , p1
                _autodisplay

                redraw = 0
        end if

        if mw < 0 then
                zz = zz + 0.01
        elseif mw > 0 then
                if zz > 0.01 then zz = zz - 0.01
        end if

        'draw box
        if omx <> mx or omy <> my or mw <> 0 then
                _putimage , p1
                line (mx - (sw*zz/2), my - (sh*zz/2))-step(sw*zz,sh*zz),_rgb(255,255,255),b
                _autodisplay

                omx = mx
                omy = my
        end if

        if mbl then
                do
                        getmouse
                loop while mbl

                x0 = x0 + (mx - sw/2)*z
                y0 = y0 - (sh/2 - my)*z
                z = z*zz

                iter = iter + 100

                redraw = -1
        elseif mbr then
                do
                        getMouse
                loop while mbr

                x0 = x0 + (mx - sw/2)*z
                y0 = y0 - (sh/2 - my)*z
                z = z/zz

                iter = iter - 100

                redraw = -1
        end if

        k = _keyhit
        if k = 43 then
                iter = iter + 50
                redraw = -1
        elseif k = 45 then
                if iter > 50 then iter = iter - 50
                redraw = -1
        end if

loop until k = 27
system

sub getmouse ()
        do
                mx = _mousex
                my = _mousey
                mbl = _mousebutton(1)
                mbr = _mousebutton(2)
                mw = mw + _mousewheel
        loop while _mouseinput
end sub



RE: Fractal Explorer - johnno56 - 04-22-2022

Cool... :O


RE: Fractal Explorer - bplus - 04-22-2022

A beautiful classic!


RE: Fractal Explorer - SierraKen - 04-23-2022

Very nice Mandelbrot! I zoomed in all the way to the blocks. Smile


RE: Fractal Explorer - Trial And Terror - 10-16-2024

I love the Mandelbrot and the fact that it's mouse controlled. Sitting back and zooming away my time. Smile