## Fractal Tree

Charlie Veniot18th March 2022 at 7:12pm
``````' This program based on the QB64 program by "bplus" in the Basic4All forums
' http://basic4all.info8-hosting.info/index.php?topic=76.msg543#msg543
def fn_D2R(degree) = degree * 3.14159265359 / 180
declare sub tree(x, y, angle, depth)
declare sub tLine(x1, y1, x2, y2, rThick)
declare sub fcirc(CX As Long, CY As Long, R As Long, C As Long)
'_Title "Easy Lang Tree, sorta" 'b+ 2022-03-17
'Screen _NewImage(500, 500, 32)
'Color , &HFFFFFFFF
screen 19 ' 800 x 600
SetSessionStorageItem( "FractalTree_Depth", "10" )
If val(GetLocalStorageItem( "FractalTree_Depth" )) > 0 Then SetSessionStorageItem( "FractalTree_Depth", GetLocalStorageItem( "FractalTree_Depth" ) )
newtree:
Cls
FractalTreeDepth\$ = GetSessionStorageItem( "FractalTree_Depth" )
FractalTreeDepth% = val(FractalTreeDepth\$)
line (0,0)-(800,600), &heeeeff , BF
call tree (400, 590, -90, FractalTreeDepth%)
sleep 4 : goto newtree
'
Sub tree (x, y, angle, depth)
linewidth = depth * .8
'move x y
x1 = x + Cos(fn_D2R(angle)) * 8 * depth * 1.4 * Rnd + 0.5
y1 = y + Sin(fn_D2R(angle)) * 8 * depth * 1.4 * Rnd + 0.5
tLine x, y, x1, y1, linewidth
If depth > 1 Then
tree x1, y1, angle - 20, depth - 1
tree x1, y1, angle + 20, depth - 1
End If
End Sub
'
Sub tLine (x1, y1, x2, y2, rThick)
'x1, y1 is one endpoint of line
'x2, y2 is the other endpoint of the line
'rThick is the radius of the tiny circles that will be drawn
'   from one end point to the other to create the thick line
'Yes, the line will then extend beyond the endpoints with circular ends.
rThick = Int(rThick / 2): stepx = x2 - x1: stepy = y2 - y1
length = Int((stepx ^ 2 + stepy ^ 2) ^ .5)
If length Then
dx = stepx / length: dy = stepy / length
For i = 0 To length
fcirc x1 + dx * i, y1 + dy * i, rThick, &h654321 ' &HFF884401
Next
Else
fcirc x1, y1, rThick, &h654321 ' &HFF884401
End If
_delay 0.0001
End Sub
'
Sub fcirc (CX As Long, CY As Long, R As Long, C As Long)
Dim X As Long, Y As Long
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y