Sierpinski Triangle in QB64PE (and others)

[SMcNeill]

Code: (Select All)

_Title "Sierpinski Triangle in QB64PE"

Screen _NewImage(800, 800, 32)

For d = 0 To 7

    SierpinskiTriangle 50, 50, 700, d

    _Display

    _Delay 2

Next

System



Sub SierpinskiTriangle (x As Integer, y As Integer, size As Integer, depth As Integer)

    If depth = 0 Then

        Line (x, y)-(x + size, y)

        Line (x + size, y)-(x + size / 2, y + Int(size * Sin(_Pi / 3)))

        Line (x + size / 2, y + Int(size * Sin(_Pi / 3)))-(x, y)

    Else

        Color _RGB32(255 * Rnd, 255 * Rnd, 255 * Rnd)

        SierpinskiTriangle x, y, size / 2, depth - 1

        SierpinskiTriangle x + size / 2, y, size / 2, depth - 1

        SierpinskiTriangle x + size / 4, y + Int((size / 2) * Sin(_Pi / 3)), size / 2, depth - 1

    End If

End Sub

[PhilOfPerth]

Never heard of that, but an interesting effect! Might be useful sometime!

[SMcNeill]

In a similar vein to the above, we have a Koch Snowflake as well:

Code: (Select All)

_Title "Koch Snowflake in QB64PE with 32-bit Color"

Screen _NewImage(640, 480, 32)

Randomize Timer



Const xmid = 320, ymid = 240, side = 200, PI = _Pi

depth = 8



' Calculate the initial points of the equilateral triangle

x1 = xmid - side / 2: y1 = ymid + side * Sin(PI / 3) / 2

x2 = xmid + side / 2: y2 = ymid + side * Sin(PI / 3) / 2

x3 = xmid: y3 = ymid - side * Sin(PI / 3)



' Draw the three sides of the Koch Snowflake

For depth = 0 To 7

    Cls

    Color _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)

    DrawKoch x1, y1, x2, y2, depth

    DrawKoch x2, y2, x3, y3, depth

    DrawKoch x3, y3, x1, y1, depth

    _Delay 2

Next

System



Sub DrawKoch (x1 As Single, y1 As Single, x2 As Single, y2 As Single, depth As Integer)

    If depth = 0 Then

        Line (x1, y1)-(x2, y2)

    Else ' Calculate the points for the Koch Snowflake segment

        dx = x2 - x1

        dy = y2 - y1

        xA = x1 + dx / 3

        yA = y1 + dy / 3

        xB = x1 + dx * 2 / 3

        yB = y1 + dy * 2 / 3

        xC = (x1 + x2) / 2 - (Sin(PI / 3) * (y2 - y1)) / 3

        yC = (y1 + y2) / 2 + (Sin(PI / 3) * (x2 - x1)) / 3

        ' Recursively draw the four segments of the Koch Snowflake

        DrawKoch x1, y1, xA, yA, depth - 1

        DrawKoch xA, yA, xC, yC, depth - 1

        DrawKoch xC, yC, xB, yB, depth - 1

        DrawKoch xB, yB, x2, y2, depth - 1

    End If

End Sub

---

(Edited the original post title to include (AND OTHERS).  If I keep doing more of these, I'll just put them all here together, rather than create a dozen topics with such similar snippets and programs.)

[SMcNeill]

Code: (Select All)

_TITLE "Rainbow Tunnel Fractal in QB64PE"

Screen _NewImage(800, 600, 32)



For d = 0 To 8

    Cls , &HFF000000&&

    DrawRainbowTunnel 400, 300, 250, d

    _Display

    _Delay 2

Next

System



Sub DrawRainbowTunnel (x As Single, y As Single, radius As Single, depth As Integer)

    If depth = 0 Then Exit Sub

    Color _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)

    For i = 1 To 8

        Circle (x, y), radius, , , , _Pi / 4 * i

    Next i

    DrawRainbowTunnel x + radius / 2, y, radius / 2, depth - 1

    DrawRainbowTunnel x - radius / 2, y, radius / 2, depth - 1

    DrawRainbowTunnel x, y + radius / 2, radius / 2, depth - 1

    DrawRainbowTunnel x, y - radius / 2, radius / 2, depth - 1

End Sub

[SMcNeill]

Code: (Select All)

_Title "Recursion Flower Fractal in QB64PE"

Screen _NewImage(800, 600, 32)



For d = 0 To 10

    Cls , &HFF000000&&

    DrawRecursionFlower 400, 300, 200, 0, d

    _Display

    _Delay 2

Next

System



Sub DrawRecursionFlower (x As Single, y As Single, size As Single, angle As Single, depth As Integer)

    If depth = 0 Then Exit Sub

    Color _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)

    Line (x, y)-(x + size * Cos(angle), y - size * Sin(angle)), , BF

    For i = 0 To 5

        DrawRecursionFlower x + size * Cos(angle + i * _Pi / 3), y - size * Sin(angle + i * _Pi / 3), size / 3, angle + i * _Pi / 3, depth - 1

    Next i

End Sub

[SMcNeill]

Code: (Select All)

_Title "Stochastic Tree in QB64PE"

Randomize Timer

Screen _NewImage(800, 600, 32)



For a = -_Pi / 2 To 0 Step .1 'just to show how to rotate the angle of the tree

    For d = 1 To 10 'the depth of branches on the tree

        Cls , &HFF000000&&

        DrawStochasticTree 400, 550, a, 100, d

        _Delay .25 'as these are the same and we're repeating them for various angles, I went with a low pause

        _Display

    Next

Next

System



Sub DrawStochasticTree (x As Single, y As Single, angle As Single, length As Single, depth As Integer)

    If depth = 0 Or length < 2 Then Exit Sub

    x2 = x + length * Cos(angle)

    y2 = y + length * Sin(angle)

    Line (x, y)-(x2, y2), _RGB32(139, 69, 19)

    new_length = length * 0.7

    new_depth = depth - 1

    DrawStochasticTree x2, y2, angle + RandomAngle, new_length, new_depth

    DrawStochasticTree x2, y2, angle - RandomAngle, new_length, new_depth

End Sub



Function RandomAngle

    RandomAngle = (Rnd * _Pi / 4 + _Pi / 8) - _Pi / 16

End Function

(And that's the last of these that I'm playing with for tonight. More may come later sometime.)

[bplus]

Never heard of that, but an interesting effect! Might be useful sometime!

Sierpinsky has been around for ages and even here at this forum:
https://qb64phoenix.com/forum/showthread.php?tid=439
Reply #2&3

[NakedApe]

Those are cool, Steve. Thanks for posting. The stochastic tree is my fave even though it's crashing to the ground.   
I added a SLEEP after line 11 on that one to appreciate the pretty trees...

[SierraKen]

Awesome stuff!

[SMcNeill]

(The triangle in the first post is back.  Where it disappeared off to is beyond me.  When I renamed the topic to include the (and others), it erased itself somehow.   Luckily, it's a short code snippet and not hard to recreate.  It's just... odd that the forum is so picky over editing the topic's titles like that.  /sigh )