Fractals!
#1
Rainbow 
Hi Everyone! Smile
This video has planted the seed of fractal into my Brain.
So, I was inspired by that video & I coded a lot of fractals.

and They are as follows -

1. Circle Fractal Big Grin
Code:
'Idea from  https://youtu.be/jPsZwrV9ld0
'Coded by Ashish
_TITLE "Circle Fractal [Press 'w' and 's' to zoom-in and zoom-out]"
SCREEN _NEWIMAGE(800, 600, 32)
r = 40
needUpdate = 1
DO
    IF _KEYDOWN(ASC("w")) THEN r = r + s: needUpdate = 1
    IF _KEYDOWN(ASC("s")) AND r > 2 THEN r = r - s: needUpdate = 1
    IF needUpdate = 1 THEN
        needupadte = 0
        drawCircle 400, 300, r
        _DISPLAY
        CLS
    END IF
    s = map(r, 1, 10000, 1, 300)
    _LIMIT 60
LOOP

SUB drawCircle (x, y, r)
    CIRCLE (x, y), r
    IF r > 2 THEN
        drawCircle x + r, y, r / 2
        drawCircle x - r, y, r / 2
    END IF
END SUB
'taken from QB64's p5.js
'http://bit.ly/p5jsbas
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION

2. Arc Fractal Smile
Code:
'Coded By Ashish
_TITLE "Press 'w' and 's' to zoom-in and zoom-out"
SCREEN _NEWIMAGE(800, 600, 32)
r = 40

DO
    IF _KEYDOWN(ASC("w")) THEN r = r + s: needUpdate = 1
    IF _KEYDOWN(ASC("s")) AND r > 2 THEN r = r - s: needUpdate = 1
    IF needUpdate = 1 THEN
        needUpdate = 0
        drawArc 400, 300, r, 1
        _DISPLAY
        CLS
    END IF
    _LIMIT 60
    s = map(r, 1, 10000, 1, 300)
LOOP
SUB drawArc (x, y, r, f)
    IF f = 1 THEN
        CIRCLE (x, y), r, , 0, _PI
    ELSE
        CIRCLE (x, y), r, , _PI, _PI(2)
    END IF
    IF r > 2 THEN
        IF f = 1 THEN e = 0 ELSE e = 1
        drawArc x + r, y, r / 2, e
        drawArc x - r, y, r / 2, e
    END IF
END SUB
'taken from QB64's p5.js
'http://bit.ly/p5jsbas
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION

3. Wonderful Fractal Trees Wink
Code:
'Coded By Ashish
_TITLE "Fractal_Trees"
SCREEN _NEWIMAGE(800, 600, 32)
radius = 130
DO
    CLS
    drawTree 400, 400, radius, _PI(3 / 2), s
    internalp5line 400, 600, 400, 400, radius / 10, _RGB(160, 10, 10)
    _DISPLAY
    _LIMIT 40
    s = ABS(SIN(v#)) * 0.25 + 0.2
    v# = v# + 0.01
LOOP
SLEEP

SUB drawTree (x, y, r, a, s)
    IF r < 14 THEN c~& = _RGB(10, 200, 10) ELSE c~& = _RGB(160, 10, 10)
    internalp5line x, y, x + r * COS(a - s), y + r * SIN(a - s), r / 10, c~&
    internalp5line x, y, x + r * COS(a + s * 3), y + r * SIN(a + s * 3), r / 10, c~&

    IF r > 2 THEN
        drawTree x + r * COS(a - s), y + r * SIN(a - s), r * 0.67, a - s, s
        drawTree x + r * COS(a + s * 3), y + r * SIN(a + s * 3), r * 0.67, a + s * 3, s
    END IF

END SUB

SUB CircleFill (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG)
    'This sub from here: http://www.qb64.net/forum/index.php?topic=1848.msg17254#msg17254
    DIM Radius AS LONG
    DIM RadiusError AS LONG
    DIM X AS LONG
    DIM Y AS LONG

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

    IF Radius = 0 THEN PSET (CX, CY), C: 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), C, 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), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF

            X = X - 1
            RadiusError = RadiusError - X * 2

        END IF

        Y = Y + 1

        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF

    WEND

END SUB

'taken from QB64's p5.js
'http://bit.ly/p5jsbas

