Pool

[Jack]

hello OldMoses

was playing your latest pool game and my subconscious anger led me to max the power at 50 on all my shots, after a number of shots I saw the 14 ball roll on top side rail from right to left, I am guessing it's bug

[OldMoses]

hello OldMoses

was playing your latest pool game and my subconscious anger led me to max the power at 50 on all my shots, after a number of shots I saw the 14 ball roll on top side rail from right to left, I am guessing it's bug

Let me guess, it entered this condition after hitting a side pocket bevel and just sort of wiggled along the bumper? If so, I believe it's getting confused as to which bumper normal to take and gets out of bounds, then it just rebounds along the wall vector, zig-zagging back and forth. I've seen it several times myself.

I implemented the following dot product test and tried it with with all full power shots, so far I haven't been able to get it to walk the rail anymore.

Code: (Select All)

 'in SUB ColCheck  

'CHECK FOR BUMPER INTERSECTIONS
    FOR x% = 0 TO 17
        IF NewlineSegCirc(bmp(x%), bl(var)) = 0 THEN _CONTINUE
        IF R2_Dot(bl(var).d, bmp(x%).n) > 0 THEN _CONTINUE '<<<adding this line should stop bumper walkers

[Coolman]

Forgive me if I sound confused, chances are I am, but, what parentheses? I initially cut and pasted the listing from this site into the IDE then F5. The last time I ran it, using 3.4.0, I actually saved the game first as, 'pool.bas' then F5. I do not recall adding parentheses to any filename...

when you copy and paste a code in the editor, it is automatically renamed to :

for example Untitled(10), try to compile and you will get almost the same error message as you posted here :

https://qb64phoenix.com/forum/showthread...09#pid9109

g++ -no-pie -w -std=gnu++11 -DFREEGLUT_STATIC -I./internal/c/libqb/include -DDEPENDENCY_NO_SOCKETS -DDEPENDENCY_NO_PRINTER -DDEPENDENCY_NO_ICON -DDEPENDENCY_NO_SCREENIMAGE internal/c/qbx2.cpp -c -o internal/c/qbx2.o
objcopy -Ibinary -Oelf64-x86-64 -Bi386:x86-64 internal/temp2/data.bin internal/temp2/data.o
g++ -no-pie -w -std=gnu++11 -DFREEGLUT_STATIC -I./internal/c/libqb/include -DDEPENDENCY_NO_SOCKETS -DDEPENDENCY_NO_PRINTER -DDEPENDENCY_NO_ICON -DDEPENDENCY_NO_SCREENIMAGE ./internal/c/libqb_make_00000000000000.o ./internal/c/qbx2.o ./internal/temp2/data.o -o "untitled" ./internal/c/libqb/src/threading.o ./internal/c/libqb/src/buffer.o ./internal/c/libqb/src/filepath.o ./internal/c/libqb/src/threading-posix.o ./internal/c/parts/core/src.a -lGL -lGLU -lX11 -lpthread -ldl -lrt
objcopy --only-keep-debug "untitled" "./internal/temp2/untitled.sym"
objcopy --strip-unneeded "untitled"

[johnno56]

You are correct. At first, the compilation was performed on an unsaved (untitled) listing, and later saved and recompiled. The first displayed the error. The second displayed nothing.

Based on the current situation, I believe that the 'compillog.txt' file is 'just' that. A record of the successful compilation of the game. Successful, in the sense, that it did not produce an error. Unfortunately, it seems that the problem may be Linux based, and its apparent inability to handle QB64pe's '_DesktopWidth" and/or "_DesktopHeight".


The solution was quite crude. Instead of allowing QB64pe to determine the screen size of my monitor, I actually "hard code" the width and height of the screen and the game played correctly without error.

Regards

J

[bplus]

@johnno56

Another thing to try AFTER you save the file to avoid Untitled() thing,
put _Delay 1 before you call _DesktopWidth" and/or "_DesktopHeight".

[mnrvovrfc]

