Schraf Brot Fractal

[PhilOfPerth]

Here is an animated version of the swirl, using RotoZoom. 

Code: (Select All)

'Posted on FaceBook's "BASIC Programming Language" group by Eric Schraf

'Edited by SierraKen



Screen _NewImage(1000, 800, 32)

Const pi = 3.1415926

Dim screenX, screenY As Integer

Randomize Timer

np = 800: n = 180: m = 30: k = .02

For i = 0 To n

    x = Rnd: y = Rnd

    For j = 0 To m

        x_pixel = Int(np * x): y_pixel = Int(np * y)

        screenX = x_pixel + (1280 - np) / 2

        screenY = y_pixel

        If j > 0 Then

            col = prevX * prevX + prevY * prevY

            rr = 4 * (col Mod 256)

            gg = col Mod 256

            bb = (255 - col \ 2) Mod 256

            Line (prevX, prevY)-(screenX, screenY), _RGB(rr, gg, bb)

        End If

        prevX = screenX: prevY = screenY

        xx = 2 * x - 1: yy = 2 * y - 1

        If xx <> 0 Then an = Atn(yy / xx) Else an = pi / 2 * Sgn(yy)

        If xx < 0 Then an = an + pi * Sgn(yy)

        an = an + 4 * pi / 3 + Sin(6 * pi * Sqr(xx * xx + yy * yy)) / 4

        x = x + k * Cos(an): y = y + k * Sin(an)

        If x <= 0 Or x >= 1 Or y <= 0 Or y >= 1 Then Exit For

    Next j

Next i



image& = _CopyImage(0)

Cls

zoom = 1.5

zoom2 = .5

zoom3 = .2

m = .99

Do

    _Limit 20

    RotoZoom 400, 300, image&, zoom, angle + bump

    RotoZoom 400, 300, image&, zoom2, angle + bump

    RotoZoom 400, 300, image&, zoom3, angle + bump

    zoom = zoom * m

    zoom2 = zoom2 * m

    zoom3 = zoom3 * m

    If zoom < .1 Then m = 1.02: bump = Rnd * .1

    If zoom > 1.7 Then m = .98: bump = Rnd * .1

    _Display

    angle = angle - 20

    If angle <= 0 Then angle = 360

    _Delay .1

    Cls

Loop Until InKey$ = Chr$(27)





Sub RotoZoom (X As Long, Y As Long, image&, Scale As Single, Rotation As Single)

    Dim px(3) As Single: Dim py(3) As Single

    W& = _Width(image&): H& = _Height(image&)

    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2

    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2

    sinr! = Sin(-Rotation / 57.2957795131): cosr! = Cos(-Rotation / 57.2957795131)

    For i& = 0 To 3

        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y

        px(i&) = x2&: py(i&) = y2&

    Next

    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))

    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))

End Sub

@ SierraKen: Very nice.
However, the Animated version has a smaller second "core" visiible, that wasn't there in the static one, and I think it detracts a little from its effect.
Can this be removed?
Nice work, as usual! 

[SierraKen]

Thanks .
Phil yes, the 3 make a 3D innertube effect as it swirls around. But here it is with just 1. I commented them out.

Code: (Select All)

'Posted on FaceBook's "BASIC Programming Language" group by Eric Schraf

'Edited by SierraKen

'One-Swirl Version



Screen _NewImage(1000, 800, 32)

Const pi = 3.1415926

Dim screenX, screenY As Integer

Randomize Timer

np = 800: n = 180: m = 30: k = .02

For i = 0 To n

    x = Rnd: y = Rnd

    For j = 0 To m

        x_pixel = Int(np * x): y_pixel = Int(np * y)

        screenX = x_pixel + (1280 - np) / 2

        screenY = y_pixel

        If j > 0 Then

            col = prevX * prevX + prevY * prevY

            rr = 4 * (col Mod 256)

            gg = col Mod 256

            bb = (255 - col \ 2) Mod 256

            Line (prevX, prevY)-(screenX, screenY), _RGB(rr, gg, bb)

        End If

        prevX = screenX: prevY = screenY

        xx = 2 * x - 1: yy = 2 * y - 1

        If xx <> 0 Then an = Atn(yy / xx) Else an = pi / 2 * Sgn(yy)

        If xx < 0 Then an = an + pi * Sgn(yy)

        an = an + 4 * pi / 3 + Sin(6 * pi * Sqr(xx * xx + yy * yy)) / 4

        x = x + k * Cos(an): y = y + k * Sin(an)

        If x <= 0 Or x >= 1 Or y <= 0 Or y >= 1 Then Exit For

    Next j

Next i



image& = _CopyImage(0)

Cls

zoom = 1.5

'zoom2 = .5

'zoom3 = .2

m = .99

Do

    _Limit 20

    RotoZoom 400, 300, image&, zoom, angle + bump

    'RotoZoom 400, 300, image&, zoom2, angle + bump

    'RotoZoom 400, 300, image&, zoom3, angle + bump

    zoom = zoom * m

    'zoom2 = zoom2 * m

    'zoom3 = zoom3 * m

    If zoom < .1 Then m = 1.02: bump = Rnd * .1

    If zoom > 1.7 Then m = .98: bump = Rnd * .1

    _Display

    angle = angle - 20

    If angle <= 0 Then angle = 360

    _Delay .1

    Cls

Loop Until InKey$ = Chr$(27)





Sub RotoZoom (X As Long, Y As Long, image&, Scale As Single, Rotation As Single)

    Dim px(3) As Single: Dim py(3) As Single

    W& = _Width(image&): H& = _Height(image&)

    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2

    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2

    sinr! = Sin(-Rotation / 57.2957795131): cosr! = Cos(-Rotation / 57.2957795131)

    For i& = 0 To 3

        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y

        px(i&) = x2&: py(i&) = y2&

    Next

    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))

    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))

End Sub