SUB internalp5line (x0!, y0!, x1!, y1!, s!, col~&
    dx! = x1! - x0!
    dy! = y1! - y0!
    d! = SQR(dx! * dx! + dy! * dy!)
    FOR i = 0 TO d!
        CircleFill x0! + dxx!, y0! + dyy!, s!, col~&
        dxx! = dxx! + dx! / d!
        dyy! = dyy! + dy! / d!
    NEXT
END SUB

FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION

4. Quadrilateral Fractal Big Grin
Code:
'Coded By Ashish
_TITLE "Quads!!"
SCREEN _NEWIMAGE(800, 600, 32)
k = 100
DO
    CLS
    quad_fractal 400, 300, 100, k
    _DISPLAY
    _DELAY .5
    k = k / 1.5
LOOP UNTIL k < 2
SUB quad_fractal (x, y, r, e)
    LINE (x - r, y - r)-(x + r, y - r)
    LINE (x + r, y - r)-(x + r, y + r)
    LINE (x + r, y + r)-(x - r, y + r)
    LINE (x - r, y + r)-(x - r, y - r)
    IF r > e THEN

        quad_fractal x - r, y - r, r / 2, e
        quad_fractal x + r, y - r, r / 2, e
        quad_fractal x + r, y + r, r / 2, e
        quad_fractal x - r, y + r, r / 2, e
    END IF
END SUB
'taken from QB64's p5.js
'http://bit.ly/p5jsbas
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION

'Calculate the distance between two points.
FUNCTION dist! (x1!, y1!, x2!, y2!)
    dist! = SQR((x2! - x1!) ^ 2 + (y2! - y1!) ^ 2)
END FUNCTION

5. Quadrilateral & Circle Fractal Smile
Code:
'Coded By Ashish
_TITLE "Quad Inside Circle Inside Quad......"
SCREEN _NEWIMAGE(800, 600, 32)
r = 100
needupdate = 1
DO
    IF _KEYDOWN(ASC("w")) THEN r = r + s: needupdate = 1
    IF _KEYDOWN(ASC("s")) AND r > 2 THEN r = r - s: needupdate = 1
    IF needupdate = 1 THEN
        needupdate = 0
        quad_circle 400, 300, 0, 0, r, 0
        _DISPLAY
        CLS
        s = map(r, 1, 10000, 1, 300)
    END IF
    _LIMIT 40
LOOP

SUB quad_circle (x, y, x2, y2, r, e)
    IF e = 1 THEN
        LINE (x, y)-(x2, y2), , B
    ELSE
        CIRCLE (x, y), r
    END IF
    IF r > 2 THEN
        IF e = 1 THEN
            IF x2 > x THEN newR = x2 - x ELSE newR = x - x2
            quad_circle (x + x2) / 2, (y + y2) / 2, 0, 0, newR / 2, 0
        ELSE
            tx1 = x + r * COS(_PI - .7)
            ty1 = y + r * SIN(_PI - .7)
            tx2 = x + r * COS(_PI(2) - .7)
            ty2 = y + r * SIN(_PI(2) - .7)
            quad_circle tx1, ty1, tx2, ty2, r / 2, 1
        END IF
    END IF
END SUB
'taken from QB64's p5.js
'http://bit.ly/p5jsbas
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION

'Calculate the distance between two points.
FUNCTION dist! (x1!, y1!, x2!, y2!)
    dist! = SQR((x2! - x1!) ^ 2 + (y2! - y1!) ^ 2)
END FUNCTION

6. Triangle made of Square Wink
Code:
'Coded by Ashish
_TITLE "Square_formed_triangle"
SCREEN _NEWIMAGE(800, 600, 32)

draw_pattern 250, 450, 100

SUB draw_pattern (x, y, r)
    LINE (x - r, y - r)-(x + r, y + r), _RGB(RND * 255, RND * 255, RND * 255), BF
    IF r > 1 THEN
        v = r * 2
        draw_pattern x, y - v, r / 2
        draw_pattern x + v, y - r * 2, r / 2
        draw_pattern x + v, y, r / 2
    END IF
END SUB


'taken from QB64's p5.js
'http://bit.ly/p5jsbas
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION

'Calculate the distance between two points.
FUNCTION dist! (x1!, y1!, x2!, y2!)
    dist! = SQR((x2! - x1!) ^ 2 + (y2! - y1!) ^ 2)
END FUNCTION

7. Sierpinski Carpet Big Grin
Code:
'Coded By Ashish
_TITLE "Sierpinski_Carpet"
SCREEN _NEWIMAGE(1000, 700, 32)
DIM SHARED lowX, highX, lowY, highY
lowX = 500
highX = 500
highY = 500
lowY = 500
CLS , _RGB(255, 255, 255)
draw_pattern 500, 350, 120

LINE (0, 0)-(lowX, _HEIGHT), _RGB(0, 0, 0), BF
LINE (_WIDTH - 1, 0)-(highX, _HEIGHT), _RGB(0, 0, 0), BF
LINE (0, 0)-(_WIDTH, lowY), _RGB(0, 0, 0), BF
LINE (0, _HEIGHT)-(_WIDTH, highY), _RGB(0, 0, 0), BF
SLEEP
draw_pattern2 500, 350, 120
SLEEP
SUB draw_pattern (x, y, r)

    LINE (x - r, y - r)-(x + r, y + r), _RGB(0, 0, 0), BF

    IF x - r < lowX THEN lowX = x - r
    IF x + r > highX THEN highX = x + r
    IF y - r < lowY THEN lowY = y - r
    IF y + r > highY THEN highY = y + r

    IF r > 3 THEN
        v = r * 2
        draw_pattern x, y - v, r / 3
        draw_pattern x, y + v, r / 3

        draw_pattern x + v, y, r / 3
        draw_pattern x - v, y, r / 3

        draw_pattern x - v, y - v, r / 3
        draw_pattern x + v, y + v, r / 3
        draw_pattern x - v, y + v, r / 3
        draw_pattern x + v, y - v, r / 3
    END IF
END SUB
SUB draw_pattern2 (x, y, r)

    LINE (x - r, y - r)-(x + r, y + r), _RGB(map(x, lowX, highX, 0, 255), map(y, lowY, highY, 255, 0), map(x + y, lowX + lowY, highX + highY, 255, 0)), BF

    'IF x - r < lowX THEN lowX = x - r
    'IF x + r > highX THEN highX = x + r
    'IF y - r < lowY THEN lowY = y - r
    'IF y + r > highY THEN highY = y + r

    IF r > 3 THEN
        v = r * 2
        draw_pattern2 x, y - v, r / 3
        draw_pattern2 x, y + v, r / 3

        draw_pattern2 x + v, y, r / 3
        draw_pattern2 x - v, y, r / 3

        draw_pattern2 x - v, y - v, r / 3
        draw_pattern2 x + v, y + v, r / 3
        draw_pattern2 x - v, y + v, r / 3
        draw_pattern2 x + v, y - v, r / 3
    END IF
END SUB



'taken from QB64's p5.js
'http://bit.ly/p5jsbas
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION

'Calculate the distance between two points.
FUNCTION dist! (x1!, y1!, x2!, y2!)
    dist! = SQR((x2! - x1!) ^ 2 + (y2! - y1!) ^ 2)
END FUNCTION

8. Kite Fractal Smile
Code:
'Coded By Ashish
_TITLE "Kite Fractal"
SCREEN _NEWIMAGE(800, 600, 32)
drawQuads 400, 500, 140, .5
SLEEP
SUB drawQuads (x, y, s, a)
    LINE (x, y)-(x + s * COS(_PI(2) - a), (y - s) + s * SIN(_PI(2) - a))
    LINE (x, y)-(x + s * COS(_PI + a), (y - s) + s * SIN(_PI + a))
    IF s > 1 THEN
        drawQuads x + s * COS(_PI(2) - a), (y - s) + s * SIN(_PI(2) - a), s / 2, a
        drawQuads x + s * COS(_PI + a), (y - s) + s * SIN(_PI + a), s / 2, a
    END IF
END SUB

9. Dragon Curve Wink
Code:
'Coded By Ashish
_TITLE "Dragon Curve Fractal"
screen _newimage(800,600,32)
randomize timer

drawPattern 400,300,400,300,60,rnd*_PI(2),rnd*255,rnd*255,rnd*255
sleep

do
    xx = rnd*_width
    yy = rnd*_height
    drawPattern xx,yy,xx,yy,60,rnd*_PI(2),rnd*255,rnd*255,rnd*255 ': f = 0
    line (0,0)-(_width,_height),_RGBA(0,0,0,30),BF
    f=f+1
    _display
    _limit 60
loop

sub drawPattern (cx,cy,x,y,r,a,mR,mG,mB)
    d = dist(x,y,cx,cy)
    circlefill x,y,r,_rgb(map(d,0,200,mR,0),map(d+y,y,d+y,0,mG),map(d,0,200,0,mB))
    if r>1 then
        drawPattern cx,cy,x+r*1.75*cos(a),y+r*1.75*sin(a),r*0.75,a-0.62,mR,mG,mB
        drawPattern cx,cy,x+r*1.75*cos(a+_PI),y+r*1.75*sin(a+_PI),r*0.75,(a+_PI)-0.62,mR,mG,mB')+_PI
    end if
end sub

SUB CircleFill (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG)
    'This sub from here: http://www.qb64.net/forum/index.php?topic=1848.msg17254#msg17254
    DIM Radius AS LONG
    DIM RadiusError AS LONG
    DIM X AS LONG
    DIM Y AS LONG

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

    IF Radius = 0 THEN PSET (CX, CY), C: 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), C, 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), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF

            X = X - 1
            RadiusError = RadiusError - X * 2

        END IF

        Y = Y + 1

        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF

    WEND