Forgive me if I sound confused, chances are I am, but, what parentheses? I initially cut and pasted the listing from this site into the IDE then F5. The last time I ran it, using 3.4.0, I actually saved the game first as, 'pool.bas' then F5. I do not recall adding parentheses to any filename...

when you copy and paste a code in the editor, it is automatically renamed to :

for example Untitled(10), try to compile and you will get almost the same error message as you posted here :

https://qb64phoenix.com/forum/showthread...09#pid9109

What got me is that there was no error actually displayed. "C++ compilation failed" has to give the reason why it failed, not just the steps that it took to create input acceptable to "g++". That was weird in itself, the "compilelog.txt" only showing those commands. If there was an error, it should have been drawn frivolously by "g++", that's why I said "squiggles and whatnot" as that compiler tries to draw attention to where it thinks it found an error, and what is the error, and maybe a suggestion how to fix it such as enabling or disabling an invoke command flag. What was even weirder was the second launch of the program which produced no "compilelog.txt" but also "did nothing". That is an easy way for someone else to lose faith in this product.

[johnno56]

@bplus

Adding the '_Delay 1' prior to setting up the screen size, on an otherwise unedited listing, did in fact work without error.

In fact, I experimented with the delay as low as _Delay 0.0007 (struggled but mostly worked) but perhaps a delay of 0.1 should be okay... After all, a 1 second delay in computer terms, is almost an eternity... lol

J

Sorry... I do not know how to insert a 'user' link...

[bplus]

Good the problem is no longer a mystery and can be overcome.

[mnrvovrfc]

Sorry... I do not know how to insert a 'user' link...

You did it right, but this forum is moody sometimes.

[bplus]

Update: This thread in this little corner of Forum is for Pool apps or WIP. You are Welcome to share code and help others build their ideal Pool Game. I am big fan of Pool, played for years and it's not as fun playing alone. b = b + others  
________________________________________________________________________________________________

Pool 3.1 fixes

Code: (Select All)

Option _Explicit
_Title "Pool 3.1 fixes" ' b+ restart 2021-05-17
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
'translated from:
' pool table.bas SmallBASIC 0.12.9 (B+=MGA) 2017-09-06
' 2021-05-17 fix stuff start with Mouse constantly poll mouse and update shared mouse variables
' add ball collision code most recently worked out.
' Thanks to OldMoses for link to collision paper with vectors.
'     https://www.vobarian.com/collisions/2dcollisions2.pdf
'  The steps in the collision code follow directly from this paper

' bak 2021-05-18 version
' 2021-05-21 fix err with finding collisions
' 2021-05-22 it's not overlap that causes the hang, before drawing balls I inserted code to pull balls overlapping apart.
' The damn thing still hangs plus now get no ball action! and why does that happen?
' (Got to wait until balls stop moving before start pulling them apart, works good now!)
' 2021-05-23 Found the hang problem!!! fixed but left balls overlapping, fixed also!
' 2021-05-23 bak Pool 2 no overlap 2021-05-23
' 2021-05-23 Pool 3 make ball images bak 2021-05-23  added for uniform edges
' 2021-05-25 fix flicker, extend aiming line so can move cue ball angle and speed setting up or down that line
' for speed and not loose the precise angle needed at kiss point.
' 2021-05-25 gutted old aim cue ball and went back to circle at end of line and added a left and right arrow
' power setting, default at medium gets you across table, max power bust rack up nice!
' See power bar below the table orange line on white background. Press spacebar to shoot now.

Const xmax = 1280
Const ymax = 740
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 80, 0

Randomize Timer
'balls
Const topBall = 15
Const BRad = 11 'ball radius 2.25"
Const BDia = BRad + BRad
'table
Const tl = 978 'table 100" for 9 foot table, adjust down for pixel ball radius
Const txo = (xmax - tl) * .5 'table x offset from left side of screen
Const tw = 489 'table 50" for 9 foot table, adjust down for pixel ball radius
Const tyo = (ymax - tw) \ 2 ' same border for 1280 wide screen
Const mt = txo + .5 * tl
'pockets
Const pw = 40 'pockey width less than 2 balls across
Const pr = 20
'rails
Const lr = txo
Const rr = txo + tl
Const tr = tyo
Const br = tyo + tw

