Pool

Update, while trying to dig down and find what is making program hang, I found a bungle in detecting collisions, as cue ball was getting them on the way to the pack on break, yikes! That's fixed but doesn't improve the hanging problem.

My theory is overlapping balls: the vector code can't handle them though sometimes I see it slow but recover with some. 

Will all be fixed if I manage to get the balls pulled apart?

Stay tuned...

Another update now with Ball images and uniform color edges, same link.

Wait membership closed there...

Option _Explicit
_Title "Pool 3 make ball images bak 2021-05-23" ' 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 smeg 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

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

   'get speed of cue  how much do I need?

   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

           'Locate 1, 1: Print i, b(i).dx, b(i).dy, "zzz "
           '_Display
           'Dim w$
           'Input "enter... "; w$

           ' this just draw the balls with arrows pointing to their headings
           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 GoTo restart
Wend

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

Sub getCueBallAngle 'get speed too
   Dim As Long i
   Dim As Double a
   _MouseHide
   mb1DownX = -1 'reset to catch a down and a up
   mb1DownY = -1
   mb1UpX = -1
   mb1UpY = -1
   CP 1, "Click for cue ball angle and speed (= line length)"

   'To Do: capture image  and redraw
   _PutImage , TableImg, 0
   CP 1, "Click for cue ball angle and speed (= line length)"
   For i = 0 To topBall
       drawBall i
   Next
   Dim temp As Long
   temp = _NewImage(_Width, _Height, 32)
   _PutImage , 0, temp
   While mb1UpX = -1
       While mb1DownX = -1
           _PutImage , temp, 0
           Line (b(0).x, b(0).y)-(mx, my), &HFFFFFFFF
           Circle (mx, my), BRad, &HFFFFFFFF
           _Display
           _Limit 200
       Wend
   Wend
   b(0).s = Sqr((my - b(0).y) ^ 2 + (mx - b(0).x) ^ 2) / 10
   If b(0).s < 1 Then b(0).s = 1
   If b(0).s > 20 Then b(0).s = 20
   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."
   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 bumperColr, feltColr
   Dim As Long i, j
   Dim As Double tl8
   bumperColr = _RGB32(10, 128, 60)
   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
   Line (txo + .75 * tl, tyo)-(txo + .75 * tl, tyo + tw), bumperColr
   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
   Line (txo + .75 * tl, tyo)-(txo + .75 * tl, tyo + tw), bumperColr ' foul line
   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, rad
   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
   ' Main code block
   'Dim Shared mx, my, mb1DownX, mb1DownY, mb1UpX, mb1UpY, oldmb1

   't1 = _FreeTimer 'get a timer number from _FREETIMER ONLY!
   'On Timer(t1, .05) PollMouse
   'Timer(t1) On
   ' signal no button locations registered yet
   'mb1DownX = -1
   'mb1DownY = -1
   'mb1UpX = -1
   'mb1UpY = -1

   Dim As Long mb1
   While _MouseInput: Wend
   mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1)
   If mb1 And oldmb1 = 0 Then
       mb1DownX = mx
       mb1DownY = my
       'mb1UpX = 0
       'mb1UpY = 0
   End If
   If mb1 = 0 And oldmb1 Then
       mb1UpX = mx
       mb1UpY = my
       'mb1DownX = 0
       'mb1DownY = 0
   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



Well good, I can assume it works in Linux, thanks for feedback.

Still some cleanup and issue of making some sort of scoring, suggestions?

Some comments are still left from original and I see DotProduct needs Double Type for consistency. 

I tried Rotozoom for stripes at any angle (like when ball rolls) but balls got fuzzy and oversized probably applied wrong source rectangle as scaling should have been a straight 1x.

Yeah, I have flicker too, which is odd because I am now using images for both the ball and table. Put that on my To Do List.

Johnno, you are describing the game of 8-Ball, a great 2 player game and I have setup the racking of balls for that game.

Having AI play... how in heaven's name would that work? Good question to stimulate the imagination, for sure!

Straight pool is about as close a game as you can get for one person, run balls (call their pockets) any order if you don't have a shot you play a safety and try to tie up cue ball behind others leave some sort of impossible shot table for opponent. When you get down to one ball left you rack the 14 balls and try to break the rack while pocketing the one free ball outside the rack to keep the run going. There are a number of rules about ways to scratch like not getting cue ball or object ball to a rail if you don't pocket a called ball.

Only a slight flicker here on Win 10.
It is fun to play.
There are so many versions of pool from country to country, so scoring is up to the coder I reckon.
"They are as many and varied as the days of Summer". A bit like basics I suppose.
Snooker is different of course.

I also notice a flicker on Ubuntu Linux.

OK along with flicker a number of other fixes and a reworked aiming of cue ball now with power bar with left and right arrow adjustment and spacebar now shoots.
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 smeg 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.
' 2021-05-26 Pool 3.1 fixes bak

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



Man I am running balls, making combo's and bank shots now!