END SUB

FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION

FUNCTION dist! (x1!, y1!, x2!, y2!)
    dist! = SQR((x2! - x1!) ^ 2 + (y2! - y1!) ^ 2)
END FUNCTION


Attached Files Thumbnail(s)

Reply
#2
Can never tire of fractals - Cool...

J
May your journey be free of incident.

Live long and prosper.
Reply
#3
Agreed! Now I know what Ashish has been up to Smile
B += x
Reply
#4
Because i dont have qb64 on my comp
i was wondering what is KITE fractal and what is QUADRILITERAL
?
any screenshot?
Reply
#5
Thank You Coders! Big Grin
@Aurel
I added screenshot for you in my first post.
Reply
#6
Some more fractals -

10. Triangle made up of Circle Smile
Code:
'Coded By Ashish
_TITLE "Triangle Formed By Circle"
SCREEN _NEWIMAGE(1000, 600, 32)

drawPattern 500, 200, 80, .5

SUB drawPattern (x, y, r, t)
    c~& = _RGB(RND * 255, RND * 255, RND * 255)
    CIRCLE (x, y), r, c~&
    PAINT (x, y), c~&, c~&
    IF r > 2 THEN
        drawPattern x + r * 1.75 * COS(t), y + r * 1.75 * SIN(t), r * 0.75, t
        drawPattern x + r * 1.75 * COS(_PI + t), y + r * 1.75 * SIN(_PI - t), r * 0.75, t
    END IF
