Fractals! : Part 2
#1
Hi everyone! Smile
I've again coded  some fractals... This time I've shown some L-System fractal.

1. L-Systems Fractals (Contain 12 L-system fractals)  Smile
Code:
'Coded By Ashish in QB64
'Twiter : @KingOfCoders
_TITLE "Fractals [Part 2 : L-System]"

SCREEN _NEWIMAGE(800, 600, 32)

TYPE rule_type
    token AS STRING * 1
    replace AS STRING * 256
END TYPE


DIM SHARED fractalsName(11) AS STRING
DIM SHARED fractalRules(14) AS rule_type


fractalsName(0) = "Board": fractalRules(0).token = "F": fractalRules(0).replace = "FF+F+F+F+FF"
fractalsName(1) = "Crystal": fractalRules(1).token = "F": fractalRules(1).replace = "FF+F++F+F"
fractalsName(2) = "Peano Curve": fractalRules(2).token = "X": fractalRules(2).replace = "XFYFX+F+YFXFY-F-XFYFX": fractalRules(3).token = "Y": fractalRules(3).replace = "YFXFY-F-XFYFX+F+YFXFY"
fractalsName(3) = "Quadratic Gosper": fractalRules(4).token = "X": fractalRules(4).replace = "XFX-YF-YF+FX+FX-YF-YFFX+YF+FXFXYF-FX+YF+FXFX+YF-FXYF-YF-FX+FX+YFYF-": fractalRules(5).token = "Y": fractalRules(5).replace = "+FXFX-YF-YF+FX+FXYF+FX-YFYF-FX-YF+FXYFYF-FX-YFFX+FX+YF-YF-FX+FX+YFY"
fractalsName(4) = "Quadratic Snowflake": fractalRules(6).token = "F": fractalRules(6).replace = "F-F+F+F-F"
fractalsName(5) = "Quadratic Koch Island": fractalRules(7).token = "F": fractalRules(7).replace = "F-FF+FF+F+F-F-FF+F+F-F-FF-FF+F"
fractalsName(6) = "Square Sierpinski": fractalRules(8).token = "X": fractalRules(8).replace = "XF-F+F-XF+F+XF-F+F-X"
fractalsName(7) = "Triangle": fractalRules(9).token = "F": fractalRules(9).replace = "F-F+F"
fractalsName(8) = "Von Koch Snowflake": fractalRules(10).token = "F": fractalRules(10).replace = "F-F++F-F"
fractalsName(9) = "Hilbert": fractalRules(11).token = "X": fractalRules(11).replace = "-YF+XFX+FY-": fractalRules(12).token = "Y": fractalRules(12).replace = "+XF-YFY-FX+"
fractalsName(10) = "Cross": fractalRules(13).token = "F": fractalRules(13).replace = "F+F-F+F+F"
fractalsName(11) = "Pentaplexity": fractalRules(14).token = "F": fractalRules(14).replace = "F++F++F|F-F++F"


DO
    choice = getChoice
    IF choice >= 0 AND choice <= UBOUND(fractalsName) THEN
        _TITLE _TITLE$ + " " + fractalsName(choice)
        SELECT CASE choice
            CASE 0
                g$ = prepareGrammer("F+F+F+F", 0, 0, 5)
                angle! = 90
            CASE 1
                g$ = prepareGrammer("F+F+F+F", 1, 1, 5)
                angle! = 90
            CASE 2
                g$ = prepareGrammer("X", 2, 3, 4)
                angle! = 90
            CASE 3
                g$ = prepareGrammer("-YF", 4, 5, 3)
                angle! = 90
            CASE 4
                g$ = prepareGrammer("F", 6, 6, 5)
                angle! = 90
            CASE 5
                g$ = prepareGrammer("F+F+F+F", 7, 7, 3)
                angle! = 90
            CASE 6
                g$ = prepareGrammer("F+XF+F+XF", 8, 8, 5)
                angle! = 90
            CASE 7
                g$ = prepareGrammer("F", 9, 9, 7)
                angle! = 120
            CASE 8
                g$ = prepareGrammer("F++F++F", 10, 10, 5)
                angle! = 60
            CASE 9
                g$ = prepareGrammer("X", 11, 12, 7)
                angle! = 90
            CASE 10
                g$ = prepareGrammer("F+F+F+F", 13, 13, 6)
                angle! = 90
            CASE 11
                g$ = prepareGrammer("F++F++F++F++F", 14, 14, 5)
                angle! = 36

        END SELECT
        showControl
        x = 100
        y = 100
        r = 3
        DO
            CLS

            IF _KEYDOWN(ASC("w")) THEN y = y - 2
            IF _KEYDOWN(ASC("s")) THEN y = y + 2
            IF _KEYDOWN(ASC("a")) THEN x = x - 2
            IF _KEYDOWN(ASC("d")) THEN x = x + 2
            IF _KEYDOWN(ASC("q")) THEN r = r + .1
            IF _KEYDOWN(ASC("e")) AND r > 1 THEN r = r - .1
            IF _KEYDOWN(27) THEN _AUTODISPLAY: EXIT DO
            drawFractal g$, angle!, r, x, y

            _LIMIT 40
            _DISPLAY

        LOOP
    ELSE
        PRINT "Wrong Choice"
        _DELAY 1
    END IF
    _KEYCLEAR
