Fractals

[bplus]

I liked that method so much I tried it with a square:

Koch Squared

Code: (Select All)

_Title "Koch Squared" '  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$
ss = 350
x0 = _Width / 2 + .5 * ss * Sqr(2) * Cos(_D2R(225))
y0 = _Height / 2 + ss / Sqr(2) * Sin(_D2R(225))
For k = 1 To 2
    a$ = "FRFRFRF"
    ss = 350
    TurtleGraphics x0, y0, 0, ss, a$
    _Delay 1
    For j = 1 To 5
        If k = 2 Then Cls
        ss = ss / 3
        a$ = stReplace$(a$, "F", "FLFRFRFLF")
        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 k
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 - 90 * _Pi / 180
            Case "R"
                angle = angle + 90 * _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