END SUB

11. Vicsek Fractal Big Grin
Code:
'Coded By Ashish with <3
_TITLE "Vicsek Fractal"
SCREEN _NEWIMAGE(800, 600, 32)

drawPattern 400, 300, 180

SUB drawPattern (x, y, r)
    LINE (x, y)-(x - r, y)
    LINE (x, y)-(x + r, y)
    LINE (x, y)-(x, y - r)
    LINE (x, y)-(x, y + r)
    IF r > 2 THEN
        drawPattern x - r, y, r / 3
        drawPattern x + r, y, r / 3
        drawPattern x, y + r, r / 3
        drawPattern x, y - r, r / 3
        drawPattern x, y, r / 3
    END IF
END SUB

12. Circle Illusion, as you will observe circle in it. Wink
Code:
'Coded By Ashish with <3
'Can you observe circle in this fractal!?
'I was able to do so...
_TITLE "Circle with 4 line"
SCREEN _NEWIMAGE(800, 600, 32)


drawPattern 400, 300, 200


SUB drawPattern (x, y, r)
    LINE (x, y)-(x - r, y)
    LINE (x, y)-(x + r, y)
    LINE (x, y)-(x, y - r)
    LINE (x, y)-(x, y + r)

    IF r > 21 THEN
        drawPattern (x - r) + r / 3, y, r / 2
        drawPattern (x + r) - r / 3, y, r / 2
        drawPattern x, (y + r) - r / 3, r / 2
        drawPattern x, (y - r) + r / 3, r / 2
    END IF
