Pinball

[bplus]

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 Sub

Anyone 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?)

[PhilOfPerth]

I call them Buffers - but when playing, I call them lots of other things! 

[bplus]

Kickers and slingshots and that is what they do.

[NakedApe]

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.

[SierraKen]

Great physics B+! Now try adding gravity that could settle the ball down and stop on a flipper that is being pressed.

[bplus]

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!

[SierraKen]

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.

[bplus]

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!

[bplus]

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 Sub

[Pete]

Not very realistic. No matter how hard I shook my laptop, it never went tilt.

+1

Pete