Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
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
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
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

Possibly Related Threads…
Thread Author Replies Views Last Post
  I must be missing something obvious with this code Dav 8 1,486 09-16-2024, 07:47 PM
Last Post: Pete
  Color picker bug or just something I'm missing OldMoses 8 1,734 08-10-2023, 01:28 AM
Last Post: OldMoses
  Any math experts know what I'm missing here? [Solved] Pete 24 4,209 09-26-2022, 07:00 PM
Last Post: Kernelpanic
  VB5 - Decimal places are missing Kernelpanic 5 1,176 06-30-2022, 01:37 PM
Last Post: bplus

Forum Jump:


Users browsing this thread: 1 Guest(s)