Smile - RotoZoom Example

[SierraKen]

I think B+ or someone else made this once before, but I thought I would give it a try. It's a smiley face that turns around and around while bouncing off the sides. He also zooms larger and smaller. It's a really good example for the RotoZoom sub, the Fillcircle sub, and for anyone that wants to learn how to make animation with Copyimage using RotoZoom. 

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

[OldMoses]

An amazing and highly useful tool.

[Dav]

Great example, SierraKen.  Easy to understand and good for others to learn from.  Rotozoom is a fun sub to play with.

- Dav

[SierraKen]

Thanks guys! I always have fun using it.

[bplus]

Nice Ken I was inspired to fix my smiling face with bee flying around (see Bplus corner - Proggies)

[SierraKen]

Thanks B+. The more I learn things the more I am inspired to make more. Although many times my energy goes elsewhere. lol