Author Topic: Sierpinski Circled  (Read 71 times)

B+

  • Sr. Member
  • ****
  • Posts: 495
    • View Profile
Sierpinski Circled
« on: 04. April 2018, 23:59:47 »
Code: [Select]
A new twist on an old fractal. Sierpinski triangle generalized and made dynamic for any regular poly though does not work well beyond 8 or 9.
[c_TITLE "Sierepinski Circled by bplus 2018-04-04 QB64 v 11-06-2017"
CONST xmax = 800
CONST ymax = 600
RANDOMIZE TIMER
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
FOR n = 3 TO 8
    a = 0
    COLOR _RGBA((RND * 155 + 100) * INT(RND * 2), RND * 155 + 100, (RND * 155 + 100) * INT(RND * 2), 40)
    WHILE a < _PI(2) - _PI(1 / 360)
        CLS
        a = a + _PI(1 / 360)
        levels = 9 - n + 3
        RecurringCircles xmax / 2, ymax / 2, ymax / 8, n, a, levels
        _DISPLAY
        _LIMIT 200
    WEND
    _DELAY 5
NEXT
SUB RecurringCircles (x, y, r, n, rao, level)
    fcirc x, y, r
    IF level > 0 THEN
        ra = _PI(2) / n
        FOR i = 0 TO n - 1
            x1 = x + 1.5 * r * COS(i * ra + rao + _PI(-.5))
            y1 = y + 1.5 * r * SIN(i * ra + rao + _PI(-.5))
            RecurringCircles x1, y1, r * .5, n, 2 * rao, level - 1
        NEXT
    END IF
END SUB

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE (CX - X, CY)-(CX + X, CY), , BF

    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    WEND
END SUB

ode]


The screen shots are still shots of final positions (or start).
« Last Edit: 05. April 2018, 00:01:28 by B+ »