'color
Const backColr = _RGB32(0, 94, 62)
Const bumperColr = _RGB32(10, 128, 60)
Type Ball
    As Double x, y
    As Double dx, dy, s ', z ' dx, dy = change x, y axis
    As _Unsigned Long colr
End Type
Dim Shared holeX(1 To 6), holeY(1 To 6)
Dim Shared b(topBall) As Ball, nf(topBall) As Ball
Dim Shared rack(topBall, 2)
Dim Shared BI(0 To topBall) As Long ' BallImages
Dim Shared mx, my, mb1DownX, mb1DownY, mb1UpX, mb1UpY, oldmb1 ' mouse event stuff
Dim Shared As Long TableImg
Dim Shared As Long scratch ' set in getting pocket list main, reset in BallInHand
Dim Shared As Long BallRemains ' still a ball not pocketed
Dim As Long i, j, saveJ, notDone
Dim As Double dist, minDist
Dim pocketed$ 'list balls that have been pocketed

Dim v1$, v2$, dv1$, dv2$, dv1u$, dv2u$, norm$, unitNorm$, unitTan$ 'vectors
Dim vp1n$, vp1t$, vp2n$, vp2t$ ' post collision vectors
Dim As Double v1n, v1t, v2n, v2t ' dot products
Dim As Double vp1n, vp1t, vp2n, vp2t ' post collision dot products
Dim As Double ai, aj, dxi, dyi, dxj, dyj

Dim pollTime
pollTime = _FreeTimer 'get a timer number from _FREETIMER ONLY!
On Timer(pollTime, .05) PollMouse
Timer(pollTime) On

' signal no button locations registered yet
mb1DownX = -1
mb1DownY = -1
mb1UpX = -1
mb1UpY = -1

