What am I missing here?
#6
Here I write up the Alternate RotateAndZoomImage sub with more comments and test it out with demo:

Feature Sub:
Code: (Select All)
Sub RotateAndZoomImage (aboutX, aboutY, Img&, xyScale, radianRot, dest&)
    Dim px(1 To 4), py(1 To 4), rotx(1 To 4), roty(1 To 4)

    ' aboutX, aboutY is the centerPoint for the destination image
    ' Img& is image handle from drawn _newImage or _LoadImage
    ' xyScale is multiplier to shrink or grow image projection from Map Triangle
    ' RadianRot is the angle in radians to turn the image from 0 rotation clockwise when positive
    ' dest& is where you want the projected image drawn 0 is the screen

    ' This part sets up our Destination points for _MapTriangle, 4 points around a Center X, Y point
    w = _Width(Img&) / 2 ' these are 1/2 widths and heights for faster calc of destination coordinates
    h = _Height(Img&) / 2
    ' the 4 points are the central point +- half the width and or height
    px(1) = aboutX - w: py(1) = aboutY - h
    px(2) = aboutX - w: py(2) = aboutY + h
    px(3) = aboutX + w: py(3) = aboutY + h
    px(4) = aboutX + w: py(4) = aboutY - h

    ' the "radius" of 4 points from the center will be same for square or rectangle image
    radius = _Hypot(py(1) - aboutY, px(1) - aboutX) ' radius is all the same

    '  the 4 projection points needs to be rotated
    For i = 1 To 4
        angle = _Atan2(py(i) - aboutY, px(i) - aboutX) ' the angle the point is before rotation
        rotA = angle + radianRot ' add the rotation to angle
        'rotated x, y point
        rotx(i) = aboutX + xyScale * radius * Cos(rotA)
        roty(i) = aboutY + xyScale * radius * Sin(rotA)
    Next

    ' this w, h concerns the Triangle coordinates for the Source _MapTriangle points
    w = _Width(Img&) - 1 'for source coordinates
    h = _Height(Img&) - 1
    _MapTriangle (0, 0)-(0, h)-(w, h), Img& To(rotx(1), roty(1))-(rotx(2), roty(2))-(rotx(3), roty(3)), dest&
    _MapTriangle (0, 0)-(w, 0)-(w, h), Img& To(rotx(1), roty(1))-(rotx(4), roty(4))-(rotx(3), roty(3)), dest&
End Sub



Code: (Select All)
_Title "Test Alternate RotoZoom Derived From Point Rotation" ' b+ 2022-09-09
Screen _NewImage(600, 350, 32)

' from demo code for Lander

' ===========================================   make background snapshot
Color , _RGB32(30, 30, 60)
snapBack& = _NewImage(_Width, _Height, 32)
Cls
DrawTerrain 100, 25, &HFF332211
DrawTerrain 150, 20, &HFF443322
DrawTerrain 200, 15, &HFF554433
DrawTerrain 250, 10, &HFF665544
DrawTerrain 300, 5, &HFF776655
_PutImage , 0, snapBack&

' ========================================== make a spaceship sprite
ship& = _NewImage(61, 31, 32) ' ship is 60 x 30 drawn in top left hand corner
' need black backgrounf for ship
Color , &HFF000000 '= black background
Cls
drawShip 30, 15, &HFF00FF88
_PutImage , 0, ship&, (0, 0)-(61, 31) ' <<<< upper left corner of screen!!!
_ClearColor &HFF000000, ship& ' <<<  make the background black of ship transparent

' ============================================= now for test of Alternate RotoZoom
sx = 0 ' from left edge to right and back
dx = 5 ' 270 / 5 = 54 loops to go from start to mid screen with max tilt there at pi(.25)
tilt = 0
dt = _Pi(.25 / 54)
scale = 1
ds = 1 / 54 ' want to double scale at 54 loops
Do
    _PutImage , snapBack&, 0 ' back to screen
    'rotozoom workes from image center, add 30 for middle of ship  15 add to y keeps ship lower
    RotateAndZoomImage sx + 30, 175 + 15, ship&, scale, tilt, 0 ' ship to screen at destination x, y

    ' update x, scale and tilt
    sx = sx + dx
    If sx > _Width - 60 Then
        sx = _Width - 60: dx = -dx
        scale = 1: tilt = 0
    ElseIf sx < 0 Then
        sx = 0: dx = -dx
        scale = 1: tilt = 0
    ElseIf Abs(sx - 270) < .01 And dx > 0 Then
        dt = -dt: ds = -ds
    ElseIf Abs(sx - 270) < .01 And dx < 0 Then
        dt = -dt: ds = -ds
    End If
    scale = scale + ds
    tilt = tilt + dt
    Locate 1, 1
    Print "Press escape to quit..."
    _Display 'no flicker
    _Limit 20 ' max 20 loops a second
Loop Until _KeyDown(27)


Sub drawShip (x, y, colr As _Unsigned Long) 'shipType     collisions same as circle x, y radius = 30
    Static ls
    Dim light As Long, r As Long, g As Long, b As Long
    r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)
    fellipse x, y, 6, 15, _RGB32(r, g - 120, b - 100)
    fellipse x, y, 18, 11, _RGB32(r, g - 60, b - 50)
    fellipse x, y, 30, 7, _RGB32(r, g, b)
    For light = 0 To 5
        fcirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)
    Next
    ls = ls + 1
    If ls > 5 Then ls = 0
