Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Fractals
#16
S Virjee Fractal

Here's a fractal I've been meaning to port to QB64 for some time! a740g's Julia Rings reminded me of it again this morning.

Finally got around to converting from SmallBASIC. It's a little off the SB version but I animated it to make up the difference Big Grin while rocking back and forth (mostly p values) it is silently zooming out until it reaches a max then starts over in slightly different values of p and q

Code: (Select All)
_Title "S Virjee Fractal" ' b+ trans from SmallBASIC 2024-10-02  animated zoom, dp, dq added
'Written for Smallbasic Aug 2013 - S Virjee

Dim As Long xmax, ymax
xmax = 1300: ymax = 700
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 0, 0
Dim col As _Unsigned Long

centerx = xmax / 2
centery = ymax / 2
iter = 20 ' orig 20
zoom = 5 '  orig 2.8
p = -.745 ' orig -.745
q = .113 '  orig .113
'Line (0, 0)-(xmax, ymax), _, BF
oldi = 1
pqsq = (p * p + q * q)
L = (Sqr(p * p + q * q) - 1 / iter) * (Sqr(p * p + q * q) - 1 / iter)
H = (Sqr(p * p + q * q) + 1 / iter) * (Sqr(p * p + q * q) + 1 / iter)
dp = .001: dq = -.001

Do
    For x = -centerx To centerx
        For y = 0 To ymax
            c = x / xmax * (1 - zoom * 1.5)
            d = y / ymax * (1 - zoom)
            ztot = 0
            i = 1
            z = 1
            While i < iter And z < zoom * 1.5
                real = c * c - d * d + p
                imag = 2 * c * d + q
                c = real / Sgn(d - i)
                d = imag
                z = (c * c + d * d)
                If (z < H) Then
                    If (z > L) And (i > 0) Then
                        ztot = ztot + (1 - (Abs((z - pqsq) / z) / (i / (iter))))
                        oldi = i
                        'if i<25 and z>0 then i=abs((c*d+q))*i
                    End If
                End If
                i = i + 1
            Wend
            If ztot >= 0 Then i = Int(Sqr(ztot) * 256)
            If i < 256 Then red = i: green = 0: blue = 0
            If i > 255 And i <= 512 Then green = i - 256: blue = 0: red = 255
            If i > 511 Then green = 255: blue = 0: red = 255
            If i > 511 And i <= 768 Then blue = i - 512: red = 255: green = 255
            If i > 768 And i <= 1026 Then blue = 255: red = 255: green = 255
            If i > 1026 Then blue = 55: red = 255: green = 55
            gray = Int((red + green + blue) * .33)

            ' hot = if(max(red,green,blue)<255,max(red,green,blue),0)   ' what???
            hot = max(red, max(green, blue))
            If hot > 255 Then hot = -128
            If hot < 0 Then hot = -255
            ' ???

            If oldi = 1 Then red = hot: 'Outer Circle 1 Figure 8
            If oldi = 2 Then green = hot 'Outer Circle 2
            If oldi = 3 Then red = hot: blue = gray 'Inner Circle Figure 8 - Yellow
            If oldi = 4 Then blue = hot: green = red: red = gray 'Inner to 2/Outer Circle 4 Loops top
            If oldi >= 5 Then red = Int((hot + blue + green) * .33) / (oldi): 'This is main color
            'col = -red + (256 * -green) + (256 * 256 * -blue)
            col = _RGB32(red, green, blue)
            PSet (centerx + x, centery - y), col
            PSet (xmax - centerx - x, centery + y), col
        Next y
    Next x
    _Title "S Virjee Fractal" + Str$(zoom) + Spc(2) + Str$(p) + Spc(2) + Str$(q)
    _Display
    zoom = zoom * .999
    If zoom < 2.4 Then zoom = 5
    p = p + dp
    If p < -.8 Then dp = -dp: p = -.8
    If p > -.7 Then dp = -dp: p = -.7
    q = q + dq
    If q > .13 Then dq = -dq: q = .13
    If q < .11 Then dq = -dq: q = .11
Loop

Function max& (a&, b&)
    If a& > b& Then max& = a& Else max& = b&
End Function


Attached Files Image(s)
   
b = b + ...
Reply


Messages In This Thread
Fractals - by bplus - 05-19-2022, 07:34 PM
RE: Fractals - by bplus - 05-19-2022, 07:46 PM
RE: Fractals - by bplus - 05-19-2022, 07:52 PM
RE: Fractals - by bplus - 05-19-2022, 08:03 PM
RE: Fractals - by bplus - 05-19-2022, 08:25 PM
RE: Fractals - by bplus - 05-19-2022, 08:33 PM
RE: Fractals - by TarotRedhand - 05-19-2022, 10:33 PM
RE: Fractals - by bplus - 05-20-2022, 01:14 AM
RE: Fractals - by TarotRedhand - 05-20-2022, 07:01 AM
RE: Fractals - by bplus - 05-20-2022, 03:55 PM
RE: Fractals - by TarotRedhand - 05-21-2022, 10:12 PM
RE: Fractals - by bplus - 05-21-2022, 11:16 PM
RE: Fractals - by bplus - 05-21-2022, 11:33 PM
RE: Fractals - by bplus - 06-03-2022, 03:37 PM
RE: Fractals - by bplus - 06-03-2022, 03:43 PM
RE: Fractals - by bplus - 10-02-2024, 08:01 PM



Users browsing this thread: 3 Guest(s)