Pinball

[bplus]

RE: Pete's last reply

Thanks, not realistic is right! This thing has been quite frustrating, OTOH where else can you see 2 balls drawn for the price of one coded?! How the heck does that even happen?

On Android we could do tilt in SmallBASIC I think.

[SierraKen]

Great job B+! For the detection problem that makes it seep through, you might want to add a 5 pixel bounce once it hits a certain X and Y limits. A game I did recently had something similar happen and when I added that "bounce" away from the border, it stayed away. But since you want the ball to stop at the flipper, I would but the X and Y limits not on the border of the flipper, but instead in the middle of the flipper. So if it sits there long enough, the ball can seep through a little bit and then bounce back toward the border of the flipper. 5 pixels won't make much to see anyway, but it might stop this problem. I have no idea why it splits into 2, you must have done that.

[bplus]

Hi Ken,

If you read through the code, yeah understanding a little difficult, when the flipper collison is detected, the ball is placed above the flipper And if the flipper is moving the ball speed is increased according how far down the fliiper it is detected ie biggest bounce from tip, smallest bounce from the end it is melting through. I think the gravity is why the ball melts through. Two balls start being drawn when the there is collision detection on the other side of the flipper as ball melts through.

Maybe I could set the ball a tad higher above the flipper, put a limit on how much gravity can effect bdy but ball likely to come to dead stop stuck above the flipper but at least that would be more natural and time to tilt machine

Thanks your ideas help give me ideas

[bplus]

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.

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

[SierraKen]

This is fantastic! It's almost like a fidget ball thing now and actually pretty fun to mess around with. Are you going to try and make this into a game? I hope so.

[bplus]

Wait... didn't I just reply to this? EEEEEh too early Monday morning

Yes I am working towards a Chritsmas themed Pinball Game, a challenge vince threw out after my Christmas Themed mod of Plinko that he started earlier this month.

[grymmjack]

I thought I was halucinating @bplus as the ghosting is so trailsy.

This is sweet man. You are a legend. I'm excited to see your Christmas things! Plinko that @vince made in qbjs is awesome. You should check that out if you haven't yet?

[bplus]

I thought I was halucinating @bplus as the ghosting is so trailsy.

? what, you'll have to translate what that means? oh you mean the tracers on flippers and ball, that is easy to do, just blackout screen with an alpha black transparency of line statement. Instead of CLS it just darkens until eventually faded out. Cool effect I learned from Fellippe, stars at warp speed!

This is sweet man. You are a legend. I'm excited to see your Christmas things! Plinko that @vince made in qbjs is awesome. You should check that out if you haven't yet?

@grymmjack not only did I check out vince Plinko I did this:
https://qb64phoenix.com/forum/showthread...5#pid29755
reply #218 near end of 20+ pages

and Christmas Themed Plinko:
https://qb64phoenix.com/forum/showthread...2#pid29782

So you don't have to wait, I started on Christmas stuff already

[SierraKen]

A Christmas Pinball!!! I can't wait!!!

[bplus]

Well if you get figety I am testing a circular board here:

Code: (Select All)

Option _Explicit
_Title "Test flippers with Circle BG: 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.

' 2024-11-24 dont let bs go below zero better yet below gravity.
' Moved baseX of flippers closer to walls so ball isn't stuck in the corner.
' Increased power down line of flipper contact from i/200 to i/50 because
' gravity was increased to roll ball down flipper faster from dead stop.
' More deadening of bs when hitting walls or flippers not moving.

' 2024-11-25 now add a Circle Board BackGround = BG
Const XMax = 740, YMax = 740
Const ScR = 370, 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 = ScR - 300
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 = ScR + 300
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 = 250: 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(XMax, YMax, 32): _ScreenMove 320, 0
br = 25

restart:
bx = ScR: by = br: bs = 10
If Rnd < .5 Then ba = _Pi((8 + 2 * Rnd) / 12) Else ba = _Pi((4 - 2 * Rnd) / 12)
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
Color , &HFF220044
Do
    Cls: Print "ba bs"; _R2D(ba); bs
    'Sleep
    FC3 ScR, ScR, ScR + 3, &HFFBB0000
    FC3 ScR, ScR, ScR, &HFF888888
    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
    by = by + bdy
    If bs < Gravity Then bs = Gravity ' limit lowest speed
    'If bs > 20 Then bs = 20
    If by > YMax - 1.25 * br Then drawBall bx, by, br, _RGB32(250): _Display: Exit Do ' drain
    'keep ball inside board radius
    If _Hypot(by - ScR, bx - ScR) + br > ScR Then ' move back ball
        ba = _Atan2(by - ScR, bx - ScR) ' angle ball to center
        bx = ScR + (ScR - br) * Cos(ba): by = ScR + (ScR - br) * Sin(ba)
        ba = ba - _Pi
        bs = bs - 5 * Gravity
        If bs < Gravity Then bs = Gravity
        bdx = bs * Cos(ba): bdy = bs * Sin(ba)
        bx = bx + bdx: by = by + bdy
    End If

    '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 / 25
        Else
            bs = bs - 5 * 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 / 25
        Else
            bs = bs - 5 * 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, &HFFFF4400
        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, &HFFFF4400
        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