Double Pendulum
#1
Rainbow 
Hi Everyone! Smile
This program traces the motion of the double pendulum to get beautiful patterns.
Press 'Space' for new settings.

Code:
'Coded By Ashish on 4 March, 2018

_TITLE "Double Pendulum [Press Space for New Settings]"

SCREEN _NEWIMAGE(800, 600, 32)

TYPE vec2
    x AS SINGLE
    y AS SINGLE
END TYPE

TYPE pendlm
    pos AS vec2
    r AS SINGLE
    ang AS DOUBLE
    angInc AS DOUBLE
    angSize AS DOUBLE
END TYPE

DIM SHARED pendulum(1) AS pendlm
RANDOMIZE TIMER
change_settings:
pendulum(0).r = p5random(250, 350)
pendulum(0).pos.x = 400
pendulum(0).pos.y = 0
pendulum(0).angInc = p5random(0, _PI(2))
pendulum(0).angSize = p5random(_PI(.1), _PI(.6))

pendulum(1).angInc = p5random(0, _PI(2))
pendulum(1).r = p5random(100, 300)
pendulum(1).angSize = p5random(_PI(.1), _PI(.9))
px = 0: py = 0: a = 0: f = 0

tracer& = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
DO
    CLS
    k& = _KEYHIT
    IF a < 255 THEN a = a + 1
    IF k& = ASC(" ") THEN _FREEIMAGE tracer&: GOTO change_settings
    tx1 = COS(pendulum(0).ang) * pendulum(0).r + pendulum(0).pos.x
    ty1 = SIN(pendulum(0).ang) * pendulum(0).r + pendulum(0).pos.y

    pendulum(0).ang = SIN(pendulum(0).angInc) * pendulum(0).angSize + _PI(.5)
    pendulum(1).pos.x = tx1: pendulum(1).pos.y = ty1

    tx2 = COS(pendulum(1).ang) * pendulum(1).r + pendulum(1).pos.x
    ty2 = SIN(pendulum(1).ang) * pendulum(1).r + pendulum(1).pos.y

    pendulum(1).ang = SIN(pendulum(1).angInc) * pendulum(0).angSize + pendulum(0).ang

    g = SIN(pendulum(0).angInc) * 128 + 128
    b = COS(pendulum(1).angInc) * 128 + 128

    _DEST tracer&
    COLOR _RGBA(0, g, b, a)
    IF f > 40 THEN
        thickLine px, py, tx2, ty2, 2
    END IF
    _DEST 0
    COLOR _RGB(255, 0, 0)

    LINE (pendulum(0).pos.x, pendulum(0).pos.y)-(tx1, ty1)
    CircleFill tx1, ty1, 30, _RGB(50, 50, 50)
    LINE (pendulum(1).pos.x, pendulum(1).pos.y)-(tx2, ty2)
    CircleFill tx2, ty2, 30, _RGB(50, 50, 50)
    _PUTIMAGE , tracer&
    _LIMIT 60

    _DISPLAY
    pendulum(0).angInc = pendulum(0).angInc + .03
    pendulum(1).angInc = pendulum(1).angInc + .05
    px = tx2: py = ty2

    f = f + 1
LOOP

'By Fellippe
SUB thickLine (x1 AS SINGLE, y1 AS SINGLE, x2 AS SINGLE, y2 AS SINGLE, lineWeight%)
    DIM a AS SINGLE, x0 AS SINGLE, y0 AS SINGLE
    DIM prevDest AS LONG, prevColor AS _UNSIGNED LONG
    STATIC colorSample AS LONG

    IF colorSample = 0 THEN
        colorSample = _NEWIMAGE(1, 1, 32)
    END IF

    prevDest = _DEST
    prevColor = _DEFAULTCOLOR
    _DEST colorSample
    PSET (0, 0), prevColor
    _DEST prevDest

    a = _ATAN2(y2 - y1, x2 - x1)
    a = a + _PI / 2
    x0 = 0.5 * lineWeight% * COS(a)
    y0 = 0.5 * lineWeight% * SIN(a)

    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), colorSample TO(x1 - x0, y1 - y0)-(x1 + x0, y1 + y0)-(x2 + x0, y2 + y0), , _SMOOTH
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), colorSample TO(x1 - x0, y1 - y0)-(x2 + x0, y2 + y0)-(x2 - x0, y2 - y0), , _SMOOTH
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 p5js.bas
'https://bit.ly/p5jsbas
FUNCTION p5random! (mn!, mx!)
    IF mn! > mx! THEN
        SWAP mn!, mx!
    END IF
    p5random! = RND * (mx! - mn!) + mn!
END FUNCTION


Attached Files Thumbnail(s)

Reply