10-16-2022, 08:04 PM
(10-16-2022, 07:45 PM)bplus Wrote: Well I could goof up the 4 corners of container and it works showing arrowed directions (but not magnitudes).
Code: (Select All)_Title "James Random Container" ' b+ 2022-10-16
Screen _NewImage(800, 600, 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, x2, y2 ' building container
Dim As _Unsigned Long PK
Dim As Long NLines, L, Container
ReDim Boundaries(1 To 100) As lineSegment
cx = _Width / 2: cy = _Height / 2 + 40
PK = _RGB32(0, 150, 85) ' minty green background out of bounds
Cls
x1 = 10
y1 = 100
flag = 0
While flag = 0 ' across top of screen left to right
x2 = (Rnd * 80) + 800 + x1
If x2 > 750 Then
x2 = 750
flag = 1
End If
y2 = Rnd * 160 + 50
Line (x1, y1)-(x2, y2), PK
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 ' down right side
y2 = (Rnd * 80) + 600 + y1
If y2 > 550 Then
y2 = 550
flag = 1
End If
x2 = 750 - (Rnd * 160 + 50)
Line (x1, y1)-(x2, y2), PK
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 ' across bottom right to left
x2 = x1 - ((Rnd * 80) + 800)
If x2 < 50 Then
x2 = 50
flag = 1
End If
y2 = 550 - (Rnd * 60 + 20)
Line (x1, y1)-(x2, y2), PK
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) + 700)
If y2 < 50 Then
y2 = 100
flag = 1
End If
x2 = Rnd * 60 + 20
If flag = 1 Then x2 = 10
Line (x1, y1)-(x2, y2), PK
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), PK, PK
Print " Yellow = the vector of ball heading towards line."
Print " Blue = vector perpendicular (normal) to boundary line."
Print " White = angle of refelection off line."
Print " esc starts a different poly."
Container = _NewImage(_Width, _Height, 32)
_PutImage , 0, Container
Dim bx, by, ba, br, bspeed, hit, hitx1, hity1, hitx2, hity2, diff
bx = cx: by = cy: bspeed = 5
br = 10 ' 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?
hit = lineIntersectCircle%(Boundaries(L).x1, Boundaries(L).y1, Boundaries(L).x2, Boundaries(L).y2, bx, by, br, hitx1, hity1, hitx2, hity2)
' probably should back it up before processing bounce
If hit Then ' rebound ball
Circle (bx, by), br
_Display
While hit ' back up circle
bx = bx + CosD(ba - 180)
by = by + SinD(ba - 180)
hit = lineIntersectCircle%(Boundaries(L).x1, Boundaries(L).y1, Boundaries(L).x2, Boundaries(L).y2, bx, by, br, hitx1, hity1, hitx2, hity2)
Circle (bx, by), br
_Display
Wend
_PutImage , Container, 0
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 1
End If
Next
_Display
_Limit 30
Loop Until _KeyDown(27)
'' return 0 no Intersect, 1 = tangent 1 point touch, 2 = 2 point intersect
'' if intersect returns point or points of intersect ix1, iy1, ix2, iy2
'' intersect points are -999 if non existent ie no intersect or 2nd point when circle is tangent
Function lineIntersectCircle% (lx1, ly1, lx2, ly2, cx, cy, r, ix1, iy1, ix2, iy2)
Dim m, y0, A, B, C, D, x1, y1, x2, y2, ydist
'needs SUB slopeYintersect (X1, Y1, X2, Y2, slope, Yintercept)
If lx1 <> lx2 Then
slopeYintersect lx1, ly1, lx2, ly2, m, y0 ' Y0 otherwise know as y Intersect
' https://math.stackexchange.com/questions/228841/how-do-i-calculate-the-intersections-of-a-straight-line-and-a-circle
A = m ^ 2 + 1
B = 2 * (m * y0 - m * cy - cx)
C = cy ^ 2 - r ^ 2 + cx ^ 2 - 2 * y0 * cy + y0 ^ 2
D = B ^ 2 - 4 * A * C 'telling part of Quadratic formula = 0 then circle is tangent or > 0 then 2 intersect points
If D < 0 Then ' no intersection
ix1 = -999: iy1 = -999: ix2 = -999: iy2 = -999: lineIntersectCircle% = 0
ElseIf D = 0 Then ' one point tangent
x1 = (-B + Sqr(D)) / (2 * A)
y1 = m * x1 + y0
ix1 = x1: iy1 = y1: ix2 = -999: iy2 = -999: lineIntersectCircle% = 1
Else '2 points
x1 = (-B + Sqr(D)) / (2 * A): y1 = m * x1 + y0
x2 = (-B - Sqr(D)) / (2 * A): y2 = m * x2 + y0
ix1 = x1: iy1 = y1: ix2 = x2: iy2 = y2: lineIntersectCircle% = 2
End If
Else 'vertical line
If r = Abs(lx1 - cx) Then ' tangent
ix1 = lx1: iy1 = cy: ix2 = -999: iy2 = -999: lineIntersectCircle% = 1
ElseIf r < Abs(lx1 - cx) Then 'no intersect
ix1 = -999: iy1 = -999: ix2 = -999: iy2 = -999: lineIntersectCircle% = 0
Else '2 point intersect
ydist = Sqr(r ^ 2 - (lx1 - cx) ^ 2)
ix1 = lx1: iy1 = cy + ydist: ix2 = lx1: iy2 = cy - ydist: lineIntersectCircle% = 2
End If
End If
End Function
Sub slopeYintersect (X1, Y1, X2, Y2, slope, Yintercept) ' fix for when x1 = x2
slope = (Y2 - Y1) / (X2 - X1)
Yintercept = slope * (0 - X1) + Y1
End Sub
' 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
Line segment intersects with circle is harder to get going.
Excellent, nice to see this working so well!