Hey everyone,
This year, we have to discuss a self-chosen topic for math. And the topic me and my friend picked are fractals.
I started out with the julia fractals:
y = x^2 + c with c being input
For some cool effects: (
Re stands for
Real part of,
Im for
Imaginary part of --> c can be complex)
Not really a cool effect. It gives a circle
Re(c) = 0.0
Im(c) = 0.0
This one starting to be it:
Re(c) = -0.5
Im(c) = 0.0
Re(c) = -1.0
Im(c) = 0.0
What about this!!
Re(c) = -0.5
Im(c) = -0.55
This one looks like a double dragon...
Re(c) = 0.325
Re(c) = 0.417
And finally a nice lightning effect (thx Code Dragon)
Re(c) = 0.4
Im(c) = 0.6
or
Re(c) = 0.0
Im(c) = 1.0
And the code: Press enter to return to the real and imaginary input.
sync on : sync rate 0
set window on
`Some constants
#constant scrX screen width()
#constant scrY screen height()
#constant w = 400
#constant h = 400
#constant maxIt = 64
#constant maxValue = 5.0
`Create a vector
r = make vector2(1)
`The function data
global cr# as float
global ci# as float
global Zoom# as float
`Restart
Restart:
cr# = val(PLInp("Give real part of c: "))
ci# = val(PLInp("Give imaginary part of c: "))
`How many times zoom
Zoom# = 200.0
`Input
cls
CreateImage(1, 1.0 / Zoom#, -1.0, -1.0)
make image from memblock 1, 1
do
paste image 1, 0, 0
`Go back to the start
if returnkey() > 0
repeat : until returnkey() = 0
delete memblock 1
goto Restart
endif
sync
loop
function CalcFracPoint(r#, i#)
`Calculate
`Set the vector to the real and imaginary axis
set vector2 1, r#, i#
startL# = length vector2(1)
`Loop and multiply
it = 0
repeat
inc it
`Kwadrate imaginary number
tempL# = length vector2(1) : multiply vector2 1, tempL#
tempL# = length vector2(1)
if x vector2(1) <> 0.0
tempAng# = wrapvalue(atan(y vector2(1) / x vector2(1)) * 2)
else
tempAng# = 180.0
endif
`Set vector and add C
set vector2 1, (cos(tempAng#) * tempL#) + cr#, (sin(tempAng#) * tempL#) + ci#
until it > maxIt or length vector2(1) => maxValue
tempL# = length vector2(1)
`If the value is going to a attractor, go out of the function
if tempL# < maxValue
result# = -1.0
else
result# = it
endif
endfunction result#
function CreateImage(id, f#, xoff#, yoff#)
make memblock id, w*h*4
write memblock dword id, 0, w
write memblock dword id, 4, h
write memblock dword id, 8, 32
ink rgb(255, 255, 255), 0
`Write pixels
for y = 0 to h - 2
for x = 0 to w - 2
pos = 12 + ((((h - y - 2)*w) + x)*4)
r# = ((x*f#) + xoff#)
i# = ((y*f#) + yoff#)
result# = CalcFracPoint(r#, i#)
if result# = -1.0
write memblock dword id, pos, rgb(0, 0, 0)
else
write memblock dword id, pos, rgb(result#*4, result#*4, result#*4)
endif
next x
ink 0, 0
box 0, 0, 100, 100
ink rgb(255, 255, 255), 0
text 0, 0, str$(int((y*100.0/h) + 0.5)) + "%"
sync
next y
endfunction
function PLInp(m$)
out$ = ""
repeat
cls
text 0, 0, m$
text 0, 20, out$
ch$ = entry$()
select asc(ch$)
case 8
out$ = left$(out$, len(out$) - 1)
endcase
case 13
endcase
case default
out$ = out$ + ch$
endcase
endselect
clear entry buffer
sync
until returnkey() > 0
repeat : until returnkey() = 0
endfunction out$
For the people interested in how it works:
This is the algorithm
1) I used a vector to calculate with the imaginary numbers. The x vector is the real axis, the y vector is the imaginary axis.
For kwadrating an imaginary number, you have to kwadrate the length of the vector and double the angle it forms with the real axis. To add the real and imaginary c, I simply add Re(c) to the x vector and Im(c) to the y vector.
2) I repeat the proces with the vector until the value is bigger than a set length, or the number of maximum iterations was passed.
3) If the value still didn't pass the maximum value, then it means there is an attractor(?) (aantrekker in dutch), and the pixel should be black.
Else, the number of iterations the value needed to get over the maximum value is used for the color.
[edit]
For real time rendering:
sync on : sync rate 0
set window on
`Some constants
#constant scrX screen width()
#constant scrY screen height()
#constant w = 400
#constant h = 400
#constant maxIt = 64
#constant maxValue = 5.0
`Create a vector
r = make vector2(1)
`The function data
global cr# as float
global ci# as float
global Zoom# as float
`Restart
Restart:
cr# = val(PLInp("Give real part of c: "))
ci# = val(PLInp("Give imaginary part of c: "))
`How many times zoom
Zoom# = 200.0
`Input
cls
CreateImage(1, 1.0 / Zoom#, -1.0, -1.0)
make image from memblock 1, 1
do
paste image 1, 0, 0
`Go back to the start
if returnkey() > 0
repeat : until returnkey() = 0
delete memblock 1
goto Restart
endif
sync
loop
function CalcFracPoint(r#, i#)
`Calculate
`Set the vector to the real and imaginary axis
set vector2 1, r#, i#
startL# = length vector2(1)
`Loop and multiply
it = 0
repeat
inc it
`Kwadrate imaginary number
tempL# = length vector2(1) : multiply vector2 1, tempL#
tempL# = length vector2(1)
if x vector2(1) <> 0.0
tempAng# = wrapvalue(atan(y vector2(1) / x vector2(1)) * 2)
else
tempAng# = 180.0
endif
`Set vector and add C
set vector2 1, (cos(tempAng#) * tempL#) + cr#, (sin(tempAng#) * tempL#) + ci#
until it > maxIt or length vector2(1) => maxValue
tempL# = length vector2(1)
`If the value is going to a attractor, go out of the function
if tempL# < maxValue
result# = -1.0
else
result# = it
endif
endfunction result#
function CreateImage(id, f#, xoff#, yoff#)
make memblock id, w*h*4
write memblock dword id, 0, w
write memblock dword id, 4, h
write memblock dword id, 8, 32
ink rgb(255, 255, 255), 0
`Write pixels
for y = 0 to h - 2
for x = 0 to w - 2
pos = 12 + ((((h - y - 2)*w) + x)*4)
r# = ((x*f#) + xoff#)
i# = ((y*f#) + yoff#)
result# = CalcFracPoint(r#, i#)
if result# = -1.0
write memblock dword id, pos, rgb(0, 0, 0)
else
write memblock dword id, pos, rgb(result#*4, result#*4, result#*4)
endif
next x
make image from memblock id, id
paste image id, 0, 0
ink 0, 0
box 0, 0, 100, 100
ink rgb(255, 255, 255), 0
text 0, 0, str$(int((y*100.0/h) + 0.5)) + "%"
sync
next y
endfunction
function PLInp(m$)
out$ = ""
repeat
cls
text 0, 0, m$
text 0, 20, out$
ch$ = entry$()
select asc(ch$)
case 8
out$ = left$(out$, len(out$) - 1)
endcase
case 13
endcase
case default
out$ = out$ + ch$
endcase
endselect
clear entry buffer
sync
until returnkey() > 0
repeat : until returnkey() = 0
endfunction out$
[edit]
The last versions:
Julia (blue):
sync on : sync rate 0
set window on
`Some constants
#constant scrX screen width()
#constant scrY screen height()
#constant w = 600
#constant h = 600
#constant maxIt = 32
#constant maxValue = 2.0
`Create a vector
r = make vector2(1)
`The function data
global cr# as float
global ci# as float
global Zoom# as float
`Restart
Restart:
cr# = val(PLInp("Give real part of c: "))
ci# = val(PLInp("Give imaginary part of c: "))
`How many times zoom
Zoom# = 300.0
`Input
cls
start = timer()
CreateImage(1, 1.0 / Zoom#, -1.0, -1.0)
time = timer() - start
make image from memblock 1, 1
do
paste image 1, 0, 0
`Go back to the start
if returnkey() > 0
repeat : until returnkey() = 0
delete memblock 1
goto Restart
endif
`Display time
text 0, h + 5, str$(time*0.001) + " s rendertime"
sync
loop
function CalcFracPoint(r#, i#)
`Calculate
`Set the vector to the real and imaginary axis
set vector2 1, r#, i#
startL# = length vector2(1)
`Loop and multiply
it = 0
repeat
inc it
`Calculate the vector
vx# = x vector2(1)
vy# = y vector2(1)
set vector2 1, ((vx#^2) - (vy#^2)) + cr#, (2*vx#*vy#) + ci#
until it > maxIt or length vector2(1) => maxValue
tempL# = length vector2(1)
`If the value is going to a attractor, go out of the function
if tempL# < maxValue
result# = -1.0
else
result# = it
endif
endfunction result#
function CreateImage(id, f#, xoff#, yoff#)
make memblock id, w*h*4
write memblock dword id, 0, w
write memblock dword id, 4, h
write memblock dword id, 8, 32
ink rgb(255, 255, 255), 0
`Write pixels
for y = 0 to h - 2
for x = 0 to w - 2
pos = 12 + ((((h - y - 2)*w) + x)*4)
r# = ((x*f#) + xoff#)
i# = ((y*f#) + yoff#)
result# = CalcFracPoint(r#, i#)
if result# = -1.0
write memblock dword id, pos, rgb(0, 0, 0)
else
red = result#*2
green = result#*4
blue = result#*8 : if blue > 255 then blue = 255
write memblock dword id, pos, rgb(red, green, blue)
endif
next x
make image from memblock id, id
paste image id, 0, 0
text 0, 0, str$(int((y*100.0/h) + 0.5)) + "%"
sync
next y
endfunction
function PLInp(m$)
out$ = ""
repeat
cls
text 0, 0, m$
text 0, 20, out$
ch$ = entry$()
select asc(ch$)
case 8
out$ = left$(out$, len(out$) - 1)
endcase
case 13
endcase
case default
out$ = out$ + ch$
endcase
endselect
clear entry buffer
sync
until returnkey() > 0
repeat : until returnkey() = 0
endfunction out$
Mandlebrot (blue):
sync on : sync rate 0
set window on
`Some constants
#constant scrX screen width()
#constant scrY screen height()
#constant w = 800
#constant h = 600
#constant maxIt = 32
#constant maxValue = 5.0
`Create a vector
r = make vector2(1)
`The function data
global cr# as float
global ci# as float
global Zoom# as float
`Restart
Restart:
`How many times zoom
Zoom# = 300.0
`Input
cls
start = timer()
CreateImage(1, 1.0 / Zoom#, -2.0, -1.0)
time = timer() - start
make image from memblock 1, 1
do
paste image 1, 0, 0
`Go back to the start
if returnkey() > 0
repeat : until returnkey() = 0
delete memblock 1
goto Restart
endif
`Display time
text 0, h + 5, str$(time*0.001) + " s rendertime"
sync
loop
function CalcFracPoint(cr#, ci#)
`Calculate
`Set the vector to the real and imaginary axis
set vector2 1, 0.0, 0.0
startL# = length vector2(1)
`Loop and multiply
it = 0
repeat
inc it
`Calculate the vector
vx# = x vector2(1)
vy# = y vector2(1)
set vector2 1, ((vx#^2) - (vy#^2)) + cr#, (2*vx#*vy#) + ci#
until it > maxIt or length vector2(1) => maxValue
tempL# = length vector2(1)
`If the value is going to a attractor, go out of the function
if tempL# < maxValue
result# = -1.0
else
result# = it
endif
endfunction result#
function CreateImage(id, f#, xoff#, yoff#)
make memblock id, w*h*4
write memblock dword id, 0, w
write memblock dword id, 4, h
write memblock dword id, 8, 32
ink rgb(255, 255, 255), 0
`Write pixels
for y = 0 to h - 2
for x = 0 to w - 2
pos = 12 + ((((h - y - 2)*w) + x)*4)
r# = ((x*f#) + xoff#)
i# = ((y*f#) + yoff#)
result# = CalcFracPoint(r#, i#)
if result# = -1.0
write memblock dword id, pos, rgb(0, 0, 0)
else
red = result#*2
green = result#*4
blue = result#*8 : if blue > 255 then blue = 255
write memblock dword id, pos, rgb(red, green, blue)
endif
next x
make image from memblock id, id
paste image id, 0, 0
text 0, 0, str$(int((y*100.0/h) + 0.5)) + "%"
sync
next y
endfunction
function PLInp(m$)
out$ = ""
repeat
cls
text 0, 0, m$
text 0, 20, out$
ch$ = entry$()
select asc(ch$)
case 8
out$ = left$(out$, len(out$) - 1)
endcase
case 13
endcase
case default
out$ = out$ + ch$
endcase
endselect
clear entry buffer
sync
until returnkey() > 0
repeat : until returnkey() = 0
endfunction out$
Line iteration:
sync on : sync rate 0
`Type
type iteration
fx as float
fy as float
tx as float
ty as float
endtype
type standard
s as float
ang as float
l as float
endtype
gosub Initialize
`>>>>>>>>>>> INPUT CODE HERE <<<<<<<<<<<<<<<<
`>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<
` !!! Number of iterations !!!
it = 5
`Draw iterations
for i = 1 to it
DrawIteration(i)
next i
cls
DrawLines()
text 0, 0, "Press any key to quit"
do
if scancode() <> 0 then end
sync
loop
`Initialize
Initialize:
`Constants
#constant maxIterations = 10
#constant scrX screen width()
#constant scrY screen height()
`Create iteration standard
dim It(-1) as standard
`Create iteration tree array
dim Lin(0) as iteration
Lin(0).fx = scrX / 2
Lin(0).fy = scrY - 100
Lin(0).tx = scrX / 2
Lin(0).ty = 100
`Create vector for length
r = make vector2(1)
`Globals
global LastIt as integer
LastIt = 0
return
function DrawIteration(iter)
`get elements
a = array count(Lin())
ai = array count(It())
for i = LastIt to a
`Calculate new positions
sx# = Lin(i).fx : sy# = Lin(i).fy
tx# = Lin(i).tx : ty# = Lin(i).ty
dx# = tx# - sx# : dy# = ty# - sy#
set vector2 1, dx#, dy#
if dx# <> 0.0
ang# = wrapvalue(atanfull(dy#, dx#))
else
if ty# > sy#
ang# = 90.0
else
ang# = 270.0
endif
endif
le# = length vector2(1)
`Calculate new points
for it = 0 to ai
`Add points
array insert at bottom Lin()
new = array count(Lin())
newang# = wrapvalue(ang# + It(it).ang)
`Calculate
Lin(new).fx = sx# + (dx#*It(it).s)
Lin(new).fy = sy# + (dy#*It(it).s)
Lin(new).tx = Lin(new).fx + (cos(newang#) * (It(it).l * le#))
Lin(new).ty = Lin(new).fy + (sin(newang#) * (It(it).l * le#))
next it
next i
`Update last iteration
LastIt = a + 1
endfunction
function DrawLines()
a = array count(Lin())
for i = 0 to a
line Lin(i).fx, Lin(i).fy, Lin(i).tx, Lin(i).ty
next i
endfunction
function Facult(nr)
if nr = 0 then exitfunction 0
ret = 1
for a = 1 to nr
ret = ret * a
next a
endfunction ret
function CalcLines(iter)
ret = 0
ai = array count(It())
for i = 1 to iter
ret = ret + (i * ai)
next i
endfunction ret
function AddStandardLine(s#, ang#, l#)
array insert at bottom It()
nw = array count(It())
It(nw).s = s#
It(nw).ang = ang#
It(nw).l = l#
endfunction
It's the programmer's life:
Have a problem, solve the problem, and have a new problem to solve.
