+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Schraf Brot Fractal (/showthread.php?tid=3735)
Pages:
1
2
RE: Schraf Brot Fractal - PhilOfPerth - 06-10-2025
(06-10-2025, 04:07 PM)SierraKen Wrote: 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!
RE: Schraf Brot Fractal - SierraKen - 06-11-2025
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