MakeBalls
drawTable
restart:
eightBallRack
BallInHand
While 1
    If scratch Then BallInHand
    getCueBallAngle
    notDone = 1
    While notDone
        _PutImage , TableImg, 0
        CP 1, "Watch Ball Action!"
        notDone = 0
        For i = 0 To topBall ' draw balls then  update for next frame
            If b(i).x <> -1000 Then drawBall i
        Next
        CP 45, "Pocketed: " + pocketed$
        _Display
        _Limit 30
        For i = 0 To topBall
            minDist = 100000: saveJ = -1
            For j = 0 To topBall 'find deepest collision in case more than one we want earliest = deepest penetration
                If i <> j And b(i).x <> -1000 Then
                    dist = Sqr((b(i).x - b(j).x) * (b(i).x - b(j).x) + (b(i).y - b(j).y) * (b(i).y - b(j).y))
                    If dist < BDia Then ' collision but is it first or deepest collision
                        If dist < minDist Then minDist = dist: saveJ = j
                    End If
                End If
            Next
            If saveJ <> -1 Then ' found collision change ball i dx, dy   calc new course for ball i
                ''reflection  from circle  using Vectors  from JB, thanks tsh73
                v1$ = vect$(b(i).x, b(i).y) ' circle i
                v2$ = vect$(b(saveJ).x, b(saveJ).y) ' the other circle j
                dv1$ = vect$(b(i).dx, b(i).dy) ' change in velocity vector
                dv2$ = vect$(b(saveJ).dx, b(saveJ).dy)
                dv1u$ = vectUnit$(dv1$) '1 pixel
                dv2u$ = vectUnit$(dv2$)

                ' Here is the place where code hangs, make sure at least 1 vector has a decent length to change
                If vectLen(dv1u$) > .00001 Or vectLen(dv2u$) > .00001 Then
                    Do ' this should back up the balls to kiss point thanks tsh73
                        v1$ = vectSub$(v1$, dv1u$)
                        v2$ = vectSub(v2$, dv2u$)
                    Loop While vectLen(vectSub$(v1$, v2$)) < BDia 'back up our circle i to point on kiss
                End If

                ''now, get reflection speed
                ''radius to radius, norm is
                norm$ = vectSub$(v1$, v2$) ' this to this worked without all between from that collision paper
                '  step 1 unit norm and tangent
                unitNorm$ = vectUnit$(norm$)
                unitTan$ = vect$(-vectY(unitNorm$), vectX(unitNorm$))
                ' step 2 v$ and cv$ are 2 ball vectors (locations)  done already
                ' step 3 dot products before collision projecting onto normal and tangent vectors
                v1n = vectDotProduct(dv1$, unitNorm$)
                v1t = vectDotProduct(dv1$, unitTan$)
                v2n = vectDotProduct(dv2$, unitNorm$)
                v2t = vectDotProduct(dv2$, unitTan$)
                ' step 4 simplest  post collision dot products
                vp1t = v1t
                vp2t = v2t
                ' step 5  simplified by m = 1 for both balls just swap the numbers
                vp1n = v2n
                vp2n = v1n
                ' step 6  vp vectors mult the n, t numbers by unit vectors
                vp1n$ = vectScale$(vp1n, unitNorm$)
                vp1t$ = vectScale$(vp1t, unitTan$)
                vp2n$ = vectScale$(vp2n, unitNorm$)
                vp2t$ = vectScale$(vp2t, unitTan$)
                'step  7  add the 2 vectors n and t
                dv1$ = vectAdd$(vp1n$, vp1t$)

                ' store in next frame array
                nf(i).dx = vectX(dv1$)
                nf(i).dy = vectY(dv1$)
            Else ' no collision
                nf(i).dx = b(i).dx
                nf(i).dy = b(i).dy
            End If
            'update location of ball next frame
            If b(i).x <> -1000 Then
                nf(i).x = b(i).x + nf(i).dx
                nf(i).y = b(i).y + nf(i).dy
            Else
                nf(i).x = -1000: nf(i).y = -1000
            End If
            ' check in bounds next frame
            If nf(i).x <> -1000 Then
                If nf(i).x < lr + BRad Then
                    If nf(i).y > tr + 28 And nf(i).y < br - 28 Then
                        nf(i).dx = -nf(i).dx: nf(i).x = lr + BRad
                    Else
                        nf(i).x = -1000: nf(i).y = -1000: nf(i).dx = 0: nf(i).dy = 0: GoTo skip 'pocketed
                    End If
                End If

                If nf(i).x > rr - BRad Then
                    If nf(i).y > tr + 28 And nf(i).y < br - 28 Then
                        nf(i).dx = -nf(i).dx: nf(i).x = rr - BRad
                    Else
                        nf(i).x = -1000: nf(i).y = -1000: nf(i).dx = 0: nf(i).dy = 0: GoTo skip 'pocketed
                    End If
                End If

                If nf(i).y < tr + BRad Then
                    If (nf(i).x > lr + 28 And nf(i).x < mt - 40) Or (nf(i).x > mt + 40 And nf(i).x < rr - 28) Then
                        nf(i).dy = -nf(i).dy: nf(i).y = tr + BRad
                    Else
                        nf(i).x = -1000: nf(i).y = -1000: nf(i).dx = 0: nf(i).dy = 0: GoTo skip 'pocketed
                    End If
                End If

                If nf(i).y > br - BRad Then
                    If (nf(i).x > lr + 28 And nf(i).x < mt - 40) Or (nf(i).x > mt + 40 And nf(i).x < rr - 28) Then
                        nf(i).dy = -nf(i).dy: nf(i).y = br - BRad
                    Else
                        nf(i).x = -1000: nf(i).y = -1000: nf(i).dx = 0: nf(i).dy = 0: GoTo skip 'pocketed
                    End If
                End If
            End If
            skip:
        Next

        ''now that we've gone through all old locations update b() with nf() data
        pocketed$ = ""
        BallRemains = 0
        For i = 0 To topBall
            b(i).x = nf(i).x: b(i).y = nf(i).y
            b(i).dx = .99 * nf(i).dx: b(i).dy = .99 * nf(i).dy

            If b(i).dy * b(i).dy + b(i).dx * b(i).dx < .5 Then
                b(i).dx = 0: b(i).dy = 0
            Else
                notDone = 1
            End If
            If b(i).x = -1000 Then
                If i = 0 Then scratch = -1
                If Len(pocketed$) Then pocketed$ = pocketed$ + ", " + _Trim$(Str$(i)) Else pocketed$ = _Trim$(Str$(i))
            Else
                If i <> 0 Then BallRemains = -1
            End If
        Next
        If notDone = 0 Then 'separate overlapping balls now that they've stopped moving
            doAgain:
            For i = 1 To topBall 'separate overlapping balls
                If b(i).x <> -1000 Then
                    For j = i + 1 To topBall
                        If b(j).x <> -1000 Then
                            If Sqr((b(i).x - b(j).x) ^ 2 + (b(i).y - b(j).y) ^ 2) < BDia Then 'separate and start over
                                ai = _Atan2(b(i).y - b(j).y, b(i).x - b(j).x)
                                aj = _Atan2(b(j).y - b(i).y, b(j).x - b(i).x)
                                'update new dx, dy for i and j balls
                                dxi = Cos(ai)
                                dyi = Sin(ai)
                                dxj = Cos(aj)
                                dyj = Sin(aj)
                                b(i).x = b(i).x + dxi
                                b(i).y = b(i).y + dyi
                                b(j).x = b(j).x + dxj
                                b(j).y = b(j).y + dyj
                                GoTo doAgain:
                            End If
                        End If
                    Next
                End If
            Next
        End If

    Wend
    If BallRemains = 0 Then
        _PutImage , TableImg, 0
        CP 1, "Rack 'em!"
        _Display
        _Delay 1
        GoTo restart
    End If