LOOP

FUNCTION prepareGrammer$ (axm$, s, e, N)
    DIM fractalRule(e - s) AS rule_type
    FOR i = s TO e
        fractalRule(i - s).token = fractalRules(i).token
        fractalRule(i - s).replace = RTRIM$(fractalRules(i).replace)
    NEXT
    prepareGrammer$ = generateGrammer$(axm$, fractalRule(), N)
END FUNCTION

FUNCTION getChoice ()
    _TITLE "Fractals [Part 2 : L-System]"
    CLS
    FOR i = 0 TO UBOUND(fractalsName)
        PRINT i + 1; ". "; fractalsName(i)
    NEXT
    INPUT "Enter the fractal No. : ", getChoice
    getChoice = getChoice - 1
END FUNCTION

'######################################################
'Fractal related subroutine
SUB showControl ()
    CLS
    PRINT "Use 'w' and 's' to move up and down"
    PRINT "Use 'a' and 'd' to move left and rigth"
    PRINT "Use 'q' and 'e' to zoom-in and zoom-out"
    PRINT "Use 'Esc' to goto fractal menu"
    PRINT "Hit a Key"
    SLEEP
END SUB

SUB drawFractal (grammer$, ang!, r, x, y)
    ang2! = 0
    px = x
    py = y
    FOR i = 1 TO LEN(grammer$)
        ca$ = MID$(grammer$, i, 1)
        SELECT CASE ca$
            CASE "F"
                xx = COS(_D2R(ang2!)) * r + px
                yy = SIN(_D2R(ang2!)) * r + py
                LINE (px, py)-(xx, yy)
                px = xx
                py = yy
            CASE "+"
                ang2! = ang2! + ang!
            CASE "-"
                ang2! = ang2! - ang!
            CASE "|"
                ang2! = ang2! + 180
            CASE "f"
                xx = COS(_D2R(ang2!)) * r + px
                yy = SIN(_D2R(ang2!)) * r + py
                px = xx
                py = yy
        END SELECT
    NEXT
END SUB

'L-System Function
FUNCTION generateGrammer$ (axiom$, rule() AS rule_type, n~&)
    axiom2$ = axiom$
    axiom3$ = ""
    DO
        FOR i = 1 TO LEN(axiom2$)
            ca$ = MID$(axiom2$, i, 1)
            nca$ = ca$
            FOR j = 0 TO UBOUND(rule)
                IF rule(j).token = ca$ THEN
                    nca$ = RTRIM$(rule(j).replace)
                    EXIT FOR
                END IF
            NEXT
            axiom3$ = axiom3$ + nca$
        NEXT
        axiom2$ = axiom3$
        axiom3$ = ""
        count = count + 1
        PRINT ".";
    LOOP UNTIL count >= n~&
    generateGrammer$ = axiom2$
END FUNCTION

2. Christmas Tree  Wink
Code:
'Coded By Ashish
_TITLE "Christmas Tree"
SCREEN _NEWIMAGE(800, 600, 32)
DIM SHARED sx, sy, ox, oy, z
ox = _WIDTH * .2
oy = _HEIGHT * .9
z = 500
COLOR _RGBA(255, 255, 255, 40)
drawChristmasTree 0, 0, 0
FOR i = 0 TO 50
    a = sx: b = sy
    drawChristmasTree a, b, 0
NEXT

SUB drawChristmasTree (x!, y!, N AS _UNSIGNED LONG)
    SELECT CASE RND
        CASE 0 TO 1 / 3
            xx! = -.5 * y! + .5
            yy! = .5 * x
        CASE 1 / 3 TO 2 / 3
            xx! = .5 * y! + .5
            yy! = -.5 * x + .5
        CASE ELSE
            xx! = .5 * x! + .25
            yy! = .5 * y + .5
    END SELECT
    PSET (xx! * z + ox, -yy! * z + oy)
    IF N < 10000 THEN
        drawChristmasTree xx!, yy!, N + 1
    ELSE sx = xx!: sy = yy!
    END IF
END SUB