End Sub

' ======== helper subs for drawShip that you can use for other things specially fcirc = fill_circle  x, y, radius, color

Sub fellipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
    If xr = 0 Or yr = 0 Then Exit Sub
    Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
    Dim x As Long, y As Long
    w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
    Line (CX - xr, CY)-(CX + xr, CY), C, BF
    Do While y < yr
        y = y + 1
        x = Sqr((h2w2 - y * y * w2) \ h2)
        Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
        Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
    Loop
End Sub

Sub fcirc (x As Long, y As Long, R As Long, C As _Unsigned Long) 'vince version  fill circle x, y, radius, color
    Dim x0 As Long, y0 As Long, e As Long
    x0 = R: y0 = 0: e = 0
    Do While y0 < x0
        If e <= 0 Then
            y0 = y0 + 1
            Line (x - x0, y + y0)-(x + x0, y + y0), C, BF
            Line (x - x0, y - y0)-(x + x0, y - y0), C, BF
            e = e + 2 * y0
        Else
            Line (x - y0, y - x0)-(x + y0, y - x0), C, BF
            Line (x - y0, y + x0)-(x + y0, y + x0), C, BF
            x0 = x0 - 1: e = e - 2 * x0
        End If
    Loop
    Line (x - R, y)-(x + R, y), C, BF
End Sub

Sub DrawTerrain (h, modN, c As _Unsigned Long) ' modN for ruggedness the higher the less smooth
    For x = 0 To _Width
        If x Mod modN = 0 Then ' adjust mod number for ruggedness the higher the number the more jagged
            If h < 350 - modN And h > 50 + modN Then
                dy = Rnd * 20 - 10
            ElseIf h >= 350 - modN Then
                dy = Rnd * -10
            ElseIf h <= 50 + modN Then
                dy = Rnd * 10
            End If
        End If
        h = h + .1 * dy
        Line (x, _Height)-(x, h), c
    Next
End Sub

Sub RotateAndZoomImage (aboutX, aboutY, Img&, xyScale, radianRot, dest&)
    Dim px(1 To 4), py(1 To 4), rotx(1 To 4), roty(1 To 4)

    ' aboutX, aboutY is the centerPoint for the destination image
    ' Img& is image handle from drawn _newImage or _LoadImage
    ' xyScale is multiplier to shrink or grow image projection from Map Triangle
    ' RadianRot is the angle in radians to turn the image from 0 rotation clockwise when positive
    ' dest& is where you want the projected image drawn 0 is the screen

    ' This part sets up our Destination points for _MapTriangle, 4 points around a Center X, Y point
    w = _Width(Img&) / 2 ' these are 1/2 widths and heights for faster calc of destination coordinates
    h = _Height(Img&) / 2
    ' the 4 points are the central point +- half the width and or height
    px(1) = aboutX - w: py(1) = aboutY - h
    px(2) = aboutX - w: py(2) = aboutY + h
    px(3) = aboutX + w: py(3) = aboutY + h
    px(4) = aboutX + w: py(4) = aboutY - h

    ' the "radius" of 4 points from the center will be same for square or rectangle image
    radius = _Hypot(py(1) - aboutY, px(1) - aboutX) ' radius is all the same

    '  the 4 projection points needs to be rotated
    For i = 1 To 4
        angle = _Atan2(py(i) - aboutY, px(i) - aboutX) ' the angle the point is before rotation
        rotA = angle + radianRot ' add the rotation to angle
        'rotated x, y point
        rotx(i) = aboutX + xyScale * radius * Cos(rotA)
        roty(i) = aboutY + xyScale * radius * Sin(rotA)
    Next

    ' this w, h concerns the Triangle coordinates for the Source _MapTriangle Points
    w = _Width(Img&) - 1 'for source coordinates
    h = _Height(Img&) - 1
    _MapTriangle (0, 0)-(0, h)-(w, h), Img& To(rotx(1), roty(1))-(rotx(2), roty(2))-(rotx(3), roty(3)), dest&
    _MapTriangle (0, 0)-(w, 0)-(w, h), Img& To(rotx(1), roty(1))-(rotx(4), roty(4))-(rotx(3), roty(3)), dest&
End Sub

So important to understand Rotozoom, so really cool to be able to derive it on your own with a little guidance from Galleon's example.

EDIT to fix spelling
b = b + ...
Reply


Messages In This Thread
What am I missing here? - by TerryRitchie - 09-08-2022, 05:08 AM
RE: What am I missing here? - by luke - 09-08-2022, 01:40 PM
RE: What am I missing here? - by TerryRitchie - 09-08-2022, 02:30 PM
RE: What am I missing here? - by bplus - 09-08-2022, 06:44 PM
RE: What am I missing here? - by bplus - 09-08-2022, 11:17 PM
RE: What am I missing here? - by bplus - 09-09-2022, 06:54 PM



Users browsing this thread: 4 Guest(s)