Playing with dragon curve fractal

[Dav]

Playing around with doing a dragon curve fractal, altering the looks of it, making it animated, produced an interesting effect.  Uses a recursive SUB.

- Dav

Code: (Select All)

'dragoncurve.bas

'A play on a dragon curve fractal

'Adapted by Dav, OCT/2023



Screen _NewImage(800, 600, 32)

Dim Shared a, p: p = .001

Do

    Cls: dragon 400, 300, 90 + (a * 3), a, 16

    If a < 200 Then a = a + .15

    If p < .002 Then p = p + .00000001

    _Limit 15: _Display

Loop Until _KeyHit





Sub dragon (x, y, size, ang, depth)

    If depth < 1 Then

        PSet (x, y), _RGBA(50, 150, 255, 50 + Rnd * 200)

    Else

        size2 = size / 1.414214: ang2 = ang - _Pi / p

        dragon x, y, size2, ang + _Pi / p, depth - 1

        dragon x + size2 * Cos(ang), y + size2 * Sin(ang), size2, ang2, depth - 1

    End If

End Sub

[bplus]

Playing around with doing a dragon curve fractal, altering the looks of it, making it animated, produced an interesting effect.  Uses a recursive SUB.

- Dav

Code: (Select All)

'dragoncurve.bas

'A play on a dragon curve fractal

'Adapted by Dav, OCT/2023



Screen _NewImage(800, 600, 32)

Dim Shared a, p: p = .001

Do

    Cls: dragon 400, 300, 90 + (a * 3), a, 16

    If a < 200 Then a = a + .15

    If p < .002 Then p = p + .00000001

    _Limit 15: _Display

Loop Until _KeyHit





Sub dragon (x, y, size, ang, depth)

    If depth < 1 Then

        PSet (x, y), _RGBA(50, 150, 255, 50 + Rnd * 200)

    Else

        size2 = size / 1.414214: ang2 = ang - _Pi / p

        dragon x, y, size2, ang + _Pi / p, depth - 1

        dragon x + size2 * Cos(ang), y + size2 * Sin(ang), size2, ang2, depth - 1

    End If

End Sub

Wow amazing!

[TerryRitchie]

I remember discovering fractals and mandelbrots back in the early 90's when I finally got an 80386 with VGA color that could do them. They never cease to amaze me especially when coded like this. Awesome.

[Dav]

Thanks, ya'll.  I'm finding fractals fascinating lately.  Been looking up unusual ones and found out about a 'Phoenix' fractal.  Since it's our symbol, will just have to work that one up in QB64.

- Dav

[mnrvovrfc]

Nice program, interesting concept. But on my computer I had to change `_KEYHIT` to `_KEYDOWN` to check only for escape key because it was doing only one iteration. I went further than that and it refused to work properly. I saw the `1e-8` being added to `p` and figured it would work better with double precision. So I set all variables to work in double precision but couldn't get further than one dot.

[Dav]

Hmm, I dimmed p to double and it seems to work ok.  After reading your key input problem I decided to add some keyboard control.  Here's a newer version with some added features.

Press +/- to zoom in and out of fractal.  Press SPACE to jump to a new pattern number (p variable random change).  Press ESC to quit.  I changed drawing to using CIRCLE to make it look more solid while zoomed up.

- Dav

Code: (Select All)

'dragoncurve.bas - v2

'A play on a dragon curve fractal

'Adapted by Dav, OCT/2023



'v2 - New keyboard control. Press +/- to zoom, SPACE resets, ESC ends.



Screen _NewImage(800, 600, 32)

Dim Shared p As Double: p = Rnd: size = 200

Do

    Cls: dragon 400, 300, size, a, 15

    Select Case Inp(&H60)

        Case 13: If size < 1200 Then size = size + 5

        Case 12: If size > 25 Then size = size - 5

        Case 57: p = Rnd

        Case 1: Exit Do

    End Select

    _Limit 15: _Display

    a = a + .15: p = p + .001

Loop





Sub dragon (x, y, size, ang, depth)

    If depth < 1 Then

        'PSet (x, y), _RGBA(50, 150, 255, 50 + Rnd * 200)

        Circle (x, y), size / 3, _RGBA(50, 150, 255, 50 + Rnd * 200)

    Else

        size2 = size / Sqr(2): ang2 = ang - _Pi / p

        dragon x, y, size2, ang + _Pi / p, depth - 1

        dragon x + size2 * Cos(ang), y + size2 * Sin(ang), size2, ang2, depth - 1

    End If

End Sub

[bplus]

One of those fractals looks like Pythagoras Tree! AKA Muscle Man Tree

Code: (Select All)

_Title "BodyTree Rework 2020-08" 'b+ 2020-08-14
'BodyTree recur fill.bas for SmallBASIC [B+=MGA] 2016-06-20
'copied and translated from body tree by PeterMaria
'2016-06-20 even more color mods including using triangle fills
' 2020-08-11 trans to QB64
' 2020-08-14 rework the recursive sub so can flex the body tree

Const xmax = 1200, ymax = 700

Screen _NewImage(xmax, ymax, 32)
_Delay .25
_ScreenMove _Middle


Dim Shared limit, ra
limit = 14
ra = _Pi / -4 '45 degrees is standard angle for roof

'sky
Color 0, _RGB32(40, 100, 180): Cls

'the hill for tree
ax0 = xmax / 2 - ymax / 10
ay0 = ymax - 40
bx0 = xmax / 2 + ymax / 10


For ra = 0 To _Pi / 3.7 Step _Pi / 64
    Cls
    level = 0
    'hill
    For r = xmax / 1.5 To 2 * xmax / 15 Step -10
        EllipseFill xmax / 2, ay0, r, .15 * r, _RGB32(0, r / 5, 0)
        'circle , .1, rgb(0, r / 5, 0) filled
    Next

    'tree
    BodyTree ax0, ay0, bx0, ay0, level
    _Display
    _Limit 5
