QB64 Phoenix Edition
Angle Collisions - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Help Me! (https://qb64phoenix.com/forum/forumdisplay.php?fid=10)
+---- Thread: Angle Collisions (/showthread.php?tid=972)

Pages: 1 2 3 4 5 6 7 8 9 10

RE: Angle Collisions - bplus - 10-17-2022

Aha! I got it, no vectors needed!

I had to create a new Function for detecting a line segment inside a circle. This is that:
Code: (Select All)
' return 0 if no overlap
Function lineSegIntersectCircle% (x1, y1, x2, y2, cx, cy, r)
    ' x1, y1 and x2, y2  are end points of line segment
    ' cx, cy are circle center with radius r
    Dim d, dx, dy, i, x, y
    d = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
    dx = (x2 - x1) / d
    dy = (y2 - y1) / d
    For i = 0 To d
        x = x1 + dx * i
        y = y1 + dy * i
        If Sqr((x - cx) ^ 2 + (y - cy) ^ 2) <= r Then lineSegIntersectCircle% = -1: Exit Function
    Next
End Function

OK best to just think of a circle as a distance from a given point and basically redraw the line point by point and see that each point is in range of circle radius.

Here is James Container #2 with his code for creating the container for the circle to bounce inside (changed border color):
Code: (Select All)
Option _Explicit
_Title "James Random Container 2" ' b+ 2022-10-16
Screen _NewImage(800, 680, 32)
_ScreenMove 250, 50
Randomize Timer
_PrintMode _KeepBackground
Type lineSegment
    As Single x1, y1, x2, y2, dN ' 2 end points
End Type

' mod RegularPoly to save lines created by
Dim cx, cy, x1, y1, flag, x2, y2 ' building container
Dim As _Unsigned Long c1
Dim As Long NLines, L, Container
ReDim Boundaries(1 To 100) As lineSegment
cx = _Width / 2: cy = _Height / 2 + 40
c1 = _RGB32(0, 150, 85) ' minty green background out of bounds
Cls
x1 = 50
y1 = 50
flag = 0
While flag = 0
    x2 = (Rnd * 80) + 80 + x1
    If x2 > 750 Then
        x2 = 750
        flag = 1
    End If
    y2 = Rnd * 60 + 20
    Line (x1, y1)-(x2, y2), c1
    NLines = NLines + 1
    Boundaries(NLines).x1 = x1: Boundaries(NLines).y1 = y1
    Boundaries(NLines).x2 = x2: Boundaries(NLines).y2 = y2
    Boundaries(NLines).dN = DAtan2(x1, y1, x2, y2) + 90 ' the angle x2, y2 is to x1, y1 + 90 points inward
    x1 = x2
    y1 = y2
Wend

flag = 0
While flag = 0
    y2 = (Rnd * 80) + 80 + y1
    If y2 > 550 Then
        y2 = 550
        flag = 1
    End If
    x2 = 750 - (Rnd * 60 + 20)
    Line (x1, y1)-(x2, y2), c1
    NLines = NLines + 1
    Boundaries(NLines).x1 = x1: Boundaries(NLines).y1 = y1
    Boundaries(NLines).x2 = x2: Boundaries(NLines).y2 = y2
    Boundaries(NLines).dN = DAtan2(x1, y1, x2, y2) + 90 ' the angle x2, y2 is to x1, y1 + 90 points inward
    x1 = x2
    y1 = y2
Wend

flag = 0
While flag = 0
    x2 = x1 - ((Rnd * 80) + 80)
    If x2 < 50 Then
        x2 = 50
        flag = 1
    End If
    y2 = 550 - (Rnd * 60 + 20)
    Line (x1, y1)-(x2, y2), c1
    NLines = NLines + 1
    Boundaries(NLines).x1 = x1: Boundaries(NLines).y1 = y1
    Boundaries(NLines).x2 = x2: Boundaries(NLines).y2 = y2
    Boundaries(NLines).dN = DAtan2(x1, y1, x2, y2) + 90 ' the angle x2, y2 is to x1, y1 + 90 points inward
    x1 = x2
    y1 = y2
Wend

flag = 0
While flag = 0
    y2 = y1 - ((Rnd * 80) + 80)
    If y2 < 50 Then
        y2 = 50
        flag = 1
    End If
    x2 = Rnd * 60 + 20
    If flag = 1 Then x2 = 50
    Line (x1, y1)-(x2, y2), c1
    NLines = NLines + 1
    Boundaries(NLines).x1 = x1: Boundaries(NLines).y1 = y1
    Boundaries(NLines).x2 = x2: Boundaries(NLines).y2 = y2
    Boundaries(NLines).dN = DAtan2(x1, y1, x2, y2) + 90 ' the angle x2, y2 is to x1, y1 + 90 points inward
    x1 = x2
    y1 = y2
Wend
Paint (1, 1), c1, c1
Locate 37, 1
Print "  Yellow = the angle of ball heading towards line."
Print "  Blue = angle perpendicular (normal) to boundary line."
Print "  White = angle of refelection off line."
Container = _NewImage(_Width, _Height, 32)
_PutImage , 0, Container

Dim bx, by, ba, br, bspeed, diff
bx = cx: by = cy: bspeed = 5
br = 15 ' make ball radius (br) at least 2* speed
ba = Rnd * 360 ' setup up ball in middle of screen/container random heading = ba (ball angle)

' ok just bounce ball around the polygon container
Do
    _PutImage , Container, 0
    Circle (bx, by), br ' draw ball then calc next loaction
    bx = bx + bspeed * CosD(ba) ' test x, y is new ball position if dont run into wall
    by = by + bspeed * SinD(ba)
    For L = 1 To NLines ' did we hit any?
        ' probably should back it up before processing bounce
        If lineSegIntersectCircle%(Boundaries(L).x1, Boundaries(L).y1, Boundaries(L).x2, Boundaries(L).y2, bx, by, br) Then ' rebound ball
            Sound 1000, .5
            While lineSegIntersectCircle%(Boundaries(L).x1, Boundaries(L).y1, Boundaries(L).x2, Boundaries(L).y2, bx, by, br) ' back up circle
                bx = bx + CosD(ba - 180)
                by = by + SinD(ba - 180)
            Wend
            _PutImage , Container, 0 ' show circle hit on boundary
            Circle (bx, by), br

            ' Yellow arrow for incoming towards boundary (I reversed the head of arrow to compare to reflection angle)
            ArrowTo bx + 3 * br * CosD(ba + 180), by + 3 * br * SinD(ba + 180), ba, 3 * br, &HFFFFFF00

            ' Blue Vector Perpendicular to plane
            ArrowTo bx, by, Boundaries(L).dN, 5 * br, &HFF0000FF

            ' Reflected ball off line
            diff = Boundaries(L).dN - ba + 180
            ba = Boundaries(L).dN + diff ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> new direction
            ArrowTo bx, by, ba, 3 * br, &HFFFFFFFF

            _Display
            _Delay 2
        End If
    Next
    _Display
    _Limit 120
Loop Until _KeyDown(27)

' return 0 if no overlap
Function lineSegIntersectCircle% (x1, y1, x2, y2, cx, cy, r)
    ' x1, y1 and x2, y2  are end points of line segment
    ' cx, cy are circle center with radius r
    Dim d, dx, dy, i, x, y
    d = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
    dx = (x2 - x1) / d
    dy = (y2 - y1) / d
    For i = 0 To d
        x = x1 + dx * i
        y = y1 + dy * i
        If Sqr((x - cx) ^ 2 + (y - cy) ^ 2) <= r Then lineSegIntersectCircle% = -1: Exit Function
    Next
End Function

' use angles in degrees units instead of radians (converted inside sub)
Function CosD (degrees)
    ' Note this function uses whatever the default type is, better not be some Integer Type.
    CosD = Cos(_D2R(degrees))
End Function

' use angles in degrees units instead of radians (converted inside sub)
Function SinD (degrees)
    ' Note this function uses whatever the default type is, better not be some Integer Type.
    SinD = Sin(_D2R(degrees))
End Function

' use angles in degrees units instead of radians (converted inside sub)
Function DAtan2 (x1, y1, x2, y2) ' The angle in degrees a 2nd point (x2, y2)  makes to a first point (x1, y1)
    ' Note this function uses whatever the default type is, better not be some Integer Type.
    ' Delta means change between 1 measure and another for example x2 - x1
    Dim deltaX, deltaY, rtn
    deltaX = x2 - x1
    deltaY = y2 - y1
    '  To find the angle point(x2, y2) makes to (x1, y1) in Degrees
    ' Take DegreeAngle = DAtan2(y2 - y1, x2 - x1)
    rtn = _R2D(_Atan2(deltaY, deltaX))
    If rtn < 0 Then DAtan2 = rtn + 360 Else DAtan2 = rtn
End Function

' use angles in degrees units instead of radians (converted inside sub)
Sub ArrowTo (BaseX As Long, BaseY As Long, dAngle As Double, lngth As Long, colr As _Unsigned Long)
    Dim As Long x1, y1, x2, y2, x3, y3
    Dim As Double rAngle
    rAngle = _D2R(dAngle)
    x1 = BaseX + lngth * Cos(rAngle)
    y1 = BaseY + lngth * Sin(rAngle)
    x2 = BaseX + .8 * lngth * Cos(rAngle - _Pi(.05))
    y2 = BaseY + .8 * lngth * Sin(rAngle - _Pi(.05))
    x3 = BaseX + .8 * lngth * Cos(rAngle + _Pi(.05))
    y3 = BaseY + .8 * lngth * Sin(rAngle + _Pi(.05))
    Line (BaseX, BaseY)-(x1, y1), colr
    Line (x1, y1)-(x2, y2), colr
    Line (x1, y1)-(x3, y3), colr
End Sub

   
The circle will occasionally jump out of the boundary and fly off. I think it is picking the wrong line to bounce off of as a couple line segments could be in range of the circle when checked. I also had to keep speed (in pixels) well below the pixel radius or the circle will be "returned" to the wrong side of the line on the outside of boundary line.

I might be able to reduce the occasional fly off, just got an idea....
 

Update: When it flies off it is not following the direction of the white arrow for some reason, not because it is picking the wrong line segment .

RE: Angle Collisions - bplus - 10-17-2022

Aha! again, I modified the Function to count how many points of a line segment are in a circle. Then I use the line segment with the highest point count. That seems to keep the circle inside the boundaries but I've seen it get stuck in a little indentation where the angle reflection from both walls are don't change enough to work it's way out.

Updated function that counts the number of points a segment has inside a circle:
Code: (Select All)
Function lineSegIntersectCircle (x1, y1, x2, y2, cx, cy, r)
    ' x1, y1 and x2, y2  are end points of line segment
    ' cx, cy are circle center with radius r
    Dim rtn, d, dx, dy, i, x, y
    d = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
    dx = (x2 - x1) / d
    dy = (y2 - y1) / d
    For i = 0 To d
        x = x1 + dx * i
        y = y1 + dy * i
        If Sqr((x - cx) ^ 2 + (y - cy) ^ 2) <= r Then rtn = rtn + 1
    Next
    lineSegIntersectCircle = rtn
End Function

So now the circle bouncing code looks like this:
Code: (Select All)
Option _Explicit
_Title "James Random Container 3" ' b+ 2022-10-17
' Modify the lineSegIntersectCircle function to count number of points intersecting
' if more than one line segment do the one with the most points   Yes! works better.
' Still can get a point stuck but it doesn't fly out of bounds.

Screen _NewImage(800, 680, 32)
_ScreenMove 250, 50
Randomize Timer
_PrintMode _KeepBackground
Type lineSegment
    As Single x1, y1, x2, y2, dN ' 2 end points and an angle pointing towards center (I think)
End Type

' mod RegularPoly to save lines created by
Dim cx, cy, x1, y1, flag, x2, y2 ' building container
Dim As _Unsigned Long c1
Dim As Long NLines, L, Container
ReDim Boundaries(1 To 100) As lineSegment
cx = _Width / 2: cy = _Height / 2 + 40
c1 = _RGB32(0, 150, 85) ' minty green background out of bounds
Cls
x1 = 50
y1 = 50
flag = 0
While flag = 0
    x2 = (Rnd * 80) + 80 + x1
    If x2 > 750 Then
        x2 = 750
        flag = 1
    End If
    y2 = Rnd * 60 + 20
    Line (x1, y1)-(x2, y2), c1
    NLines = NLines + 1
    Boundaries(NLines).x1 = x1: Boundaries(NLines).y1 = y1
    Boundaries(NLines).x2 = x2: Boundaries(NLines).y2 = y2
    Boundaries(NLines).dN = DAtan2(x1, y1, x2, y2) + 90 ' the angle x2, y2 is to x1, y1 + 90 points inward
    x1 = x2
    y1 = y2
Wend

flag = 0
While flag = 0
    y2 = (Rnd * 80) + 80 + y1
    If y2 > 550 Then
        y2 = 550
        flag = 1
    End If
    x2 = 750 - (Rnd * 60 + 20)
    Line (x1, y1)-(x2, y2), c1
    NLines = NLines + 1
    Boundaries(NLines).x1 = x1: Boundaries(NLines).y1 = y1
    Boundaries(NLines).x2 = x2: Boundaries(NLines).y2 = y2
    Boundaries(NLines).dN = DAtan2(x1, y1, x2, y2) + 90 ' the angle x2, y2 is to x1, y1 + 90 points inward
    x1 = x2
    y1 = y2
Wend

flag = 0
While flag = 0
    x2 = x1 - ((Rnd * 80) + 80)
    If x2 < 50 Then
        x2 = 50
        flag = 1
    End If
    y2 = 550 - (Rnd * 60 + 20)
    Line (x1, y1)-(x2, y2), c1
    NLines = NLines + 1
    Boundaries(NLines).x1 = x1: Boundaries(NLines).y1 = y1
    Boundaries(NLines).x2 = x2: Boundaries(NLines).y2 = y2
    Boundaries(NLines).dN = DAtan2(x1, y1, x2, y2) + 90 ' the angle x2, y2 is to x1, y1 + 90 points inward
    x1 = x2
    y1 = y2
Wend

flag = 0
While flag = 0
    y2 = y1 - ((Rnd * 80) + 80)
    If y2 < 50 Then
        y2 = 50
        flag = 1
    End If
    x2 = Rnd * 60 + 20
    If flag = 1 Then x2 = 50
    Line (x1, y1)-(x2, y2), c1
    NLines = NLines + 1
    Boundaries(NLines).x1 = x1: Boundaries(NLines).y1 = y1
    Boundaries(NLines).x2 = x2: Boundaries(NLines).y2 = y2
    Boundaries(NLines).dN = DAtan2(x1, y1, x2, y2) + 90 ' the angle x2, y2 is to x1, y1 + 90 points inward
    x1 = x2
    y1 = y2
Wend
Paint (1, 1), c1, c1
Locate 37, 1
Print "  Yellow = the angle of ball heading towards line."
Print "  Blue = angle perpendicular (normal) to boundary line."
Print "  White = angle of refelection off line."
Container = _NewImage(_Width, _Height, 32)
_PutImage , 0, Container

Dim bx, by, ba, br, bspeed, diff, test, saveL, hits ' now for bouncing circles around
bx = cx: by = cy: bspeed = 5
br = 15 ' make ball radius (br) at least 2* speed
ba = Rnd * 360 ' setup up ball in middle of screen/container random heading = ba (ball angle)

' ok just bounce ball around the polygon container
Do
    _PutImage , Container, 0
    Circle (bx, by), br ' draw ball then calc next loaction
    bx = bx + bspeed * CosD(ba) ' test x, y is new ball position if dont run into wall
    by = by + bspeed * SinD(ba)
    hits = 0: saveL = 0
    For L = 1 To NLines ' get line segment with highest hit count if any
        test = lineSegIntersectCircle(Boundaries(L).x1, Boundaries(L).y1, Boundaries(L).x2, Boundaries(L).y2, bx, by, br)
        If test > hits Then saveL = L: hits = test
    Next
    ' probably should back it up before processing bounce
    If hits Then ' backup circle
        Sound 1000, .5
        While lineSegIntersectCircle(Boundaries(saveL).x1, Boundaries(saveL).y1, Boundaries(saveL).x2, Boundaries(saveL).y2, bx, by, br) ' back up circle
            bx = bx + CosD(ba - 180)
            by = by + SinD(ba - 180)
        Wend
        _PutImage , Container, 0 ' show circle hit on boundary
        Circle (bx, by), br

        ' Yellow arrow for incoming towards boundary (I reversed the head of arrow to compare to reflection angle)
        ArrowTo bx + 3 * br * CosD(ba + 180), by + 3 * br * SinD(ba + 180), ba, 3 * br, &HFFFFFF00

        ' Blue Vector Perpendicular to plane
        ArrowTo bx, by, Boundaries(saveL).dN, 5 * br, &HFF0000FF

        ' Reflected ball off line
        diff = Boundaries(saveL).dN - ba + 180
        ba = Boundaries(saveL).dN + diff ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> new direction
        ArrowTo bx, by, ba, 3 * br, &HFFFFFFFF

        _Display
        _Delay .5
    End If

    _Display
    _Limit 300
Loop Until _KeyDown(27)

' return count of how many points overlap segment
Function lineSegIntersectCircle (x1, y1, x2, y2, cx, cy, r)
    ' x1, y1 and x2, y2  are end points of line segment
    ' cx, cy are circle center with radius r
    Dim rtn, d, dx, dy, i, x, y
    d = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
    dx = (x2 - x1) / d
    dy = (y2 - y1) / d
    For i = 0 To d
        x = x1 + dx * i
        y = y1 + dy * i
        If Sqr((x - cx) ^ 2 + (y - cy) ^ 2) <= r Then rtn = rtn + 1
    Next
    lineSegIntersectCircle = rtn
End Function

' use angles in degrees units instead of radians (converted inside sub)
Function CosD (degrees)
    ' Note this function uses whatever the default type is, better not be some Integer Type.
    CosD = Cos(_D2R(degrees))
End Function

' use angles in degrees units instead of radians (converted inside sub)
Function SinD (degrees)
    ' Note this function uses whatever the default type is, better not be some Integer Type.
    SinD = Sin(_D2R(degrees))
End Function

' use angles in degrees units instead of radians (converted inside sub)
Function DAtan2 (x1, y1, x2, y2) ' The angle in degrees a 2nd point (x2, y2)  makes to a first point (x1, y1)
    ' Note this function uses whatever the default type is, better not be some Integer Type.
    ' Delta means change between 1 measure and another for example x2 - x1
    Dim deltaX, deltaY, rtn
    deltaX = x2 - x1
    deltaY = y2 - y1
    '  To find the angle point(x2, y2) makes to (x1, y1) in Degrees
    ' Take DegreeAngle = DAtan2(y2 - y1, x2 - x1)
    rtn = _R2D(_Atan2(deltaY, deltaX))
    If rtn < 0 Then DAtan2 = rtn + 360 Else DAtan2 = rtn
End Function

' use angles in degrees units instead of radians (converted inside sub)
Sub ArrowTo (BaseX As Long, BaseY As Long, dAngle As Double, lngth As Long, colr As _Unsigned Long)
    Dim As Long x1, y1, x2, y2, x3, y3
    Dim As Double rAngle
    rAngle = _D2R(dAngle)
    x1 = BaseX + lngth * Cos(rAngle)
    y1 = BaseY + lngth * Sin(rAngle)
    x2 = BaseX + .8 * lngth * Cos(rAngle - _Pi(.05))
    y2 = BaseY + .8 * lngth * Sin(rAngle - _Pi(.05))
    x3 = BaseX + .8 * lngth * Cos(rAngle + _Pi(.05))
    y3 = BaseY + .8 * lngth * Sin(rAngle + _Pi(.05))
    Line (BaseX, BaseY)-(x1, y1), colr
    Line (x1, y1)-(x2, y2), colr
    Line (x1, y1)-(x3, y3), colr
End Sub


RE: Angle Collisions - OldMoses - 10-17-2022

That works great. I commented out the delay and the arrow draws to watch it run unimpeded. I did see it get stuck on a point between two lines after running for a while. I assume it couldn't determine which boundary normal to use...?

RE: Angle Collisions - bplus - 10-17-2022

Yeah it's probably in an indentation of the border trapped between 2 walls. If you have the arrows displaying, they will toggle back and forth but there is no room for circle to move enough to change position.

Here is one that got stuck, I am surprised it is a peninsula not a bay.
   

The arrows toggled with only a fraction of a change between them.

RE: Angle Collisions - james2464 - 10-17-2022

Sometime recently I read that the ends of the line segments should be treated differently than the rest of the line. I'm not quite sure what that meant but I suppose it could be a special case that is needed at intersections.

RE: Angle Collisions - OldMoses - 10-17-2022

The one that got stuck on my run was on a peninsula as well.

RE: Angle Collisions - bplus - 10-17-2022

Yes 5 peninsulas and 0 bays for me, since I've been counting. Particularly pleasing, none have gone flying off the screen.

So we need to get over it, not get out of it ;-))

Finally I've ID'd James avatar ;-))  It was bugging me for awhile
   

I thought it was another R named artist.

RE: Angle Collisions - james2464 - 10-17-2022

Yes sir that's correct!  Also it's my painting https://i.imgur.com/8eYU28D.jpg  (I occupied my pandemic time by oil painting)

RE: Angle Collisions - Pete - 10-17-2022

I hear good artists copy and great artists steal. I guess that makes you a good artist. If you were a great artist, I'd turn you in for the reward!

Pete

RE: Angle Collisions - bplus - 10-17-2022

(10-17-2022, 03:46 PM)james2464 Wrote: Yes sir that's correct!  Also it's my painting https://i.imgur.com/8eYU28D.jpg  (I occupied my pandemic time by oil painting)

Time well spent, very nice!