3. Dragon  Big Grin
Code:
'Coded By Ashish
_TITLE "Dragon"
SCREEN _NEWIMAGE(800, 700, 32)
DIM SHARED sx, sy, ox, oy, z

z = 60
ox = _WIDTH * .46
oy = _HEIGHT * .09
COLOR _RGBA(255, 180, 0, 30)
drawDragon 0, 0, 0
FOR i = 0 TO 100
    a = sx: b = sy
    drawDragon a, b, 0
NEXT
SUB drawDragon (x!, y!, N AS _UNSIGNED LONG)
    SELECT CASE RND
        CASE 0 TO .8
            xx! = .824074 * x! + .281428 * y! - 1.88229
            yy! = -.212346 * x! + .864198 * y! - .110607
        CASE ELSE
            xx! = .088272 * x! + .520988 * y! + .78536
            yy! = -.463889 * x! - .377778 * y! + 8.095795
    END SELECT
    PSET (xx! * z + ox, yy! * z + oy)
    IF N < 10000 THEN
        drawDragon xx!, yy!, N + 1
    ELSE sx = xx!: sy = yy!
    END IF
END SUB

4. Spiral  Smile
Code:
'Coded By Ashish in QB64
_TITLE "IFS Spiral"

SCREEN _NEWIMAGE(800, 600, 32)

RANDOMIZE TIMER
DIM SHARED gx, gy
COLOR _RGBA(255, 255, 255, 10)
drawSpiral _WIDTH * .75, _HEIGHT * .25, 1

FOR i = 0 TO 100
    vx = gx
    vy = gy
    drawSpiral vx, vy, 1
NEXT


SUB drawSpiral (x!, y!, N~&)
    SELECT CASE RND(1)
        CASE 0 TO 0.05
            xx! = -0.121212 * x! + 0.257576 * y! - 6.721654
            yy! = 0.151515 * x! + 0.053030 * y! + 1.377236
        CASE 0.05 TO 0.10
            xx! = 0.181818 * x! - 0.136364 * y! + 6.086107
            yy! = 0.090909 * x! + 0.181818 * y! + 1.568035
        CASE ELSE
            xx! = 0.787879 * x! - 0.424242 * y! + 1.758647
            yy! = 0.242424 * x! + 0.859848 * y! + 1.408065
    END SELECT
    PSET (xx! * 60 + _WIDTH * .5, yy! * 60)
    IF N~& < 10000 THEN
        drawSpiral xx!, yy!, N~& + 1
    ELSE
        gx = xx!
        gy = yy!
    END IF
END SUB

5. Old Tree  Wink
Code:
'Coded By Ashish
_TITLE "Old Tree"
SCREEN _NEWIMAGE(800, 600, 32)
DIM SHARED sx, sy, ox, oy, z
ox = _WIDTH * .11 'x-offset
oy = _HEIGHT * 1.1 'y-offset
z = 600 'zoom-value
COLOR _RGBA(255, 255, 255, 40)
drawOldTree 0, 0, 0

FOR i = 0 TO 100
    a = sx: b = sy
    drawOldTree a, b, 0
NEXT
sleep
SUB drawOldTree (x!, y!, N AS _UNSIGNED LONG)
    SELECT CASE RND
        CASE 0 TO .2
            xx! = .195 * x! - .488 * y! + .4431
            yy! = .344 * x! + .443 * y! + .2452
        CASE .2 TO .4
            xx! = .462 * x! + .414 * y! + .2511
            yy! = -.252 * x! + .361 * y! + .5692
        CASE .4 TO .6
            xx! = -.637 * x! + .8562
            yy! = .501 * y! + .2512
        CASE .6 TO .8
            xx! = -.035 * x! + .07 * y! + .4884
            yy! = -.469 * x! + .022 * y! + .5069
        CASE ELSE
            xx! = -.058 * x! - .07 * y! + .5976
            yy! = .453 * x! - .111 * y! + .0969
    END SELECT
    'IF N MOD 1000 = 0 THEN _DELAY .01
    PSET (xx! * z + ox, oy - yy! * (z + z * .25))
    IF N < 10000 THEN
        drawOldTree xx!, yy!, N + 1
    ELSE sx = xx!: sy = yy!
    END IF
END SUB

6. Leaf  Big Grin
Code:
'Coded By Ashish in QB64
_TITLE "Leaf"
SCREEN _NEWIMAGE(800, 600, 32)
DIM SHARED sx, sy, ox, oy, z
RANDOMIZE TIMER
ox = _WIDTH * .34
oy = _HEIGHT
z = 700
COLOR _RGBA(0, 255, 0, 10)
drawLeaf 0, 0, 0
DO
    p = sx: q = sy
    drawLeaf p, q, 0
    _LIMIT 30
