OK I got the ball now so you can trap it into a corner of a flipper and side by holding the flipper up, like on a pinball machine. Unlike a real pinball machine though the ball won't roll down the flipper when bouncing stops. Nope the ball melts right through the flipper, splits into 2 balls above and below the flipper, they wiggle their way up to top of flipper base then shoots off and drains down the middle!
You got to see this to believe!
You got to see this to believe!
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 = .15
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 - 265
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 + 265
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 = 215: 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
ba = _Atan2(bdy, bdx)
bx = bx + bdx
If bx < br Then bx = br: bdx = -bdx: bs = bs - .15
If bx > XMax - br Then bx = XMax - br: bdx = -bdx: bs = bs - .15
by = by + bdy
If by < br Then by = br: bdy = -bdy: bs = bs - .15
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 / 200
Else
bs = bs - .3
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 / 200
Else
bs = bs - .3
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 + ...