+- 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
Schraf Brot Fractal - bplus - 06-05-2025
Aurel presented this at another Discord, pretty cool! worked right out of the box.
Code: (Select All)
' Reference Aurel found this and it is pretty cool 2025-06-05 2025 I share with QB64pe
_Title "Schraf Brot (per Aurel 2025-06-05)" ' only line of code I added
w = 1280
h = 720
zoom = 3 / w
dmin = 0.06
Screen _NewImage(w, h, 32): _ScreenMove 0, 0 ' oh I need to move this too!
Cls
For a = 0 To w - 1
For b = 0 To 1.5 * h
x = (a - w) * zoom
y = (b - h) * zoom
i = 0
d = 100
Do
u = x * x
v = y * y
If u + v > 4.8 Or i > 30 Or d < dmin Then
Exit Do
End If
t = u - v
y = 2 * x * y + 0.156
x = t - 0.8
i = i + 1
n = Abs(u + v - 1)
If n < d Then d = n
Loop
If d < dmin Then
coul = 255 - Int(4000 * d)
If coul < 0 Then coul = 0
If coul > 255 Then coul = 255
x1 = a - w / 2
y1 = b - h / 2
x2 = w + w / 2 - 1 - a
y2 = h + h / 2 - b
Line (x1, y1)-(x1 + 1, y1 + 1), _RGB(coul, coul, 0)
Line (x2, y2)-(x2 + 1, y2 + 1), _RGB(coul, coul, 0)
End If
Next b
Next a
EndRE: Schraf Brot Fractal - Jack - 06-05-2025
beautiful
it would look even better if it had a variety of colors
RE: Schraf Brot Fractal - madscijr - 06-06-2025
How does it achieve that 3D-like shading in so few lines of code?? Amazing
RE: Schraf Brot Fractal - SierraKen - 06-06-2025
Incredible!!! This is more proof that numbers can make any design. Thanks for posting B+.
RE: Schraf Brot Fractal - Jack - 06-06-2025
hello @bplus
I Grok to colorize it but all I got was a black screen, then I asked ChatGPT and it gave me the following working code, but the colors are not great
Code: (Select All)
_Title "Schraf Brot (colorized, per Aurel 2025-06-06)"
w = 1280
h = 720
zoom = 3 / w
dmin = 0.06
Screen _NewImage(w, h, 32): _ScreenMove 0, 0
Cls
For a = 0 To w - 1
For b = 0 To 1.5 * h
x = (a - w) * zoom
y = (b - h) * zoom
i = 0
d = 100
Do
u = x * x
v = y * y
If u + v > 4.8 Or i > 30 Or d < dmin Then
Exit Do
End If
t = u - v
y = 2 * x * y + 0.156
x = t - 0.8
i = i + 1
n = Abs(u + v - 1)
If n < d Then d = n
Loop
If d < dmin Then
coul = 255 - Int(4000 * d)
If coul < 0 Then coul = 0
If coul > 255 Then coul = 255
' Color gradient based on iteration and distance
red = coul
green = (i * 8) Mod 256
blue = 255 - coul
x1 = a - w / 2
y1 = b - h / 2
x2 = w + w / 2 - 1 - a
y2 = h + h / 2 - b
Line (x1, y1)-(x1 + 1, y1 + 1), _RGB(red, green, blue)
Line (x2, y2)-(x2 + 1, y2 + 1), _RGB(red, green, blue)
End If
Next b
Next a
End
RE: Schraf Brot Fractal - Jack - 06-06-2025
with zoom-in/zoom-out
Code: (Select All)
_Title "Schraf Brot Animated (per Aurel 2025-06-06)"
w = 1280
h = 720
Screen _NewImage(w, h, 32): _ScreenMove 0, 0
Cls
Dim zoom As Double, dmin As Double, frame As Integer
Do
Cls
frame = frame + 1
zoom = 3 / w * (1 + 0.5 * Sin(frame * 0.05)) ' zoom oscillates over time
dmin = 0.06 * (1 + 0.3 * Cos(frame * 0.07)) ' dmin varies to make fractal edges flicker
For a = 0 To w - 1
For b = 0 To 1.5 * h
x = (a - w) * zoom
y = (b - h) * zoom
i = 0
d = 100
Do
u = x * x
v = y * y
If u + v > 4.8 Or i > 30 Or d < dmin Then Exit Do
t = u - v
y = 2 * x * y + 0.156
x = t - 0.8
i = i + 1
n = Abs(u + v - 1)
If n < d Then d = n
Loop
If d < dmin Then
coul = 255 - Int(4000 * d)
If coul < 0 Then coul = 0
If coul > 255 Then coul = 255
red = coul
green = (i * 8) Mod 256
blue = 255 - coul
x1 = a - w / 2
y1 = b - h / 2
x2 = w + w / 2 - 1 - a
y2 = h + h / 2 - b
Line (x1, y1)-(x1 + 1, y1 + 1), _RGB(red, green, blue)
Line (x2, y2)-(x2 + 1, y2 + 1), _RGB(red, green, blue)
End If
Next b
Next a
_Display
_Limit 20 ' frame rate control
Loop Until _KeyDown(27) ' ESC to exit
End
RE: Schraf Brot Fractal - CharlieJV - 06-06-2025
(06-05-2025, 11:12 PM)bplus Wrote: Aurel presented this at another Discord, pretty cool! worked right out of the box.
Code: (Select All)...
I should hope that program works out of the box because the original code was QB64 code
RE: Schraf Brot Fractal - euklides - 06-08-2025
Fractals are always nice...
RE: Schraf Brot Fractal - SierraKen - 06-10-2025
Here is a swirl, also by Schraf. I got it from the FaceBook group "BASIC Programming Language". I did have to fix it for QB64pe because he was using color as a variable instead of the command color.
![[Image: Swirl-by-Schraf.jpg]](https://i.ibb.co/jP5r2K95/Swirl-by-Schraf.jpg)
Code: (Select All)
'Posted on FaceBook's "BASIC Programming Language" group by Eric Schraf
'Edited by SierraKen
Screen _NewImage(1280, 960, 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
Sleep
End
RE: Schraf Brot Fractal - SierraKen - 06-10-2025
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