Much closer! First fix was NOT letting bs = Ball speed drop below 0 in fact not letting it drop below gravity was better.
Then the ball could be trapped in corner until it bounced in place and came to dead stop, STUCK in that corner.
Fix for that was to move the baseX of flippers closer to edge of screen so ball could only be trapped just inside the top circle not next to wall.
Increased gravity and deadened ball more when hit walls or flippers not moving, so the trap takes less time and ball rolls down flipper, still slow but better.
No more melting through flipper and double balls drawn. Plus ball is not passing through flippers while it is going down fast! and flippers are going up.
Then the ball could be trapped in corner until it bounced in place and came to dead stop, STUCK in that corner.
Fix for that was to move the baseX of flippers closer to edge of screen so ball could only be trapped just inside the top circle not next to wall.
Increased gravity and deadened ball more when hit walls or flippers not moving, so the trap takes less time and ball rolls down flipper, still slow but better.
No more melting through flipper and double balls drawn. Plus ball is not passing through flippers while it is going down fast! and flippers are going up.
Code: (Select All)
Option _Explicit
_Title "Test flippers: left ctrl for left flipper, right ctrl for right" 'b+ 2024-11-16
' instead of a light beam reflecting off surface angle in = angle out
' here we try angle out is perpendicular to flipper
' result: not a hell of allot of difference flipper goes righjt over the ball near tip
' and ball falls right through or trips and dribbles???????
' 2024-11-23 moved Weird Filpper code into here and dumped previous code I had.
Const XMax = 600, YMax = 720
Const SCX = 300, Gravity = .5
Type FlipperType
As Single baseX, baseY ' DrawFlipper needs these
As Single tipX, tipY ' need to track collisions on ends of flipper
As Single UpA, DownA, CurA
As Long LeftFlipTF, TargetUpTF ' true false boolean
End Type
Type CircleType
As Single x, y, r
End Type
Dim As FlipperType leftFlip, rightFlip
' some parts of Type are constant declare now
leftFlip.LeftFlipTF = -1
leftFlip.baseX = SCX - 280
leftFlip.baseY = YMax - 140
leftFlip.UpA = -_Pi(1 / 12) ' 315 degrees NE
leftFlip.DownA = _Pi(1 / 6)
leftFlip.TargetUpTF = 0 ' test a key press OK
leftFlip.CurA = leftFlip.DownA ' flipper at rest in down position
rightFlip.LeftFlipTF = 0
rightFlip.baseX = SCX + 280
rightFlip.baseY = YMax - 140
rightFlip.UpA = _Pi(13 / 12) ' 180 + 45 = 225 degrees NE
rightFlip.DownA = _Pi(5 / 6)
rightFlip.TargetUpTF = 0 ' flipper at rest in down position
rightFlip.CurA = rightFlip.DownA
Dim Shared FLen, BaseR, TipR
FLen = 230: BaseR = 30: TipR = 12
Dim Shared LFC(FLen) As CircleType, RFC(FLen) As CircleType
SetFlipperRadii
Dim ftime, rtime
Dim bx, by, br, bs, ba, bdx, bdy, i, lffirstI, lflastI, rffirsti, rflasti
Screen _NewImage(600, 720, 32): _ScreenMove 300, 0
restart:
bx = SCX: by = 360: br = 25: bs = 5: ba = _D2R(40) ' Ok symmetric 40 an 140
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
Do
Line (0, 0)-(XMax, YMax), &H22000000, BF
If _KeyDown(100306) And Timer(.001) > ftime + .1 Then leftFlip.TargetUpTF = -1 ' left side ctrl
If _KeyDown(100305) And Timer(.001) > rtime + .1 Then rightFlip.TargetUpTF = -1 ' right side ctrl
drawBall bx, by, br, _RGB32(250)
DrawFlipper leftFlip
DrawFlipper rightFlip
'update ball
bdy = bdy + Gravity
If bdy < -br Then bdy = -br ' keep ball from melting through flipper
ba = _Atan2(bdy, bdx)
bx = bx + bdx
If bx < br Then bx = br: bdx = -bdx: bs = bs - Gravity
If bx > XMax - br Then bx = XMax - br: bdx = -bdx: bs = bs - Gravity
by = by + bdy
If by < br Then by = br: bdy = -bdy: bs = bs - Gravity
If bs < Gravity Then bs = Gravity
If by > YMax - br Then Exit Do
'update flippers
lffirstI = -1: rffirsti = -1: lflastI = -1: rflasti = -1
For i = 0 To FLen
If _Hypot(by - LFC(i).y, bx - LFC(i).x) < br + LFC(i).r Then ' collision
If lffirstI < 0 Then lffirstI = i Else lflastI = i
End If
If _Hypot(by - RFC(i).y, bx - RFC(i).x) < br + RFC(i).r Then ' collision
If rffirsti < 0 Then rffirsti = i Else rflasti = i
End If
Next
If lffirstI >= 0 Then
If lflastI > 0 Then
i = (lffirstI + lflastI) / 2
Else
i = lffirstI
End If
If leftFlip.TargetUpTF And leftFlip.CurA <> leftFlip.UpA Then
bs = bs + i / 50
Else
bs = bs - Gravity
If bs < Gravity Then bs = Gravity
End If
ba = _Atan2(by - LFC(i).y, bx - LFC(i).x)
bx = LFC(i).x + (br + LFC(i).r) * Cos(ba): by = LFC(i).y + (br + LFC(i).r) * Sin(ba) ' move ball back above flipper
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
'bx = bx + bdx: by = by + bdy
'If leftFlip.TargetUpTF Then leftFlip.TargetUpTF = 0: ftime = Timer(.001)
ElseIf rffirsti >= 0 Then
If rflasti > 0 Then
i = (rffirsti + rflasti) / 2
Else
i = rffirsti
End If
If rightFlip.TargetUpTF And rightFlip.CurA <> rightFlip.UpA Then
bs = bs + i / 50
Else
bs = bs - Gravity
If bs < Gravity Then bs = Gravity
End If
ba = _Atan2(by - RFC(i).y, bx - RFC(i).x)
bx = RFC(i).x + (br + RFC(i).r) * Cos(ba): by = RFC(i).y + (br + RFC(i).r) * Sin(ba) ' move ball back above flipper
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
'bx = bx + bdx: by = by + bdy
'If rightFlip.TargetUpTF Then rightFlip.TargetUpTF = 0: rtime = Timer(.001)
End If
_Display
_Limit 60
Loop Until _KeyDown(27)
If _KeyDown(27) = 0 Then _Delay 2: GoTo restart
Function FlipAngle (f As FlipperType)
Dim da
da = _Pi(1 / 48)
If f.LeftFlipTF Then ' left flipper
If f.TargetUpTF Then ' move CCW subtract
If f.CurA - da < f.UpA Then
f.CurA = f.UpA
f.TargetUpTF = 0 'target hit
Else
f.CurA = f.CurA - da
End If
Else ' move CW
If f.CurA + da > f.DownA Then f.CurA = f.DownA Else f.CurA = f.CurA + da
End If
Else ' right flip
If f.TargetUpTF Then ' move CW
If f.CurA + da > f.UpA Then
f.CurA = f.UpA
f.TargetUpTF = 0
Else
f.CurA = f.CurA + da
End If
Else ' move CCW
If f.CurA - da < f.DownA Then f.CurA = f.DownA Else f.CurA = f.CurA - da
End If
End If
FlipAngle = f.CurA
End Function
Sub SetFlipperRadii
Dim i, f
f = (BaseR - TipR) / FLen
For i = 0 To FLen
LFC(i).r = BaseR - i * f
RFC(i).r = LFC(i).r
Next
End Sub
Sub DrawFlipper (f As FlipperType)
' setup to drawLink
Dim ang, i
ang = FlipAngle(f)
For i = 0 To FLen
If f.LeftFlipTF Then
LFC(i).x = f.baseX + i * Cos(ang)
LFC(i).y = f.baseY + i * Sin(ang)
FC3 LFC(i).x, LFC(i).y, LFC(i).r, &HFFAA8800
Else
RFC(i).x = f.baseX + i * Cos(ang)
RFC(i).y = f.baseY + i * Sin(ang)
FC3 RFC(i).x, RFC(i).y, RFC(i).r, &HFFAA8800
End If
Next
For i = 0 To FLen
If f.LeftFlipTF Then
LFC(i).x = f.baseX + i * Cos(ang)
LFC(i).y = f.baseY + i * Sin(ang)
FC3 LFC(i).x, LFC(i).y, LFC(i).r - 5, &HFFFFFFFF
Else
RFC(i).x = f.baseX + i * Cos(ang)
RFC(i).y = f.baseY + i * Sin(ang)
FC3 RFC(i).x, RFC(i).y, RFC(i).r - 5, &HFFFFFFFF
End If
Next
End Sub
Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' no suffix punctuation use the Global Default Type as Long or Single or Double
Dim As Long r2, x, y ' for Option _Explicit
If r < 1 Then Exit Sub
Line (cx - r, cy)-(cx + r, cy), clr~&, BF
r2 = r * r
Do
y = y + 1
x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
Loop Until y = r
End Sub
Sub drawBall (x, y, r, c As _Unsigned Long)
Dim rred As Long, grn As Long, blu As Long, rr As Long, f
rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
For rr = r To 0 Step -1
f = 1 - Sin(rr / r) ' thank OldMoses for Sin ;-))
FC3 x, y, rr, _RGB32(rred * f, grn * f, blu * f)
Next
End Sub
b = b + ...