Wend

Function rand% (lo%, hi%)
    rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function

Sub getCueBallAngle 'get speed too
    Dim As Long i, kh
    Dim As Double a, s
    _MouseHide
    s = 13
    _PutImage , TableImg, 0
    CP 1, "Set angle with mouse, set power with left or right arrows, shoot with spacebar."
    Line (txo, tyo + tw + 90)-(txo + tl, tyo + tw + 90 + 10), &HFFFFFFFF, BF
    For i = 0 To topBall
        drawBall i
    Next
    Dim temp As Long
    temp = _NewImage(_Width, _Height, 32)
    _PutImage , 0, temp
    Do
        _PutImage , temp, 0
        kh = _KeyHit
        If kh = 19712 Then 'right arrow move cx,cy down line
            s = s + 1
            If s > 26 Then s = 26
        End If
        If kh = 19200 Then 'left arrow move cx,cy down line
            s = s - 1
            If s < 1 Then s = 1
        End If
        ' angle line
        Line (b(0).x, b(0).y)-(mx, my), &HFFFFFFFF
        Circle (mx, my), BRad, &HFFFFFFFF
        ' power box
        Line (txo, tyo + tw + 90 + 2)-(txo + s * tl / 26, tyo + tw + 90 + 8), &HFFFF9900, BF
        _Display
        _Limit 200
    Loop Until kh = 32
    b(0).s = s
    a = _Atan2(my - b(0).y, mx - b(0).x)
    b(0).dx = b(0).s * Cos(a)
    b(0).dy = b(0).s * Sin(a)
    _MouseShow
    _FreeImage temp
End Sub

Sub BallInHand
    CP 1, "Ball 'in hand' behind table head line, click place for cue ball."
    Line (txo + .75 * tl, tyo)-(txo + .75 * tl, tyo + tw), bumperColr ' foul line
    _Display
    mb1DownX = -1 'reset to catch a down and a up
    mb1DownY = -1
    mb1UpX = -1
    mb1UpY = -1
    While mb1UpX = -1 'wait for click
    Wend
    b(0).x = mx: b(0).y = my ' assign cue ball
    drawBall 0
    scratch = 0
    _Display
End Sub