END SUB

13. Sierpinski Triangles
Code:
'Coded By Ashish with <3
_TITLE "Sierpinski Triangle"
SCREEN _NEWIMAGE(800, 600, 32)

drawPattern 400, 400, 160

SUB drawPattern (x, y, r)
    LINE (x + r * COS(_D2R(330)), y + r * SIN(_D2R(330)))-(x + r * COS(_D2R(90)), y + r * SIN(_D2R(90)))
    LINE (x + r * COS(_D2R(90)), y + r * SIN(_D2R(90)))-(x + r * COS(_D2R(210)), y + r * SIN(_D2R(210)))
    LINE (x + r * COS(_D2R(210)), y + r * SIN(_D2R(210)))-(x + r * COS(_D2R(330)), y + r * SIN(_D2R(330)))
    IF r > 4 THEN
        drawPattern x + r * COS(_D2R(30)), y + r * SIN(_D2R(30)), r / 2
        drawPattern x + r * COS(_D2R(150)), y + r * SIN(_D2R(150)), r / 2
        drawPattern x + r * COS(_D2R(270)), y + r * SIN(_D2R(270)), r / 2
    END IF
END SUB


Attached Files Thumbnail(s)

Reply
#7
14. 3D Vicsek Fractal
Code:
'3D Vicsek Fractal!
'By Ashish Kushwaha

