Just 6 Fractals

[bplus]

Thumbs way up! I luv fractals!

Here is one I call Glitter Hop Along that often has a pattern that reminds me of the painting "The Scream"

Code: (Select All)

_Title "Glitter Hopalong, any key quits" 'trans from SmallBASIC 2020-04-09
'Glitter hopalong.bas SmallBASIC 2015-05-04 modified for Bpf, B+
' color changes for the night shift

Const xmax = 1200, ymax = 700
Screen _NewImage(xmax, ymax, 32)
_Delay .25
_ScreenMove _Middle

xoffs = xmax * 5 / 12
yoffs = ymax * 5 / 12
Do
    Cls
    j = Rnd * 100
    k = Rnd * 100
    x = 0: y = 0: r = 0: n = 0
    For i = 1 To 10000000
        r = Rnd * 4000
        If r > 3997 Then Color qb(Int(Rnd * 15) + 1)
        xx = y - Sgn(x) * Sqr(Abs(k * x - 1))
        y = j - x
        x = xx
        xp = x * 3 + xoffs
        yp = y * 3 + yoffs
        Circle (xp, yp), 1
    Next i
    _Delay 1
Loop Until Len(InKey$)

Function qb~& (n As Integer)
    Select Case n
        Case 0: qb~& = &HFF000000
        Case 1: qb~& = &HFF000088
        Case 2: qb~& = &HFF008800
        Case 3: qb~& = &HFF008888
        Case 4: qb~& = &HFF880000
        Case 5: qb~& = &HFF880088
        Case 6: qb~& = &HFF888800
        Case 7: qb~& = &HFFCCCCCC
        Case 8: qb~& = &HFF888888
        Case 9: qb~& = &HFF0000FF
        Case 10: qb~& = &HFF00FF00
        Case 11: qb~& = &HFF00FFFF
        Case 12: qb~& = &HFFFF0000
        Case 13: qb~& = &HFFFF00FF
        Case 14: qb~& = &HFFFFFF00
        Case 15: qb~& = &HFFFFFFFF
    End Select
End Function