Sub eightBallRack
    Dim As Double xoff, yoff, spacer, i, b, xx, yy, rndB, saveI
    xoff = txo + .25 * tl
    yoff = tyo + .5 * tw
    spacer = BRad * 2 '
    b = 1
    For xx = 0 To 4
        For yy = 0 To xx
            b(b).x = xoff - spacer * (xx)
            b(b).y = yoff - .5 * spacer * xx + yy * spacer
            rack(b, 0) = b(b).x: rack(b, 1) = b(b).y
            b = b + 1
        Next
    Next
    Dim shuff(topBall)
    For i = 1 To topBall
        shuff(i) = i
    Next
    For i = topBall To 2 Step -1
        rndB = rand(1, i)
        Swap shuff(i), shuff(rndB)
    Next
    For i = 1 To topBall
        If shuff(i) = 8 Then saveI = i
        'b(i).z = _R2D(Rnd * 2 * _Pi)
    Next
    Swap shuff(saveI), shuff(5)
    For i = 1 To topBall
        b(shuff(i)).x = rack(i, 0)
        b(shuff(i)).y = rack(i, 1)
        drawBall shuff(i)
    Next
    _Display
End Sub

Sub drawTable
    Dim As _Unsigned Long feltColr
    Dim As Long i, j
    Dim As Double tl8

    feltColr = _RGB32(0, 118, 50)
    holeX(1) = txo - BRad: holeY(1) = tyo - BRad
    holeX(2) = txo + tw: holeY(2) = tyo + -1.5 * BRad
    holeX(3) = txo + tl + BRad: holeY(3) = tyo - BRad
    holeX(4) = txo - BRad: holeY(4) = tyo + tw + BRad
    holeX(5) = txo + tw: holeY(5) = tyo + tw + 1.5 * BRad
    holeX(6) = txo + tl + BRad: holeY(6) = tyo + tw + BRad
    TableImg = _NewImage(_Width, _Height, 32)
    Color &HFF000088, backColr
    Cls
    For i = 60 To 1 Step -1
        Line (txo - i, tyo - i)-(rr + i, br + i), _RGB32(100 - .9 * i, 55 - .7 * i, 50 - .5 * i), BF
    Next
    Line (txo - BRad, tyo - BRad)-(rr + BRad, br + BRad), bumperColr, BF
    Color feltColr
    Line (txo, tyo)-(rr, br), feltColr, BF
    tLine holeX(1), holeY(1), holeX(5), holeY(5), pw - 1 'drill pockets into wood
    tLine holeX(2), holeY(2), holeX(4), holeY(4), pw - 1
    tLine holeX(2), holeY(2), holeX(6), holeY(6), pw - 1
    tLine holeX(5), holeY(5), holeX(3), holeY(3), pw - 1
    tl8 = tl / 8
    Color &HFFFFFFFF
    For i = 1 To 7
        fcirc txo + i * tl8, tyo - 30, 3
        fcirc txo + i * tl8, tyo + tw + 30, 3
    Next
    For i = 1 To 3
        fcirc txo - 30, tyo + i * tl8, 3
        fcirc txo + tl + 30, tyo + i * tl8, 3
    Next
    For i = 1 To 6
        Color &HFF000000
        If i <> 2 And i <> 5 Then
            For j = 0 To 7
                Select Case i ' move hole to last location
                    Case 1: fcirc holeX(i) + j, holeY(i) + j, 20
                    Case 3: fcirc holeX(i) - j, holeY(i) + j, 20
                    Case 4: fcirc holeX(i) + j, holeY(i) - j, 20
                    Case 6: fcirc holeX(i) - j, holeY(i) - j, 20
                End Select
            Next
        Else
            fcirc holeX(i), holeY(i), 20
        End If
    Next
    'move corner holes
    holeX(1) = holeX(1) + 7: holeY(1) = holeY(1) + 7
    holeX(3) = holeX(3) - 7: holeY(1) = holeY(3) + 7
    holeX(4) = holeX(4) + 7: holeY(1) = holeY(4) - 7
    holeX(6) = holeX(6) - 7: holeY(1) = holeY(6) - 7
    'aiming diamond
    _Display
    _PutImage , 0, TableImg
End Sub