LOOP UNTIL INKEY$ <> ""

SUB drawLeaf (x!, y!, N AS _UNSIGNED LONG)
    DIM a(3) AS SINGLE, b(3) AS SINGLE, c(3) AS SINGLE, d(3) AS SINGLE, e(3) AS SINGLE, f(3) AS SINGLE
    a(0) = 0: a(1) = .7248: a(2) = .1583: a = (3) = .3386
    b(0) = .2439: b(1) = .0337: b(2) = -.1297: b(3) = .3694
    c(0) = 0: c(1) = -.0253: c(2) = .355: c(3) = .2227
    d(0) = .3053: d(1) = .7426: d(2) = .3676: d(3) = -.0756
    e(0) = 0: e(1) = .206: e(2) = .1383: e(3) = .0679
    f(0) = 0: f(1) = .2538: f(2) = .175: f(3) = .0826
    k = INT(RND * 4)
    xx! = a(k) * x! + b(k) * y! + e(k)
    yy! = c(k) * x! + d(k) * y! + f(k)
    PSET (xx! * z + ox, -yy! * z + oy)

    IF N < 10000 THEN
        drawLeaf xx!, yy!, N + 1
    ELSE sx = xx!: sy = yy!
    END IF
END SUB

7. Young Tree  Smile
Code:
'Coded By Ashish in QB64
DEFDBL A-Z
_TITLE "Young Tree"
SCREEN _NEWIMAGE(800, 700, 32)
DIM SHARED sx, sy, ox, oy, z
ox = _WIDTH / 2
oy = _HEIGHT
z = 300
COLOR _RGBA(255, 255, 255, 40)
drawYoungTree 0, 0, 0
FOR i = 0 TO 200
    a = sx: b = sy
    drawYoungTree a, b, 0
NEXT
SLEEP
SUB drawYoungTree (x, y, N AS _UNSIGNED LONG)
    DIM r(5), s(5), theta(5), phi(5), f(5)
    r(0) = .05: r(1) = .05: r(2) = .6: r(3) = .5: r(4) = .5: r(5) = .55
    s(0) = .6: s(1) = -.5: s(2) = .5: s(3) = .45: s(4) = .55: s(5) = .4
    theta(0) = 0: theta(1) = 0: theta(2) = .698: theta(3) = .349: theta(4) = -.524: theta(5) = -.698
    phi(0) = 0: phi(1) = 0: phi(2) = .698: phi(3) = .3492: phi(4) = -.524: phi(5) = -.698
    f(0) = 0: f(1) = 1: f(2) = .6: f(3) = 1.1: f(4) = 1: f(5) = .7
    k = INT(RND * 6)
    xx = r(k) * COS(theta(k)) * x - s(k) * SIN(phi(k)) * y
    yy = r(k) * SIN(theta(k)) * x + s(k) * COS(phi(k)) * y + f(k)
    PSET (xx * (z + z * .25) + ox, -yy * z + oy)
    IF N < 6000 THEN
        drawYoungTree xx, yy, N + 1
    ELSE sx = xx: sy = yy
    END IF
END SUB
Reply
#2
@Ashish,

Very nicely done.

The old and new tree fractals gave me some cool ideas.
Dedicated to empowering computer programming hobbyists, tinkerers, amateurs, and enthusiasts.
profile for Walter Whitman at Stack Overflow, Q&A for professional and enthusiast programmers


Reply
#3
Thanks Walter! Smile
I'm glad you like it.
Reply
#4
Ashish,

Fractals are one of my favourites. Well done!

J
May your journey be free of incident.

Live long and prosper.
Reply
#5
Yep! I second that!
B += x
Reply
#6
Thanks everyone!
You all also can try code some fractal listed here - http://paulbourke.net/fractals/
Reply
#7
@Ashish,

I fell in love with fractals when I discovered a book on them in the early to mid-1990's at the local public library. They were fun to play with and still fun to look at.

Your tree fractal demos was inspiring because I can use them to create artwork for clients at work.

I can't never get enough of fractal demos.

Thank you again for sharing.
Dedicated to empowering computer programming hobbyists, tinkerers, amateurs, and enthusiasts.
profile for Walter Whitman at Stack Overflow, Q&A for professional and enthusiast programmers


Reply
#8
Ashish,

Thanks for the advise but I have no idea how to convert those fractal formulae into a usable program. That's one of the reasons I prefer that other people, more knowledgeable and more clever than I, to apply their talents so as to amaze the rest of us...

J
May your journey be free of incident.

Live long and prosper.
Reply
#9
Ashish thanks for site link, I have it bookmarked now, cool stuff.
B += x
Reply