Next
Sleep

Sub BodyTree (x1, y1, x2, y2, level)
    'dim shared ra = roof angle 0 to PI/4
    L = _Hypot(x2 - x1, y2 - y1)
    pa = _Atan2(y2 - y1, x2 - x1) - _Pi / 2 'perpendicular angle to base line
    x3 = x1 + L * 1 * Cos(pa)
    y3 = y1 + L * 1 * Sin(pa)
    x4 = x2 + L * 1 * Cos(pa)
    y4 = y2 + L * 1 * Sin(pa)
    'build roof to square
    mx = (x3 + x4) / 2
    my = (y3 + y4) / 2
    adj = _Hypot(x3 - mx, y3 - my)
    raise = Tan(ra) * adj
    x5 = mx + raise * Cos(pa)
    y5 = my + raise * Sin(pa)

    'now that we have our drawing points draw our house
    'LINE (x2, y2)-(x1, y1), &HFFFFFFFF 'house base
    'LINE (x1, y1)-(x3, y3), &HFFFFFFFF ' left wall
    'LINE (x3, y3)-(x5, y5), &HFFFFFFFF 'left peak
    'LINE (x5, y5)-(x4, y4), &HFFFFFFFF ' right peak
    'LINE (x4, y4)-(x2, y2), &HFFFFFFFF ' right wall completes house

    k = _RGB32((15 - level) * 8, 64 + level * 8, .25 * (15 - level) * 12, 255 - level * 18)
    'k = &HFFBB8866
    ftri x1, y1, x2, y2, x3, y3, k
    ftri x2, y2, x3, y3, x4, y4, k
    ftri x3, y3, x4, y4, x5, y5, k

    If level < limit Then
        BodyTree x3, y3, x5, y5, level + 1
        BodyTree x5, y5, x4, y4, level + 1
    End If
End Sub


Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long
    Static a&
    D = _Dest
    If a& = 0 Then a& = _NewImage(1, 1, 32)
    _Dest a&
    _DontBlend a& '  '<<<< new 2019-12-16 fix
    PSet (0, 0), K
    _Blend a& '<<<< new 2019-12-16 fix
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub

Sub EllipseFill (CX As Integer, CY As Integer, a As Integer, b As Integer, C As _Unsigned Long)
    ' CX = center x coordinate
    ' CY = center y coordinate
    '  a = semimajor axis
    '  b = semiminor axis
    '  C = fill color
    If a = 0 Or b = 0 Then Exit Sub
    Dim h2 As _Integer64
    Dim w2 As _Integer64
    Dim h2w2 As _Integer64
    Dim x As Integer
    Dim y As Integer
    w2 = a * a
    h2 = b * b
    h2w2 = h2 * w2
    Line (CX - a, CY)-(CX + a, CY), C, BF
    Do While y < b
        y = y + 1
        x = Sqr((h2w2 - y * y * w2) \ h2)
        Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
        Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
    Loop
End Sub

Instead of green and brown make it pink or tan and make the "tree" body flex back and forth between two points of the spreading of branches.

[Dav]

Wow -- that's a beauty, bplus!  Love it.  Really cool how you calculated the color changing. I had to steal borrow that method for the little  tree thing I was playing with.  Just what was missing.  Added some yellow PSETs for highlights.  Before using your colors my green tree looked like a head of broccoli.  Made the branching go random (RND * 35)  instead of +/- 45 so the tree growth looks a little more natural.

- Dav

Code: (Select All)

Screen _NewImage(800, 600, 32)



tree 400, 600, -90, 100, 0: Sleep



Sub tree (x1, y1, angle, size, depth)

    If depth <= 14 Then

        x2 = x1 + size * Cos(angle * _Pi / 180)

        y2 = y1 + size * Sin(angle * _Pi / 180)

        k& = _RGB32((15 - depth) * 8, 64 + depth * 8, .25 * (15 - depth) * 12, 255 - depth * 18)

        Line (x1, y1)-(x2, y2), k&: PSet (x1, y1), _RGBA(255, 255, 0, Rnd * 75)

        tree x2, y2, angle - (Rnd * 35), size * .8, depth + 1

        tree x2, y2, angle + (Rnd * 35), size * .8, depth + 1

    End If

End Sub

[bplus]

Wow -- that's a beauty, bplus!  Love it.  Really cool how you calculated the color changing. I had to steal borrow that method for the little  tree thing I was playing with.  Just what was missing.  Added some yellow PSETs for highlights.  Before using your colors my green tree looked like a head of broccoli.  Made the branching go random (RND * 35)  instead of +/- 45 so the tree growth looks a little more natural.

- Dav

Code: (Select All)

Screen _NewImage(800, 600, 32)



tree 400, 600, -90, 100, 0: Sleep



Sub tree (x1, y1, angle, size, depth)

    If depth <= 14 Then

        x2 = x1 + size * Cos(angle * _Pi / 180)

        y2 = y1 + size * Sin(angle * _Pi / 180)

        k& = _RGB32((15 - depth) * 8, 64 + depth * 8, .25 * (15 - depth) * 12, 255 - depth * 18)

        Line (x1, y1)-(x2, y2), k&: PSet (x1, y1), _RGBA(255, 255, 0, Rnd * 75)

        tree x2, y2, angle - (Rnd * 35), size * .8, depth + 1

        tree x2, y2, angle + (Rnd * 35), size * .8, depth + 1

    End If

End Sub

Not too different from what I used in Falling Leaves, looks nice.

[Dav]

Uh oh... Maybe I stole  borrowed that too without realizing it.  

- Dav