DECLARE LIBRARY
    SUB gluLookAt (BYVAL eyeX#, BYVAL eyeY#, BYVAL eyeZ#, BYVAL centerX#, BYVAL centerY#, BYVAL centerZ#, BYVAL upX#, BYVAL upY#, BYVAL upZ#)
END DECLARE

_TITLE "3D Vicsek Fractal"
SCREEN _NEWIMAGE(800, 600, 32)

DIM SHARED glAllow AS _BYTE

glAllow = -1
DO
    _LIMIT 20
LOOP UNTIL INKEY$ <> ""

SUB _GL () STATIC
    IF NOT glAllow THEN EXIT SUB

    IF NOT glSetup THEN
        _glViewport 0, 0, _WIDTH, _HEIGHT
        aspect# = _WIDTH / _HEIGHT
        glSetup = -1
    END IF

    _glMatrixMode _GL_PROJECTION
    _gluPerspective 45.0, aspect#, 1.0, 1000.0

    _glMatrixMode _GL_MODELVIEW

    gluLookAt 0, 0, 5, 0, 0, -1, 0, -1, 0

    '_glBegin _GL_LINES
    '_glVertex2f -1, 0
    '_glVertex2f 1, 0
    '_glVertex2f 0, 1
    '_glVertex2f 0, -1
    '_glEnd
    _glRotatef clock# * 60, 0, 1, 0
    _glRotatef clock# * 90, 1, 0, 0
    _glRotatef clock# * 30, 0, 0, 1

    drawPattern3D 0, 0, 0, 2

    clock# = clock# + 0.01
    _glFlush
END SUB

SUB drawPattern3D (x, y, z, r)
    _glBegin _GL_LINES

    _glVertex3f x - r, y, z
    _glVertex3f x + r, y, z

    _glVertex3f x, y - r, z
    _glVertex3f x, y + r, z

    _glVertex3f x, y, z - r
    _glVertex3f x, y, z + r

    _glEnd

    IF r > 0.05 THEN
        drawPattern3D x, y, z, r / 3

        drawPattern3D x - r, y, z, r / 3
        drawPattern3D x + r, y, z, r / 3

        drawPattern3D x, y - r, z, r / 3
        drawPattern3D x, y + r, z, r / 3

        drawPattern3D x, y, z - r, r / 3
        drawPattern3D x, y, z + r, r / 3
    END IF
END SUB
Reply
#8
Wow, that is better than rotating 3D cubes ^ 3!

Ashish, I am liking how you started with simple designs and then start jazzing them up.
B += x
Reply
#9
Ashish, I Carbonated your Circle Fractal!

Code:
_TITLE "Carbonated Circle Fractal by bplus 2017-10-15"
' working from Ashish simple Circle Fractal

CONST xmax = 660
CONST ymax = 700
DEFINT A-Z
SCREEN _NEWIMAGE(xmax, ymax, 32)
_DELAY .8 'sorry, my system needs .6 delay for _MIDDLE, yours may NOT
_SCREENMOVE _MIDDLE ' not working with 32 in line above

RANDOMIZE TIMER
COMMON SHARED cx(), cy(), cr(), ci

REDIM cx(0): REDIM cy(0): REDIM cr(0)
r1 = 150: basey = ymax - r1 - 10
drawCircle xmax / 2, basey, r1
antigravity = -.6
nb = 60
DIM bx(nb), by(nb), br(nb), bdy(nb)
DIM bc&(nb)
FOR i = 1 TO nb
    r = rand%(1, ci)
    bx(i) = cx(r): by(i) = rand(0, basey): br(i) = cr(r): bdy(i) = rand(-4, -2)
    bc&(i) = _RGB(RND * 155 + 100, RND * 155 + 100, RND * 155 + 100)
NEXT
DO
    CLS
    WHILE 1
        CLS
        FOR i = 1 TO ci
            COLOR &HFF88DDDD
            CIRCLE (cx(i), cy(i)), cr(i)
        NEXT
        FOR i = 1 TO nb
            COLOR bc&(i)
            CIRCLE (bx(i), by(i)), br(i)
            IF by(i) - 4 + br(i) < 0 THEN
                r = rand%(1, ci)
                bx(i) = cx(r): by(i) = cy(r): br(i) = cr(r): bdy(i) = rand(-4, -2)
                bc& = _RGB(rand%(100, 255), rand(100, 255), rand(100, 255))
            ELSE
                bdy(i) = bdy(i) + antigravity
                by(i) = by(i) + bdy(i)
            END IF
        NEXT
        _DISPLAY
        _LIMIT 10

    WEND
LOOP

SUB drawCircle (x, y, r)
    CIRCLE (x, y), r
    ci = ci + 1
    REDIM _PRESERVE cx(ci): cx(ci) = x
    REDIM _PRESERVE cy(ci): cy(ci) = y
    REDIM _PRESERVE cr(ci): cr(ci) = r
    'PRINT cx(ci), cy(ci), cr(ci)
    IF r > 2 THEN
        drawCircle x + r, y, r / 2
        drawCircle x - r, y, r / 2
    END IF
END SUB

FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION

Love potion #9
Caution: this potion contains anti-gravity, drink too much and you will get high.


Attached Files Thumbnail(s)

B += x
Reply
#10
Plus, another variation:
Code:
_TITLE "Plus, another variation by bplus 2017-10-16"
'playing with Ashish circle with 4 line
'variation BF, B, B, BF
'variation #2 BF, BF, BF, BF
'variation #3 B, B, B, B
'How many plus can you find?
'then change r

SCREEN _NEWIMAGE(800, 600, 32)

drawPattern 400, 300, 290
SLEEP

SUB drawPattern (x, y, r)
   COLOR _RGB(r, 255 - r, 255 - r)
   LINE (x, y)-(x - r, y - r), , B
   LINE (x, y)-(x + r, y - r), , B
   LINE (x, y)-(x - r, y + r), , B
   LINE (x, y)-(x + r, y + r), , B

   IF r > 6 THEN
       drawPattern x - r / 2, y - r / 2, r / 2.3
       drawPattern x + r / 2, y - r / 2, r / 2.3
       drawPattern x - r / 2, y + r / 2, r / 2.3
       drawPattern x + r / 2, y + r / 2, r / 2.3
   END IF
END SUB


Attached Files Thumbnail(s)

B += x
Reply
#11
Sierpinski flies a Kite
Code:
_TITLE "Sierpinsky flys a kite by bplus 2017-10-16"
' after playing with Ashish Kite Fractal

SCREEN _NEWIMAGE(1200, 700, 32)
WHILE 1
    CLS
    drawKite 600, 540, 200, a
    _DISPLAY
    _LIMIT 20
    a = a + _PI(2 / 360)
WEND
SLEEP
SUB drawKite (xx, yy, s, a)
    x = xx: y = yy
    x2 = x + 3 * s * COS(_PI(1 / 2) - a / 2): y2 = y + 3 * s * SIN(_PI(1 / 2) - a / 2)
    x3 = x + 3 * s * COS(_PI(1 / 2) + a / 2): y3 = y + 3 * s * SIN(_PI(1 / 2) + a / 2)
    SierLineTri x, y, x2, y2, x3, y3, 0
    'LINE (x, y)-(x + s * COS(_PI(2) - a / 2), (y - s) + s * SIN(_PI(2) - a / 2))
    'LINE (x, y)-(x + s * COS(_PI + a / 2), (y - s) + s * SIN(_PI + a / 2))

    IF s > 10 THEN
        drawKite x + 1 * s * COS(_PI(2) - a), (y - s) + 1 * s * SIN(_PI(2) - a), s / 2, a
        drawKite x + 1 * s * COS(_PI + a), (y - s) + 1 * s * SIN(_PI + a), s / 2, a
    END IF
END SUB
SUB SierLineTri (x1, y1, x2, y2, x3, y3, depth)
    IF depth = 0 THEN 'draw out triangle if level 0
        LINE (x1, y1)-(x2, y2)
        LINE (x2, y2)-(x3, y3)
        LINE (x1, y1)-(x3, y3)
    END IF
    'find midpoints
    IF x2 < x1 THEN mx1 = (x1 - x2) / 2 + x2 ELSE mx1 = (x2 - x1) / 2 + x1
    IF y2 < y1 THEN my1 = (y1 - y2) / 2 + y2 ELSE my1 = (y2 - y1) / 2 + y1
    IF x3 < x2 THEN mx2 = (x2 - x3) / 2 + x3 ELSE mx2 = (x3 - x2) / 2 + x2
    IF y3 < y2 THEN my2 = (y2 - y3) / 2 + y3 ELSE my2 = (y3 - y2) / 2 + y2
    IF x3 < x1 THEN mx3 = (x1 - x3) / 2 + x3 ELSE mx3 = (x3 - x1) / 2 + x1
    IF y3 < y1 THEN my3 = (y1 - y3) / 2 + y3 ELSE my3 = (y3 - y1) / 2 + y1

    LINE (mx1, my1)-(mx2, my2) '  'draw all inner triangles
    LINE (mx2, my2)-(mx3, my3)
    LINE (mx1, my1)-(mx3, my3)

    IF depth < 4 THEN 'not done so call me again
        SierLineTri x1, y1, mx1, my1, mx3, my3, depth + 1
        SierLineTri x2, y2, mx1, my1, mx2, my2, depth + 1
        SierLineTri x3, y3, mx3, my3, mx2, my2, depth + 1
    END IF
END SUB
B += x
Reply
#12
HI
Nice fractals Ashish and Mark
but Mark you over reacted on same thing maaan !!
Ok i am interested in fractals because of one simple reason
i like to build fractal antennas for TV-radio or Wifi systems.
you amy ask why?
reason is simple fractal antenas have advantage over usual antennas because
can be created very small,and if you dont know most antennas in your cell phones are
fractal types
most used are sierpinski carpet- which is probably the BEST but is hard to build
by hands but with pcb design are.
second is sierpinski triangle, then minkowski which is not presented here
but looks like viscek fractal,quads are also used as antennas
most of them are patch or panel antennas...
so ashish present minkowski here ?
Reply
#13
@bplus
Hi. I like your plus variation fractal. In the code you have asked "how many plus can you find?"
......Well, I've found 1365 plus in variation B, B, B, B
@aurel
Minkowski? What's that? HuhUndecided
Reply
#14
Hi Ashish, thanks!  I was curious too of the Minkowski mention.

Oh wait! "Minkowski Fractal"

Yep! That's probably it! Definitely worth a try!
B += x
Reply
#15
Some practice with Notepad++

A Fractal Collection in a sampler program.


Attached Files .bas   Ashish Fractals Plus.bas (Size: 16.17 KB / Downloads: 6)
B += x
Reply
#16
Hi Guys! Smile
A 3D Fractal Tree -

Code:
'3D Fractal Tree
'By Ashish Kushwaha

DECLARE LIBRARY
    SUB gluLookAt (BYVAL eyeX#, BYVAL eyeY#, BYVAL eyeZ#, BYVAL centerX#, BYVAL centerY#, BYVAL centerZ#, BYVAL upX#, BYVAL upY#, BYVAL upZ#)
END DECLARE

_TITLE "3D Fractal Tree"
SCREEN _NEWIMAGE(800, 600, 32)

DIM SHARED glAllow AS _BYTE, branchAngle

glAllow = -1
DO
    WHILE _MOUSEINPUT: WEND
    branchAngle = map(_MOUSEX, 0, _WIDTH, 15, 55)
    _LIMIT 40
LOOP UNTIL INKEY$ <> ""

SUB _GL () STATIC
    IF NOT glAllow THEN EXIT SUB

    IF NOT glSetup THEN
        _glViewport 0, 0, _WIDTH, _HEIGHT
        aspect# = _WIDTH / _HEIGHT
        glSetup = -1
    END IF

    _glEnable _GL_DEPTH_TEST
    '_glEnable _GL_LIGHTING

    _glMatrixMode _GL_PROJECTION
    _gluPerspective 45.0, aspect#, 1.0, 1000.0

    _glMatrixMode _GL_MODELVIEW

    gluLookAt 0, -3, 3, 0, -.6, 0, 0, -1, 0

    _glRotatef clock# * 60, 0, 1, 0
    _glLineWidth 10.0

    _glColor3f .6, .3, 0
    _glBegin _GL_LINES
    _glVertex3f 0, 0.0, 0
    _glVertex3f 0, 1.8, 0
    _glEnd

    drawTree3D 0, 0, 0, .8, branchAngle
    clock# = clock# + 0.01
    _glFlush
END SUB

SUB drawTree3D (x, y, z, r, t)
    IF r < 0.4 THEN _glColor3f 0, .8, 0 ELSE _glColor3f .6, .3, 0

    _glLineWidth map(r, 0.8, 0.06, 10, 1)

    _glPushMatrix
    _glRotatef t, 0, 0, 1
    _glBegin _GL_LINES
    _glVertex3f x, y, z
    _glVertex3f x, y - r, z
    _glEnd
    _glPopMatrix

    _glPushMatrix
    _glRotatef -t, 0, 0, 1
    _glBegin _GL_LINES
    _glVertex3f x, y, z
    _glVertex3f x, y - r, z
    _glEnd
    _glPopMatrix

    _glPushMatrix
    _glRotatef t, 1, 0, 0
    _glBegin _GL_LINES
    _glVertex3f x, y, z
    _glVertex3f x, y - r, z
    _glEnd
    _glPopMatrix

    _glPushMatrix
    _glRotatef -t, 1, 0, 0
    _glBegin _GL_LINES
    _glVertex3f x, y, z
    _glVertex3f x, y - r, z
    _glEnd
    _glPopMatrix



    IF r > 0.06 THEN
        _glPushMatrix
        _glRotatef t, 0, 0, 1
        _glTranslatef x, y - r, z
        drawTree3D 0, 0, 0, r * 0.51, t
        _glPopMatrix

        _glPushMatrix
        _glRotatef -t, 0, 0, 1
        _glTranslatef x, y - r, z
        drawTree3D 0, 0, 0, r * 0.51, t
        _glPopMatrix

        _glPushMatrix
        _glRotatef t, 1, 0, 0
        _glTranslatef x, y - r, z
        drawTree3D 0, 0, 0, r * 0.61, t
        _glPopMatrix

        _glPushMatrix
        _glRotatef -t, 1, 0, 0
        _glTranslatef x, y - r, z
        drawTree3D 0, 0, 0, r * 0.61, t
        _glPopMatrix

    END IF

END SUB

'taken from a 2D rendering library, p5js.bas
'http://bit.ly/p5jsbas
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION


Attached Files Thumbnail(s)

Reply
#17
Oh, that is nice response to mouse moves.

Thanks Ashish
B += x
Reply
#18
(10-21-2017, 02:37 AM)bplus Wrote: Oh, that is nice response to mouse moves.

Thanks Ashish
You are thanking me....??? Undecided
I'm glad you like it!
Thank You.
Reply
#19
Beautiful work, Ashish. Thank you. I stole code from you and BPlus Smile.
Reply
#20
What would impress me is if BPlus can put a bird up in that tree. Maybe a  terrafractyl?

Pete Big Grin
Reply