Post by bplus on Sept 26, 2023 22:09:07 GMT -5
Inspired by ZXDunny's version! seen here: friends-of-basic.freeforums.net/thread/277/specbas-unlimited-bobs
Ball.png in zip with copy of code above
_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/thread/277/specbas-unlimited-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
Ball.png in zip with copy of code above