An animated fractal effect, I kind of made by accident.
AppTitle "Fractals"
Graphics 640, 480, 32, 2
SetBuffer BackBuffer()
Const recursions = 8
Const base_length = 100
Const base_lines = 3
Const ox = 320
Const oy = 240
Const spawn = 2
Const shrink# = 1.6
Type lines
Field x1, y1
Field x2, y2
Field length
Field angle#
End Type
Global off
;deg_off = 360/spawn
While Not KeyHit(1)
Cls
off=off+1
Fractal()
Flip
Delay(1)
Wend
Function Fractal()
length = base_length
num_lines = base_lines
deg_off = (360/base_lines)+off
For i = 1 To base_lines
l.lines = New lines
l\x1=ox: l\y1=oy
l\angle# = i * deg_off
l\length = base_length
l\x2 = l\x1+Sin(l\angle)*l\length
l\y2 = l\y1+Cos(l\angle)*l\length
Next
For r = 1 To recursions
re=200: gr=100: bl=100
Color re-(r*16), gr-(r*8), bl-(r*8)
For l.lines = Each lines
Line l\x1, l\y1, l\x2, l\y2
Next
count = 0
For l.lines = Each lines
count = count + 1
If r < recursions
For i = 1 To spawn
l2.lines = New lines
l2\x1 = l\x2: l2\y1 = l\y2
l2\length = l\length/shrink#
l2\angle = l\angle - (((spawn+1)*deg_off)/2)
l2\angle = l2\angle + (i * deg_off)
l2\x2 = l2\x1+Sin(l2\angle)*l2\length
l2\y2 = l2\y1+Cos(l2\angle)*l2\length
Next
EndIf
Delete l.lines ;delete the old line
If r = 1 And count >= base_lines Then Exit
If r > 1 And count >= base_lines*(spawn ^ (r-1)) Then Exit
Next
Next
End FunctionIt could really do with some optimasation in that is doesent create then destroy each line each time the function is called.