Sub tLine (x1, y1, x2, y2, rThick)
    Dim stepx, stepy, dx, dy
    Dim As Long length, i
    'x1, y1 is one endpoint of line
    'x2, y2 is the other endpoint of the line
    'rThick is the radius of the tiny circles that will be drawn
    '   from one end point to the other to create the thick line
    'Yes, the line will then extend beyond the endpoints with circular ends.
    'local length, stepx, stepy, dx, dy, i
    rThick = Int(rThick / 2): stepx = x2 - x1: stepy = y2 - y1
    length = Int((stepx ^ 2 + stepy ^ 2) ^ .5)
    If length Then
        dx = stepx / length: dy = stepy / length
        For i = 0 To length
            fcirc x1 + dx * i, y1 + dy * i, rThick
        Next
    Else
        fcirc x1, y1, rThick
    End If
End Sub

Sub drawBall (idx)
    _PutImage (b(idx).x - BRad, b(idx).y - BRad)-Step(BDia, BDia), BI(idx), 0
End Sub

Sub MakeBalls 'image
    Dim As Integer r, g, b
    Dim As Long i, x1, y1, x2, y2
    Dim ra
    For i = 0 To topBall
        BI(i) = _NewImage(BRad * 2 + 2, BRad * 2 + 2, 32)
        Select Case i
            Case 0: r = 255: g = 255: b = 255
            Case 1, 9: r = 255: g = 255: b = 0
            Case 2, 10: r = 0: g = 0: b = 255
            Case 3, 11: r = 180: g = 0: b = 0
            Case 4, 12: r = 60: g = 60: b = 140
            Case 5, 13: r = 255: g = 120: b = 0
            Case 6, 14: r = 0: g = 100: b = 0
            Case 7, 15: r = 180: g = 0: b = 100
            Case 8: r = 40: g = 40: b = 40
        End Select
        'For rad = BRad To 0 Step -1
        If i < 9 Then
            Color _RGB32(r, g, b)
            fcirc BRad + 1, BRad + 1, BRad
        Else
            Color _RGB32(235, 235, 235)
            fcirc BRad + 1, BRad + 1, BRad
        End If
        Circle (BRad + 1, BRad + 1), BRad, _RGB32(200, 200, 200)
        'Next

        If i > 8 Then
            ra = Int(Rnd * 360)

            x1 = BRad + 1 + BRad * Cos(_D2R(ra + 20)): y1 = BRad + 1 + BRad * Sin(_D2R(ra + 20))
            x2 = BRad + 1 + BRad * Cos(_D2R(ra + 180 - 20)): y2 = BRad + 1 + BRad * Sin(_D2R(ra + 180 - 20))
            Line (x1, y1)-(x2, y2), _RGB32(200, 200, 200)
            x1 = BRad + 1 + BRad * Cos(_D2R(ra - 20)): y1 = BRad + 1 + BRad * Sin(_D2R(ra - 20))
            x2 = BRad + 1 + BRad * Cos(_D2R(ra + 180 + 20)): y2 = BRad + 1 + BRad * Sin(_D2R(ra + 180 + 20))
            Line (x1, y1)-(x2, y2), _RGB32(200, 200, 200)

            Paint (BRad + 1, BRad + 1), _RGB32(r, g, b), _RGB32(200, 200, 200)
        End If
        _PutImage , 0, BI(i), (1, 1)-Step(BDia, BDia)
    Next
End Sub

Sub CP (lineNumber, mess$)
    Dim As Long ttw, tth
    ttw = 8: tth = 16
    Line (0, tth * lineNumber)-(xmax, tth * lineNumber + tth), backColr, BF
    Color _RGB32(255, 255, 255), _RGB32(0, 94, 62)
    _PrintString ((xmax - ttw * Len(mess$)) / 2, tth * lineNumber), mess$
    '_Display
End Sub

