Fractals

[bplus]

Koch Curve (Snow flake)

Thankyou @triggered for this cool method for doing the Koch Curve. I have modified code to show how fractal builds:

Code: (Select All)

_Title "Koch Curve" '  by triggered mod b+ 2022-06-02
Screen _NewImage(700, 700, 12) ' b+ mod tirggered Koch curve
_ScreenMove 300, 20
mx = _Width / 2: my = _Height / 2
Dim a$

a$ = "FRRFRRF"
ss = 600
Circle (mx, my), 1
Circle (mx, my), ss / Sqr(3)
x0 = _Width / 2 + ss / Sqr(3) * Cos(_D2R(210))
y0 = _Height / 2 + ss / Sqr(3) * Sin(_D2R(210))
Dim j, k
For k = 1 To 2
    a$ = "FRRFRRF"
    ss = 600
    TurtleGraphics x0, y0, 0, ss, a$
    _Delay 5
    For j = 1 To 5
        If k = 2 Then Cls
        ss = ss / 3
        a$ = stReplace$(a$, "F", "FLFRRFLF")
        TurtleGraphics x0, y0, 0, ss, a$
        _Delay 1 ' pause 2 x's per sec
    Next j
    If k <> 2 And j <> 5 Then Cls
Next
Sleep

Sub TurtleGraphics (x0 As Double, y0 As Double, a0 As Double, ssize As Double, path As String)
    Dim As Double x, y, angle, stepsize
    Dim w As String
    Dim t As String
    x = x0
    y = y0
    angle = a0
    w = path
    stepsize = ssize

    PReset (x0, y0)

    Do While Len(w)
        t = Left$(w, 1)
        w = Right$(w, Len(w) - 1)
        Select Case t
            Case "F"
                x = x + stepsize * Cos(angle)
                y = y + stepsize * Sin(angle)
            Case "L"
                angle = angle - 60 * _Pi / 180
            Case "R"
                angle = angle + 60 * _Pi / 180
        End Select
        Line -(x, y), 15
    Loop
End Sub

Function stReplace$ (a As String, b As String, c As String)
    Dim i As Integer
    Dim g As String
    Dim r As String
    For i = 1 To Len(a)
        g = Mid$(a, i, 1)
        If g = b Then
            r = r + c
        Else
            r = r + g
        End If
    Next
    stReplace = r
End Function