I was playing around with some fractal tree code and made a few different variations to share.
Thank you Paul Doe for the image box suggestion. I have now edited the post to try to include some images.
Version 1:
A multicoloured fractal tree with decreasing circle sizes at node points.
Code: Select all
' A multicoloured fractal tree
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180 ' degrees * DtoR = radians
screenres 640,480,32
color rgb(0,0,0),rgb(0,0,0):cls
dim as single angle,x,y
x = 30
y = 40
angle = atan2(y,x)*RtoD
print angle;90-angle
'x = cos(angle*DtoR)*L
'y = sin(angle*DtoR)*L
SUB tree (x as integer, y as integer, a as single, L as single, depth as integer)
dim as single Oldx,Oldy,xx,yy,lastdepth
Oldx = x
Oldy = y
IF depth THEN
x = x + L * COS(a + DtoR*90) 'compute new x coordinate
y = y + L * SIN(a + DtoR*90) 'compute new y coordinate
line (Oldx+320,480-Oldy)-(x+320,480-y),rgb(100 + 6*L,4*L,115)
if depth > 3 and depth <> 9 then circle (Oldx+320,480-Oldy),2*depth -5,rgb(100 + 6*L,4*L,115),,,,f
xx = x+320
yy = 480-y
'line (xx-L\4,yy-L\4)-(xx+L\4,yy+L\4),rgb(100 + 6*L,4*L,115)
'line (xx+L\4,yy-L\4)-(xx-L\4,yy+L\4),rgb(100 + 6*L,4*L,115)
'if depth > 6 then circle (xx+L\4,yy-L\4),depth -2,rgb(255,0,0),,,,f
'if depth > 6 then circle (xx-L\4,yy-L\4),depth -2,rgb(255,0,0),,,,f
Oldx = x
Oldy = y
tree (x,y, a + 45*DtoR, L * .6, depth - 1) 'shorten the length of branch
tree (x,y, a - 45*DtoR, L * .6 , depth - 1) 'and reduce the depth value
END IF
return
END SUB
'************** MAIN ROUTINE ****************
' x, y, angle, length, depth
tree (0, 10, 0, 190, 9 )
while inkey="":wend
Version 2:
'A purple fractal tree with 3 extra diagonal lines at the node points.
Code: Select all
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180 ' degrees * DtoR = radians
screenres 640,480,32
color rgb(0,0,0),rgb(0,0,0):cls
dim as single angle,x,y
x = 30
y = 40
angle = atan2(y,x)*RtoD
print angle;90-angle
'x = cos(angle*DtoR)*L
'y = sin(angle*DtoR)*L
SUB tree (x as integer, y as integer, a as single, L as single, depth as integer)
dim as single Oldx,Oldy,xx,yy,lastdepth
Oldx = x
Oldy = y
IF depth THEN
x = x + L * COS(a + DtoR*90) 'compute new x coordinate
y = y + L * SIN(a + DtoR*90) 'compute new y coordinate
line (Oldx+320,480-Oldy)-(x+320,480-y),rgb(255,0,255)
xx = x+320
yy = 480-y
IF depth <> 9 THEN
line (xx-L\4,yy-L\4)-(xx+L\4,yy+L\4),rgb(255,0,255)
line (xx+L\4,yy-L\4)-(xx-L\4,yy+L\4),rgb(255,0,255)
END IF
Oldx = x
Oldy = y
tree (x,y, a + 45*DtoR, L * .6, depth - 1) 'shorten the length of branch
tree (x,y, a - 45*DtoR, L * .6 , depth - 1) 'and reduce the depth value
END IF
return
END SUB
'************** MAIN ROUTINE ****************
' x, y, angle, length, depth
tree (0, 10, 0, 190, 9 )
while inkey="":wend
Version 3:
A green Fractal Tree with 4 diagonal lines and four circles at the node points.
Code: Select all
'A green Fractal Tree
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180 ' degrees * DtoR = radians
screenres 640,480,32
color rgb(0,0,0),rgb(0,0,0):cls
dim as single angle,x,y
x = 30
y = 40
angle = atan2(y,x)*RtoD
print angle;90-angle
'x = cos(angle*DtoR)*L
'y = sin(angle*DtoR)*L
SUB tree (x as integer, y as integer, a as single, L as single, depth as integer)
dim as single Oldx,Oldy,xx,yy,lastdepth
Oldx = x
Oldy = y
IF depth THEN
x = x + L * COS(a + DtoR*90) 'compute new x coordinate
y = y + L * SIN(a + DtoR*90) 'compute new y coordinate
line (Oldx+320,480-Oldy)-(x+320,480-y),rgb(0,150,0)
xx = x+320
yy = 480-y
IF depth < 8 THEN
line (xx-L\4,yy-L\4)-(xx+L\4,yy+L\4),rgb(0,150,0)
line (xx+L\4,yy-L\4)-(xx-L\4,yy+L\4),rgb(0,150,0)
END IF
if depth < 8 then circle (xx+L\4,yy-L\4),depth -1.5,rgb(0,150,0),,,,f
if depth < 8 then circle (xx-L\4,yy-L\4),depth -1.5,rgb(0,150,0),,,,f
if depth < 8 then circle (xx+L\4,yy+L\4),depth -1.5,rgb(0,150,0),,,,f
if depth < 8 then circle (xx-L\4,yy+L\4),depth -1.5,rgb(0,150,0),,,,f
Oldx = x
Oldy = y
tree (x,y, a + 45*DtoR, L * .6, depth - 1) 'shorten the length of branch
tree (x,y, a - 45*DtoR, L * .6 , depth - 1) 'and reduce the depth value
END IF
return
END SUB
'************** MAIN ROUTINE ****************
' x, y, angle, length, depth
tree (0, 10, 0, 190, 8 )
while inkey="":wend
Version 4:
A cactus like picture (actually a fractal tree with circles instead of lines for branches).
Code: Select all
' a cactus like picture
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180 ' degrees * DtoR = radians
screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255):cls
dim as single angle,x,y
x = 20
y = 40
angle = atan2(y,x)*RtoD
'x = cos(angle*DtoR)*L
'y = sin(angle*DtoR)*L
SUB cactus (x as integer, y as integer, a as single, L as single, depth as integer)
dim as single Oldx,Oldy,xx,yy
Oldx = x
Oldy = y
IF depth THEN
x = x + L * COS(a + DtoR*90) 'compute new x coordinate
y = y + L * SIN(a + DtoR*90) 'compute new y coordinate
if depth < 4 then line (Oldx+320,480-Oldy)-(x+320,480-y),rgb(50,120,50)
if depth = 9 then circle (x+320,480-y+L\2.475),(L\3.375) - 2,rgb(0,120,0),,,,f
xx = x+320
yy = 480-y
if depth > 4 then circle (x+320,480-y),L\1.815,rgb(10-L,238+11.5*L,0),,,,f
if depth = 4 then circle (x+320,480-y),-1.5 + (L\1.815),rgb(60+5*L,10+L,0),,,,f
if depth = 1 then circle (x+320,480-y),2,rgb(230,10,0),,,,f
Oldx = x
Oldy = y
cactus (x,y, a + 45*DtoR, L * .6, depth - 1) 'shorten the length of branch
cactus (x,y, a - 45*DtoR, L * .6 , depth - 1) 'and reduce the depth value
END IF
END SUB
' x, y, angle, length, depth
cactus (20, 40, 0, 170, 9 )
while inkey="":wend
I wonder how to make the branches like a trapezium in shape and how to distort them slightly to make the tree look bit more realistic.
I also thought about using Cairo to enhance the graphics.
I accidentally came across this forum a number of days ago and was really impressed by all the knowledge of it's members. I upload to PlanetVb but now I'n a big fan of FreeBasic. I have experimented with different Freebasic source code, and am finding it not to hard to use, except for the little errors that come up with win32 and win64 builds. A little bit frustrating but the great graphics is a real eye opener.
Thank you Paul Doe and Badidea for your fractal code additions and for making me welcome. I see that you are from the Netherlands and Argentina. I'm in Australia (which is being hit hard by fires, rain/hail and now wind). The weather has been really unusual and going from one extreme to the other.
See you for now.