Smile - RotoZoom Example - Printable Version

Code: (Select All)
'Smile - RotoZoom Example by SierraKen

'May 19, 2022



Dim image As Long

Screen _NewImage(200, 200, 32)

'Head

cx = 100: cy = 100: r = 95

c = _RGB32(255, 255, 0)

fillCircle cx, cy, r, c

'Right Eye

cx = 50: cy = 75: r = 15

c = _RGB32(0, 0, 0)

fillCircle cx, cy, r, c

'Left Eye

cx = 150: cy = 75: r = 15

c = _RGB32(0, 0, 0)

fillCircle cx, cy, r, c

'Mouth

Circle (100, 125), 70, _RGB32(0, 0, 0), _Pi, 2 * _Pi, .5

Line (30, 125)-(170, 125), _RGB32(0, 0, 0)

Paint (100, 140), _RGB32(0, 0, 0)



dirx = 1

diry = 1

x = 400

y = 400

scale = 1

_Title "Smile - RotoZoom Example by SierraKen"



image& = _CopyImage(0)

Cls

Screen _NewImage(800, 800, 32)

Do

    _Limit 30

    rotation = rotation + 1

    If rotation > 359 Then rotation = 0

    x = x + dirx

    y = y + diry

    If x > 700 Then dirx = -1 * Rnd * 3

    If x < 100 Then dirx = 1 * Rnd * 3

    If y > 700 Then diry = -1 * Rnd * 3

    If y < 100 Then diry = 1 * Rnd * 3



    If shrink = 0 Then scale = scale + .01

    If scale > 5 Then shrink = 1

    If shrink = 1 Then scale = scale - .01

    If scale < .5 Then shrink = 0



    RotoZoom x, y, image&, scale, rotation



    _Display

    Line (0, 0)-(800, 800), _RGB32(0, 0, 0, 10), BF



Loop Until InKey$ = Chr$(27)





'from Steve Gold standard

Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)

    Dim Radius As Integer, RadiusError As Integer

    Dim X As Integer, Y As Integer

    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0

    If Radius = 0 Then PSet (CX, CY), C: Exit Sub

    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



Sub RotoZoom (X As Long, Y As Long, image&, Scale As Single, Rotation As Single)

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

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

    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2

    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2

    sinr! = Sin(-Rotation / 57.2957795131): cosr! = Cos(-Rotation / 57.2957795131)

    For i& = 0 To 3

        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y

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

    Next

    _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