+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/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 subRE: 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.
