+- 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: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: Pinball (/showthread.php?tid=3225)
Pinball - bplus - 11-22-2024
Testing flipper action, this has best results so far. I've given up on angle-in = angle-out like ball hitting wall.
Off a flipper, ball action works best ball going out perpendicular to flipper for me anyway...
Code: (Select All)
Option _Explicit
_Title "Weird 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
Const XMax = 600, YMax = 720
Const SCX = 300, Gravity = .1
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 / 6) ' 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(7 / 6) ' 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 = 15: 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
bx = bx + bdx
If bx < br Then bx = br: bdx = -bdx
If bx > XMax - br Then bx = XMax - br: bdx = -bdx
by = by + bdy
If by < br Then by = br: bdy = -bdy
If by > YMax - br Then Exit Do
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
ba = _Atan2(by - LFC(i).y, bx - LFC(i).x)
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
ba = _Atan2(by - RFC(i).y, bx - RFC(i).x)
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 30
Loop Until _KeyDown(27)
If _KeyDown(27) = 0 Then _Delay 2: GoTo restart
Function FlipAngle (f As FlipperType)
Dim da
da = _Pi(1 / 24)
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 SubAnyone have Pinball code hanging around? I have a pretty good JB example with spring action off bumper (not bumper really more bell than bumper, what do you call them?)
RE: Pinball - PhilOfPerth - 11-22-2024
I call them Buffers - but when playing, I call them lots of other things!
RE: Pinball - bplus - 11-22-2024
Kickers and slingshots and that is what they do.
RE: Pinball - NakedApe - 11-22-2024
Am I helpful - or what?!
From The Internet Pinball Machine Glossary:
"Bumpers are round, mushroom-shaped targets set into the playfield of most pinball machines. They fall into two categories: active and passive. Both types register a hit when the ball collides with them.
Active bumpers, the most common, forcefully kick the ball away when struck.
Passive bumpers look similar to active bumpers, but do not kick the ball when hit. See also the passive Tower Bumper.
Mushroom bumpers are passive bumpers, each is a post having a disk on top. When the ball approaches the bumper and strikes the post, it lifts the disk. The disk is attached to a shaft down the middle of the post, and this shaft rises when the disk is lifted, activating a leaf switch which registers the hit. Bally popularized this bumper in the 1960s and 1970s starting with Bally's 1963 'Hootenanny', and European games followed in its use. While Bally is popularly credited with the first use of mushroom bumpers, Stoner used them during 1939-40 on Stoner's 1939 'Ali-Baba' and Stoner's 1940 'Fantasy'.
Active bumpers have been given various names. According to the book All About Pinball, Williams called them thumper bumpers on their 1948 game Saratoga but eventually decided to use the shorter term jet bumpers. Gottlieb first used the term percussion bumpers on their 1949 "Bowling Champ" game but eventually changed to the term pop bumpers. Genco called them power bumpers. Bally called them thumper bumpers.
RE: Pinball - SierraKen - 11-23-2024
Great physics B+! Now try adding gravity that could settle the ball down and stop on a flipper that is being pressed.
RE: Pinball - bplus - 11-23-2024
Ha I do have gravity, it's in the code. Everytime the ball hits a flipper the ball dx, dy is reset back to bs = ball speed. Increase gravity too much, the ball will fall right through flipper as it missed the intersect detection!
RE: Pinball - SierraKen - 11-23-2024
Hmm, not sure what you mean. But I mean if you have a flipper up already and the ball hits it, it won't lose any energy, it will just deflect off of it. There's no difference between the power of the flipper speed and just the flipper. Would be pretty cool if it added the power of the flipper speed and the ball loses more energy if you don't strike it with the flipper.
RE: Pinball - bplus - 11-23-2024
Well what I was saying was that the ball can be moving so fast downward and the flipper, specially at the tips, so fast upward that between one frame and the next there is no contact detection and the ball is below the flipper!
But you're right the force of a moving flipper hitting the ball should be different than if the ball hits a stationary flipper. I will have to work on that!
RE: Pinball - bplus - 11-24-2024
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!
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 SubRE: Pinball - Pete - 11-24-2024
Not very realistic. No matter how hard I shook my laptop, it never went tilt.
+1
Pete