'Steve McNeil's  copied from his forum   note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
    Dim subRadius As Long, RadiusError As Long
    Dim X As Long, Y As Long

    subRadius = Abs(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    If subRadius = 0 Then PSet (CX, CY): Exit Sub

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    Line (CX - X, CY)-(CX + X, CY), , BF

    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    Wend
End Sub

Sub PollMouse ' catch locations of mouse button 1 down and up
    Dim As Long mb1
    While _MouseInput: Wend
    mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1)
    If mb1 And oldmb1 = 0 Then
        mb1DownX = mx
        mb1DownY = my
    End If
    If mb1 = 0 And oldmb1 Then
        mb1UpX = mx
        mb1UpY = my
    End If
    oldmb1 = mb1
End Sub

Function vect$ (x, y) ' convert x, y to string for passing vectors with Functions
    vect$ = _Trim$(Str$(x)) + "," + _Trim$(Str$(y))
End Function

Function vectX# (v$)
    vectX# = Val(LeftOf$(v$, ","))
End Function

Function vectY# (v$)
    vectY# = Val(RightOf$(v$, ","))
End Function

Function vectLen# (v$)
    Dim As Double x, y
    x = Val(LeftOf$(v$, ","))
    y = Val(RightOf$(v$, ","))
    vectLen# = Sqr(x * x + y * y)
End Function

Function vectUnit$ (v$) ' fix possible 0 that might hang
    Dim As Double x, y, vl
    x = Val(LeftOf$(v$, ","))
    y = Val(RightOf$(v$, ","))
    vl = Sqr(x * x + y * y)
    If vl <> 0 Then vectUnit$ = vect$(x / vl, y / vl) Else vectUnit$ = vect$(x, y)
End Function

Function vectAdd$ (v1$, v2$)
    Dim As Double x1, y1, x2, y2
    x1 = Val(LeftOf$(v1$, ","))
    y1 = Val(RightOf$(v1$, ","))
    x2 = Val(LeftOf$(v2$, ","))
    y2 = Val(RightOf$(v2$, ","))
    vectAdd$ = vect$(x1 + x2, y1 + y2)
End Function

Function vectSub$ (v1$, v2$)
    Dim As Double x1, y1, x2, y2
    x1 = Val(LeftOf$(v1$, ","))
    y1 = Val(RightOf$(v1$, ","))
    x2 = Val(LeftOf$(v2$, ","))
    y2 = Val(RightOf$(v2$, ","))
    vectSub$ = vect$(x1 - x2, y1 - y2)
End Function

Function vectDotProduct# (v1$, v2$)
    Dim As Double x1, y1, x2, y2
    x1 = Val(LeftOf$(v1$, ","))
    y1 = Val(RightOf$(v1$, ","))
    x2 = Val(LeftOf$(v2$, ","))
    y2 = Val(RightOf$(v2$, ","))
    vectDotProduct# = x1 * x2 + y1 * y2
End Function

Function vectScale$ (a, v$) 'a * vector v$
    Dim As Double x, y
    x = Val(LeftOf$(v$, ","))
    y = Val(RightOf$(v$, ","))
    vectScale$ = vect$(a * x, a * y)
End Function

Function vectTangent$ (v$, base$)
    Dim n$
    n$ = vectUnit$(base$)
    vectTangent$ = vectScale$(vectDotProduct(n$, v$), n$)
End Function

Function vectNorm$ (v$, base$)
    vectNorm$ = vectSub$(v$, vectTangent$(v$, base$))
End Function

' update these 2 in case of$ is not found! 2021-02-13
Function LeftOf$ (source$, of$)
    If InStr(source$, of$) > 0 Then LeftOf$ = Mid$(source$, 1, InStr(source$, of$) - 1) Else LeftOf$ = source$
End Function

' update these 2 in case of$ is not found! 2021-02-13
Function RightOf$ (source$, of$)
    If InStr(source$, of$) > 0 Then RightOf$ = Mid$(source$, InStr(source$, of$) + Len(of$)) Else RightOf$ = ""
End Function

For Dimster and again thanks to OldMoses for pointing to a paper upon which collision code here is based.

Dang it! Starting with version QB64pe 3.13.1, this game hangs my whole system, can't even click in the cue ball to start play THEN I need Windows Task Master to shut the thing down!