Proggies

[bplus]

Lissajous Ball

Inspired by ZXDunny's here: https://friends-of-basic.freeforums.net/...mited-bobs

Code: (Select All)

_Title "Lissajous Ball" ' b+ 2023-09-26

' Electric Lissajous.bas for SmallBASIC 0.12.8 [B+=MGA] 2017-02-22

' port to QB64 trans 2017-10-31 by bplus"



' 2023-09-26 This, Inspired once again by ZXDunny

' ref https://friends-of-basic.freeforums.net/...mited-bobs



Const xmax = 1024

Const ymax = 700

Screen _NewImage(xmax, ymax, 32)

_ScreenMove 120, 20

ball& = _LoadImage("ball.png")

Color , &HFF000099

Cls

sc = ymax / 3

xc = xmax / 2

yc = ymax / 2

Dim bx(400), by(400)

While 1

    m = 3: n = 2: p = 4: q = 11

    For s = 0 To sc * .75 Step .05 * sc

        Cls

        Erase bx

        Erase by

        bx(1) = xc: by(1) = sc + yc: cnt = 0: rot = 0

        For t = 0 To _Pi(4) * (1 + _Pi(1 / 360)) Step _Pi(1 / 90)

            cnt = cnt + 1

            Cls

            Locate 1, 1: Print cnt

            rotsave = rot

            For i = 1 To cnt

                RotoZoom23r bx(i), by(i), ball&, .2, .2, rot

                rot = rot + _Pi(1 / 30)

            Next

            _Display

            _Limit 30

            rot = rotsave + _Pi(1 / 30)

            bx(cnt + 1) = 1.1 * (sc - s) * Sin(m * t) + 1.1 * 2 * s * Sin(p * t) + xc

            by(cnt + 1) = (sc - s) * Cos(n * t) + s * Cos(q * t) + yc

        Next

        _Display

        _Limit 10

    Next

    _Delay .8

Wend



' best  rev 2023-01-20 Jarvis with Steve change for eff  might need _Seamless next to _MapTriangle calls

Sub RotoZoom23r (centerX As Long, centerY As Long, Image As Long, xScale As Single, yScale As Single, radRotation As Single)

    'uses radians

    Dim As Long W, H, Wp, Hp, i, x2, y2

    Dim sinr!, cosr!

    Dim px(3) As Single: Dim py(3) As Single

    W& = _Width(Image&): H& = _Height(Image&)

    Wp& = W& / 2 * xScale

    Hp& = H& / 2 * yScale

    px(0) = -Wp&: py(0) = -Hp&: px(1) = -Wp&: py(1) = Hp&

    px(2) = Wp&: py(2) = Hp&: px(3) = Wp&: py(3) = -Hp&

    sinr! = Sin(-radRotation): cosr! = Cos(radRotation)

    For i& = 0 To 3

        ' x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY

        x2& = (px(i&) * cosr! + sinr! * py(i&)) + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) + centerY

        px(i&) = x2&: py(i&) = y2&

    Next ' _Seamless? below

    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))

    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))

End Sub

   

Image and code again in zip