Just 6 Fractals

[bplus]

@bplus Are you aware of these fractals in QB64 over on RosettaCode?

Barnsley Fern
Fractal Tree
Cantor Set (prettier than mine)
Hilbert Curve
Pythagoras Tree
Serpinski Carpet

All QB64 code on RosettaCode.

FWIW all QBasic code on RosettaCode.

TR

Yeah yeah...  ho hum old stuff! Oh have I got a Hilbert mod for you!

Code: (Select All)

_Title "Hilbert in His Curve" '2021-04-14 B+
' using AndyA's code for Hilbert Curve  and Wiki image of Hilbert

Const wide = 128, cell = 4 ' screen width 512 = height
Screen _NewImage(wide * cell + cell, wide * cell + cell, 32)
ReDim Shared As Long H, I
H = _NewImage(wide * cell + cell, wide * cell + cell, 32)
I = _LoadImage("Hilbert.PNG")
_PutImage , I, H
'Color , &HFFFFFFFF     'nope black still works better!
'Cls
PSet (wide * cell, wide * cell) 'prime pump
Hilbert 0, 0, wide, 0, 0
Sleep
System

Sub Hilbert (x As Integer, y As Integer, lg As Integer, p As Integer, q As Integer)
    Dim As Integer iL, iX, iY
    Dim As _Unsigned Long K
    iL = lg: iX = x: iY = y
    _Source H
    If iL = 1 Then
        K = Point((wide - iX) * cell, (wide - iY) * cell)
        Line -((wide - iX) * cell, (wide - iY) * cell), K
        Exit Sub
    End If
    iL = iL \ 2
    Hilbert iX + p * iL, iY + p * iL, iL, p, 1 - q
    Hilbert iX + q * iL, iY + (1 - q) * iL, iL, p, q
    Hilbert iX + (1 - p) * iL, iY + (1 - p) * iL, iL, p, q
    Hilbert iX + (1 - q) * iL, iY + q * iL, iL, 1 - p, q
End Sub