' 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 Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
	 If Radius = 0 Then PSet (CX, CY), C: Exit Sub
	 Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub