Well I've had trouble with the random outer border, so I decided to try a fixed pattern for now. Added frame splitting, so going past the line is kept to a minimum. This seems to make the ball stick every so often, so I need to adjust this.
Code: (Select All)
'vector reflection and line detection demo
'james2464
Dim Shared scx, scy As Integer
scx = 800: scy = 600
Screen _NewImage(scx, scy, 32)
Const PI = 3.141592654#
Randomize Timer
Dim Shared x, y, h, xv, yv, ndpx, ndpy, rx, ry, rt
Dim Shared cpa, cpb, a, b, a2, b2, sbx, sby
Dim Shared bg&
bg& = _NewImage(scx + 1, scy + 1, 32)
Dim Shared c(10) As Long
c(0) = _RGB(30, 30, 30)
c(1) = _RGB(255, 255, 255)
c(2) = _RGB(255, 255, 0)
c(3) = _RGB(255, 0, 0)
c(4) = _RGB(0, 255, 0)
c(5) = _RGB(0, 255, 255)
c(6) = _RGB(255, 0, 255)
Type fixedwall
x1 As Integer
x2 As Integer
y1 As Integer
y2 As Integer
b As Integer
bx1 As Integer
bx2 As Integer
by1 As Integer
by2 As Integer
xx As Single
yy As Single
wlen As Single
nx As Single
ny As Single
sc As Single
End Type
Dim Shared w(50) As fixedwall
Dim Shared walltotal, ballrad
ballrad = 12 'ball radius
walltotal = 10
For t = 1 To walltotal
w(t).b = ballrad + 2
Next t
w(1).x1 = 400: w(1).x2 = 456.1285: w(1).y1 = 50: w(1).y2 = 222.7458
w(2).x1 = 456.1285: w(2).x2 = 637.7641: w(2).y1 = 222.7458: w(2).y2 = 222.7458
w(3).x1 = 637.7641: w(3).x2 = 490.8178: w(3).y1 = 222.7458: w(3).y2 = 329.5085
w(4).x1 = 490.8178: w(4).x2 = 546.9463: w(4).y1 = 329.5085: w(4).y2 = 502.2542
w(5).x1 = 546.9463: w(5).x2 = 400: w(5).y1 = 502.2542: w(5).y2 = 395.4915
w(6).x1 = 400: w(6).x2 = 253.0537: w(6).y1 = 395.4915: w(6).y2 = 502.2542
w(7).x1 = 253.0537: w(7).x2 = 309.1822: w(7).y1 = 502.2542: w(7).y2 = 329.5085
w(8).x1 = 309.1822: w(8).x2 = 162.2359: w(8).y1 = 329.5085: w(8).y2 = 222.7458
w(9).x1 = 162.2359: w(9).x2 = 343.8715: w(9).y1 = 222.7458: w(9).y2 = 222.7458
w(10).x1 = 343.8715: w(10).x2 = 400: w(10).y1 = 222.7458: w(10).y2 = 50
wallsetup
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen
xv = 6. 'starting ball x velocity
yv = 2. 'starting ball y velocity
sbx = 400 'starting x position
sby = 300 'starting y position
flag = 0
Do
_Limit 30
Cls
_PutImage (0, 0)-(scx, scy), bg&, 0 'draw background
'=====================================================
'_MouseHide
sbx = sbx + xv
sby = sby + yv
If sbx > (scx - ballrad) Then
xv = xv * -1
t = sbx - (scx - ballrad)
sbx = sbx - t
End If
If sby > (scy - ballrad) Then
yv = yv * -1
t = sby - (scy - ballrad)
sby = sby - t
End If
If sbx < ballrad Then
xv = xv * -1
t = ballrad - sbx
sbx = sbx + t
End If
If sby < ballrad Then
yv = yv * -1
t = ballrad - sby
sby = sby + t
End If
'=====================================================
rt = rectanglecheck 'early wall detection
'Line (w(rt).x1, w(rt).y1)-(w(rt).x2, w(rt).y2), c(3) 'early detection (red)
If rectanglecheck > 0 Then
rt = nearestwall
Line (w(rt).x1, w(rt).y1)-(w(rt).x2, w(rt).y2), c(4) 'nearest wall (green)
framesplit
reflect
End If
'=====================================================
Circle (sbx, sby), (ballrad - 1), c(2) 'screen location of ball
_Display
If mouseclick2 = 1 Then flag = 1
Loop Until flag = 1
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
Function rectanglecheck
rectanglecheck = 0
ttt = 1
While ttt <= walltotal
If sbx >= w(ttt).bx1 Then
If sbx <= w(ttt).bx2 Then
If sby >= w(ttt).by1 Then
If sby <= w(ttt).by2 Then
rectanglecheck = ttt
End If
End If
End If
End If
ttt = ttt + 1
Wend
End Function
Function nearestwall
nearestwall = 0
For ct = 1 To walltotal 'get each wall centerpoint distance from ball
tdx = Abs(sbx - w(ct).xx)
tdy = Abs(sby - w(ct).yy)
w(ct).sc = _Hypot(tdx, tdy)
Next ct
'sort to find nearest wall
lowscore = 500
lowscorewall = 0
For ct = 1 To walltotal
If w(ct).sc < lowscore Then
old = lowscore
oldwall = lowscorewall
lowscore = w(ct).sc
lowscorewall = ct
End If
Next ct
'faceoff between 2 closest walls
'predict which will be closer after another frame of movement
fsbx = sbx + xv
fsby = sby + yv
tdx = Abs(fsbx - w(oldwall).xx)
tdy = Abs(fsby - w(oldwall).yy)
fscoreold = _Hypot(tdx, tdy)
tdx = Abs(fsbx - w(lowscorewall).xx)
tdy = Abs(fsby - w(lowscorewall).yy)
fscorelow = _Hypot(tdx, tdy)
If fscoreold < fscorelow Then
nearestwall = oldwall
Else
nearestwall = lowscorewall
End If
End Function
Sub framesplit
x = sbx - w(rt).xx: y = 0 - sby + w(rt).yy 'location relative to wall
h = (_Hypot(-x, y))
dx = -x * w(rt).ny * -1: dy = y * w(rt).nx: ndp = dx + dy
If Abs(ndp) <= ballrad Then ' ball moved past the line
overtheline = ballrad - Abs(ndp)
spd = _Hypot(xv, yv)
nxv = xv / spd: nyv = yv / spd
oldsbx = sbx: oldsby = sby
sbx = sbx - (overtheline * nxv) * .8
sby = sby - (overtheline * nyv) * .8
End If
'check for endpoints distance
End Sub
Sub reflect
x = sbx - w(rt).xx: y = 0 - sby + w(rt).yy 'location relative to wall
h = (_Hypot(-x, y))
dx = -x * w(rt).ny * -1: dy = y * w(rt).nx: ndp = dx + dy
'dot product V.N - used to find distance of N
ndpx = w(rt).ny * ndp
ndpy = w(rt).nx * ndp
'Line (w(rt).xx, w(rt).yy)-(w(rt).xx + ndpx, w(rt).yy - ndpy), c(5)
'calculate point R
th1 = _Atan2(-y, x) 'radian value of ball (point I)
th2 = _Atan2(-ndpy, ndpx) 'radian value of line N
thd = th1 - th2 'find difference
th3 = th2 - thd 'subtract difference from line N
rx = Cos(th3) * h: ry = Sin(th3) * h 'point R position - th3 * length of point I to collision point
'angled wall
a = w(rt).ny * w(rt).wlen
b = w(rt).nx * w(rt).wlen
a2 = a * -1: b2 = b * -1
c(9) = c(1)
'find length of line A
segx = Abs(x - rx)
segy = Abs((w(rt).yy - y) - (w(rt).yy + ry))
sega = _Hypot(segx, segy)
'find distance from point I to wall endpoints
i2w1x = Abs(x - b)
i2w1y = Abs(a + y)
i2w2x = Abs(x + b)
i2w2y = Abs(y - a)
i2wh1 = _Hypot(i2w1x, i2w1y)
i2wh2 = _Hypot(i2w2x, i2w2y)
If i2wh1 < i2wh2 Then 'determine which end the ball is closer to
i2ws = 1: i2w = i2wh1
Else
i2ws = 2: i2w = i2wh2
End If
If sega < (w(rt).wlen * 2) Then
If Abs(ndp) <= ballrad Then ' ***** collision with side of the line *****
c(9) = c(3) 'if beside the wall, just check length of line N
collisionpointa = w(rt).ny * (sega / 2)
collisionpointb = w(rt).nx * (sega / 2)
If i2ws = 1 Then
cpa = w(rt).yy + collisionpointa: cpb = w(rt).xx + collisionpointb
End If
If i2ws = 2 Then
cpa = w(rt).yy - collisionpointa: cpb = w(rt).xx - collisionpointb
End If
'Circle (cpb, cpa), 5, c(4) 'circle the collision point
'_Display
'_Delay .01
sidecollisionvector
End If
Else
If i2w <= ballrad Then ' ***** collision with endpoint of the line *****
c(9) = c(3)
If i2ws = 1 Then
cpa = w(rt).yy - a2: cpb = w(rt).xx + b
endpointcollision1
End If
If i2ws = 2 Then
cpa = w(rt).yy - a: cpb = w(rt).xx + b2
endpointcollision2
End If
'Circle (cpb, cpa), 5, c(4) 'circle the collision point
'_Display
'_Delay .01
End If
End If
End Sub
Sub sidecollisionvector
tx = xv: ty = yv: th = _Hypot(tx, ty)
tx2 = tx / th: ty2 = ty / th
spd = _Hypot(tx, ty) 'speed of existing motion vector
th1 = _Atan2(tx, -ty) 'radian value of motion vector
th2 = _Atan2(-ndpy, ndpx) 'radian value of line N
thd = th1 - th2 'find difference
th3 = th2 - thd 'subtract difference from line N
newxv = Sin(th3): newyv = Cos(th3)
xv = newxv * spd: yv = newyv * spd * -1
End Sub
Sub endpointcollision1
tx = x - b: ty = y - a2: th = _Hypot(tx, ty)
tx2 = tx / th: ty2 = ty / th
txv = Abs(xv): tyv = Abs(yv): spd = _Hypot(txv, tyv)
xv = tx2 * spd: yv = ty2 * spd * -1
End Sub
Sub endpointcollision2
tx = x - b2: ty = y - a: th = _Hypot(tx, ty)
tx2 = tx / th: ty2 = ty / th
txv = Abs(xv): tyv = Abs(yv): spd = _Hypot(txv, tyv)
xv = tx2 * spd: yv = ty2 * spd * -1
End Sub
Sub wallsetup
For wct = 1 To walltotal
w(wct).bx1 = w(wct).x1: w(wct).bx2 = w(wct).x2
w(wct).by1 = w(wct).y1: w(wct).by2 = w(wct).y2
'orient outer box
If w(wct).bx1 > w(wct).bx2 Then
t = w(wct).bx1
w(wct).bx1 = w(wct).bx2
w(wct).bx2 = t
End If
If w(wct).by1 > w(wct).by2 Then
t = w(wct).by1
w(wct).by1 = w(wct).by2
w(wct).by2 = t
End If
w(wct).bx1 = w(wct).bx1 - w(wct).b: w(wct).bx2 = w(wct).bx2 + w(wct).b
w(wct).by1 = w(wct).by1 - w(wct).b: w(wct).by2 = w(wct).by2 + w(wct).b
Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(1)
'Line (w(wct).bx1, w(wct).by1)-(w(wct).bx2, w(wct).by2), c(2), B
w(wct).xx = (w(wct).x2 - w(wct).x1) / 2 + w(wct).x1
w(wct).yy = (w(wct).y2 - w(wct).y1) / 2 + w(wct).y1
'Circle (w(wct).xx, w(wct).yy), 5, c(4)
tx = w(wct).x2 - w(wct).xx: ty = w(wct).y2 - w(wct).yy
w(wct).wlen = _Hypot(tx, ty)
w(wct).nx = tx / w(wct).wlen 'normalized wall angle
w(wct).ny = ty / w(wct).wlen 'normalized wall angle
Next wct
End Sub