Get , Put

[bplus]

OK next step towards "My First QB64 Program"

Test the new improved RotoZoom23r fixed up by James D Jarvis
'check her out

Code: (Select All)

Option _Explicit
Const Xpix = 1300 ' you guys with the giant screen give me a break
Const Ypix = 700
Type box
    As Single x, y, xsc, ysc, dxsc, dysc, a, da
    As Long img
End Type

Screen _NewImage(Xpix, Ypix, 32)
_ScreenMove 0, 0 ' my task bar in on right
_FullScreen

Dim As Long Pismeno(1 To 7), Pismo, t, PW
Dim d ' as single
Pismo& = _LoadFont("Arial.ttf", 75, "monospace") ' don't have that other font 300 = 300 pixel high font
_Font Pismo&
PW = _PrintWidth("1 Hello World") + 20
For t = 1 To 7
    Cls ' one image first baby steps
    Pismeno(t) = _NewImage(PW, 100, 32)
    _PrintString (10, 16), _Trim$(Str$(t)) + " Hello World"
    Line (10, 10)-(PW - 10, 90), , B
    _PutImage , 0, Pismeno(t), (0, 0)-(PW, 100)
    'Sleep 'check her out
    _Delay .1
Next t
Cls
t = 1: d = 1
Do
    Cls , _RGB32(0, 100, 50)
    _PutImage ((_Width - PW) / 2, (t - 1) * 100 + 5), Pismeno(t), 0
    t = t + 1
    If t = 8 Then t = 1
    _Display
    _Delay d
    d = d - .05
Loop Until d <= .02 Or _KeyDown(27)

Dim bx(1 To 7) As box
Dim As Long i
For i = 1 To 7
    bx(i).x = Rnd * (_Width - 100) + 50: bx(i).y = Rnd * (_Height - 100) + 50
    bx(i).a = _Pi(2) * Rnd ' start twirl
    bx(i).da = Rnd * _Pi(1 / 36) - _Pi(1 / 72) ' speed of twirl
    bx(i).xsc = Rnd * 2.75 + .25
    bx(i).ysc = Rnd * 2.75 + .25
    If Rnd < .5 Then bx(i).dxsc = -.05 Else bx(i).dxsc = .05
    If Rnd < .5 Then bx(i).dysc = -.05 Else bx(i).dysc = .05
Next
While _KeyDown(27) = 0
    Cls , _RGB32(100, 100, 200)
    For i = 1 To 7
        RotoZoom23r bx(i).x, bx(i).y, Pismeno(i), bx(i).xsc, bx(i).ysc, bx(i).a
        ' update
        bx(i).xsc = bx(i).xsc + bx(i).dxsc
        If bx(i).xsc > 2 Then bx(i).xsc = 2: bx(i).dxsc = -bx(i).dxsc
        If bx(i).xsc < -2 Then bx(i).xsc = -2: bx(i).dxsc = -bx(i).dxsc
        bx(i).ysc = bx(i).ysc + bx(i).dysc
        If bx(i).ysc > 2 Then bx(i).ysc = 2: bx(i).dysc = -bx(i).dysc
        If bx(i).ysc < -2 Then bx(i).ysc = -2: bx(i).dysc = -bx(i).dysc
        bx(i).a = bx(i).a + bx(i).da
    Next
    _Display
    _Limit 20
Wend

Cls
_PrintString ((_Width - _PrintWidth("Goodbye")) / 2, (_Height - 75) / 2), "Goodbye"
_Display '<<<<<<<<<<<<<<<<<<<<<<< very important once you start using _display you need to after every print thing!!!
Sleep

' 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

EDIT: a couple more improvements