Pool

[OldMoses]

I'm thinking the addition of a cue stick graphic will help make the interface a little more intuitive. As the power is ramped up the cue will back away from the ball. It only appears once the power is set beyond zero, and backs away from the cue ball proportional to the power setting. I feel that it gives a much more instant visual of the shot orientation than a couple of lines did. Originally, I though I could make the cue stick a hardware image too, but I discovered that hardware images don't play well with _MAPTRIANGLE in Rotozoom3. Since I made the balls hardware images too, that sort of backs me into a corner as far as doing rolling effects. Not that I'd have a clue how to.

And I sort of broke my rule of no trig by resorting to _ATAN2 to pass the cue stick angle to Rotozoom. I must go and do penance...

I commented out the blue dashed ball path line just to see how it felt without it, but left it in the code {line 212} for those who desire it. 

The ghost ball remains since it's just too damn useful for aiming and checking shot possibilities.

Code: (Select All)

$COLOR:32
'$CONSOLE
_DISPLAYORDER _HARDWARE , _SOFTWARE

TYPE V2
    x AS SINGLE
    y AS SINGLE
END TYPE

TYPE ball
    sunk AS _BYTE '                                             has ball been sunk true/false
    c AS _UNSIGNED LONG '                                       ball color
    p AS V2 '                                                   position vector
    d AS V2 '                                                   direction vector
    n AS V2 '                                                   normalized direction vector
    r AS _BYTE '                                                rack position
END TYPE

TYPE hole '                                                     pockets
    p AS V2 '                                                   position
    r AS INTEGER '                                              radius
END TYPE

TYPE Bump '                                                     bumper vectors
    v AS V2
    n AS V2
    s AS V2
    e AS V2
    m AS V2
    l AS SINGLE
END TYPE

DIM SHARED xtable AS INTEGER '                                  x & y limits of screen/table
DIM SHARED ytable AS INTEGER
DIM SHARED xt5 AS INTEGER '                                     table border depth (5% of xtable)
DIM SHARED bsiz AS INTEGER '                                    radius of ball
DIM SHARED bsiz2 AS INTEGER '                                   ball diameter or sphere of contact
DIM SHARED bmpthk AS INTEGER '                                  bumper thickness
DIM SHARED bl(15) AS ball '                                     ball data
DIM SHARED hl(5) AS hole '                                      pockets (6)
DIM SHARED bmp(18) AS Bump '                                    bumper vectors
DIM SHARED bnum(15) AS LONG '                                   ball image handles
DIM SHARED tbl AS LONG '                                        table image handle
DIM SHARED cue& '                                               cue image handle
DIM SHARED origin AS V2 '                                       zero vector
DIM AS V2 path, pst, foot, spot, cueline
'DIM AS V2 grab
DIM maxstrk AS INTEGER
DIM SHARED AS INTEGER Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY

origin.x = 0: origin.y = 0

maxstrk = 50
scratch = -1

'Set the table size
IF _DESKTOPWIDTH > _DESKTOPHEIGHT * 1.6 THEN
    xtable = _DESKTOPWIDTH - 100: ytable = xtable / 2
ELSE
    ytable = _DESKTOPHEIGHT - 80: xtable = ytable * 2
END IF

foot.x = xtable / 4: foot.y = ytable / 2
bsiz = INT(((xtable / 118.1102) * 2.375) / 2) '                 size balls to table (radius)
bmpthk = INT(bsiz * 1.25) '                                     bumper 5/8 of ball diameter
bsiz2 = bsiz * 2 '                                              ball diameter/2 ball contact surface
xt5 = xtable * .05 '                                            5% setback of play surface from display

RANDOMIZE TIMER
RESTORE hue
FOR x = 0 TO 15 '                                               get ball main colors
    READ bl(x).c
NEXT x

_TITLE "OldMoses' Hustle"
SCREEN _NEWIMAGE(xtable, ytable, 32)
DO: LOOP UNTIL _SCREENEXISTS
MakeTable
Bump_Vectors
Pockets
MakeBalls
MakeCue
RackEmUp

_SCREENMOVE 5, 5

DO
    CLS , &H00000000 '                                          Thanks to Gets for this solution to the hardware overlay bug
    _PUTIMAGE , tbl '                                           overlay table
    'Draw_Vecs '                                                 checking vector form and position
    FOR x% = 0 TO 15 '                                          overlay balls
        'if ball leaves table
        spot = foot
        IF ABS(xtable / 2 - bl(x%).p.x) > xtable / 2 OR ABS(ytable / 2 - bl(x%).p.y) > ytable / 2 THEN
            IF x% = 0 THEN
                scratch = -1
            ELSE
                Respot x%, spot '                               spot object ball at or near foot
            END IF
            bl(x%).d = origin
        END IF
        IF bl(x%).sunk THEN
            bl(x%).d = origin '                                 stop ball motion
            IF x% = 0 THEN '                                    scratched the cueball
                scratch = -1
                bl(0).sunk = 0 '                                re-spot the cueball
            ELSE
                _PUTIMAGE (x% * bsiz2, ytable - bsiz2 - 5), bnum(x%) 'place sunk ball in tray
                _CONTINUE '                                     ball already off the table
            END IF
        END IF
        R2_Add bl(x%).p, bl(x%).d, 1 '                          Move the ball
        R2_Mult bl(x%).d, .995 '                                 Apply some rolling friction
        IF PyT(origin, bl(x%).d) < .1 THEN bl(x%).d = origin ' stop infinite creep of slowing balls
        ColCheck x%
        IF scratch AND x% = 0 THEN _CONTINUE
        _PUTIMAGE (INT(bl(x%).p.x) - _SHR(CINT(_WIDTH(bnum(x%))), 1), INT(bl(x%).p.y) - _SHR(CINT(_HEIGHT(bnum(x%))), 1)), bnum(x%)
    NEXT x%

    'MOUSE OPS
    ms = MBS%
    IF ms AND 1 THEN
        ClearMB 1
        'IF su = 0 AND _MOUSEY > ytable - xt5 THEN
        'ELSE
        IF scratch THEN '                                       left click cue ball placing code
            IF NOT StillMoving THEN
                bl(0).p.x = Limit%(MinOf%(_MOUSEX, INT(xtable * .75)), xtable - xt5)
                bl(0).p.y = Limit%(MinOf%(_MOUSEY, xt5), ytable - xt5)
                scratch = NOT scratch
            END IF
        ELSE '                                                  shoot the cueball
            IF NOT StillMoving THEN
                bl(0).d.x = bl(0).p.x - _MOUSEX '                   get the cue strike vector
                bl(0).d.y = bl(0).p.y - _MOUSEY
                R2_Norm bl(0).d, bl(0).d, su
                DO UNTIL NOT _MOUSEBUTTON(1) '                      prevents cue thrusting,
                    WHILE _MOUSEINPUT: WEND '                       i.e. constant acceleration across table
                LOOP '                                              while holding down mouse button
                su = 0 '                                            reset strike units
            END IF
        END IF
        'END IF
    END IF
    IF ms AND 2 THEN '                                          if mouse right button reset the rack
        ClearMB 2
        Dialog_Box "Are you sure you wish to re-rack? Y/N", 350, 200, 200, Red, White
        _DISPLAY
        IF Key_In%(32, ytable / 2 - 16, 250, "", "YN") = 1 THEN
            scratch = -1
            BallStop '                                              all displacements to = origin
            bl(0).p.y = INT(ytable * .5)
            bl(0).p.x = INT(xtable * .75)
            RackEmUp
        END IF
    END IF
    IF ms AND 4 THEN '                                          if mouse center button, set full strike
        ClearMB 3
        IF ABS(su) <> ABS(maxstrk) THEN
            su = SGN(su) * maxstrk
        ELSE
            su = -su
        END IF
    END IF
    'IF ms AND 64 THEN 'Obviously I do not yet understand how Steve's mouse hold works
    '    'grab and drag a ball code here
    '    grab.x = Mouse_StartX
    '    grab.y = Mouse_StartY
    '    FOR x% = 0 TO 15
    '        IF PyT(grab, bl(x%).p) < bsiz THEN grb% = x%
    '    NEXT x%
    '    bl(grb%).p.x = Mouse_EndX
    '    bl(grb%).p.y = Mouse_EndY
    'END IF
    IF ms AND 512 THEN '                                        roll mousewheel back, accelerate away from mouse cursor
        su = Limit%(maxstrk, su + 1) '                               like pulling back a pinball spring
    END IF
    IF ms AND 1024 THEN '                                       roll mousewheel frw'd, accelerate towards mouse cursor
        su = su + 1 * (su > -maxstrk) '                              helpful in aiming from table edge
    END IF

    'AIMING AIDS
    IF NOT StillMoving THEN '                                   AIMING BLOCK WHEN ALL STOPPED
        IF scratch THEN
            Xscr% = Limit%(MinOf%(_MOUSEX, INT(xtable * .75)), xtable - xt5)
            Yscr% = Limit%(MinOf%(_MOUSEY, xt5), ytable - xt5)
            _PUTIMAGE (Xscr% - _SHR(CINT(_WIDTH(bnum(0))), 1), Yscr% - _SHR(CINT(_HEIGHT(bnum(0))), 1)), bnum(0)
        ELSE
            outcol& = Blue
            incol& = White
            path.x = CINT(bl(0).p.x) - _MOUSEX
            path.y = CINT(bl(0).p.y) - _MOUSEY
            R2_Norm path, path, SGN(su) '                           set path direction, mouse relative
            in% = 0: u% = 0 '                                       reset loop controls
            DO
                u% = u% + 1 '                                       increment unit vector multiplier
                pst = bl(0).p '                                     start pst at cue
                R2_Norm path, path, u% '                            grow path vector * u%
                R2_Add pst, path, 1 '                               Add (path * u%) to pst
                FOR x% = 1 TO 15 '                                  iterate through balls
                    IF bl(x%).sunk THEN _CONTINUE
                    IF PyT(bl(x%).p, pst) <= bsiz2 THEN
                        CIRCLE (pst.x, pst.y), bsiz '               place target ghost
                        in% = -1: EXIT FOR
                    END IF
                NEXT x%
            LOOP UNTIL in% OR u% > xtable '                         loop until ghost placed or beyond table
            IF su THEN
                R2_Norm cueline, path, -_WIDTH(cue&) / 2 - (bsiz2 + ABS(su) * 2) '* 2
                RotoZoom3 CINT(bl(0).p.x) + cueline.x, CINT(bl(0).p.y) + cueline.y, cue&, 1, 1, _ATAN2(cueline.y, cueline.x) 'radianRotation?
            END IF
            'LINE (CINT(bl(0).p.x), CINT(bl(0).p.y))-(CINT(bl(0).p.x) + path.x, CINT(bl(0).p.y) + path.y), outcol&, , &HF0F0 'path line
            _PRINTSTRING (bl(0).p.x - 8, bl(0).p.y - 8), STR$(su)
        END IF
    END IF
    IF scratch THEN
        IF NOT StillMoving THEN
            _PRINTSTRING (xtable * .75, ytable - (xt5 / 2)), "BALL IN HAND"
        ELSE
            _PRINTSTRING (xtable * .75, ytable - (xt5 / 2)), "SCRATCH"
        END IF
    ELSE
        IF NOT StillMoving THEN
            _PRINTSTRING (xtable * .75, ytable - (xt5 / 2)), "SHOOTING" '+ " " + STR$(grab.x) + " " + STR$(grab.y)
        END IF
    END IF
    _DISPLAY
    _LIMIT 100
LOOP UNTIL _KEYDOWN(27)

END ' Care to make a friendly little wager on the next game?

'                                                               DATA SECTION
hue:
DATA 4294967295,4294967040,4278190335,4294901760,4286578816,4294944000,4278222848,4286578688
DATA 4278190080,4294967040,4278190335,4294901760,4286578816,4294944000,4278222848,4286578688

start:
DATA 1,2,15,14,8,3,4,6,11,13,12,7,9,10,5,0

'²²²²²²²²Handles collision geometry of two moving balls²²²²²²²²²
SUB B2BCollision (ball1 AS ball, ball2 AS ball)
    DIM AS V2 un, ut, ncomp1, ncomp2, tcomp1, tcomp2
    P2V un, ball1.p, ball2.p: R2_Norm un, un, 1 '               establish unit normal
    Ortho_Norm ut, un '                                         establish unit tangent
    R2_Norm ncomp1, un, R2_Dot(un, ball2.d) '                   normal component/exit vector/ball1
    R2_Norm tcomp1, ut, R2_Dot(ut, ball1.d) '                   tangent component/exit vector/ball1
    R2_Norm ncomp2, un, R2_Dot(un, ball1.d) '                   normal component/exit vector/ball2
    R2_Norm tcomp2, ut, R2_Dot(ut, ball2.d) '                   tangent component/exit vector/ball2
    ball1.d = ncomp1: R2_Add ball1.d, tcomp1, 1 '               add normal and tangent exit vectors/ball1
    ball2.d = ncomp2: R2_Add ball2.d, tcomp2, 1 '               add normal and tangent exit vectors/ball2
    R2_Mult ball1.d, .95 '                                      let's take 5% of energy in entropic factors
    R2_Mult ball2.d, .95
END SUB 'B2BCollision

'²²²²²²²²Cease all ball motion for rerack²²²²²²²²²²²²²²²²²²²²²²²
SUB BallStop
    FOR x = 0 TO 15
        bl(x).d = origin
    NEXT x
END SUB 'BallStop

'²²²²²²²²Create bumper vector dimensions²²²²²²²²²²²²²²²²²²²²²²²²
SUB Bump_Vectors
    '18 bumper vectors 6 straight wall and 12 pocket angles
    ball_cf% = _SHL(bsiz2, 1) / 1.415 '                         ball corner pocket size factor
    ball_sf% = bsiz2 * 1.14 '                                   ball side pocket size factor
    b_eg% = ytable - xt5 '                                      bottom edge
    t_eg% = xt5 '                                               top edge
    l_eg% = xt5 '                                               left edge
    r_eg% = xtable - xt5 '                                      right edge
    c_ln% = _SHR(xtable, 1) '                                   width center line
    elng% = b_eg% - t_eg% - 2 * ball_cf% '                      end wall length
    slng% = (r_eg% - l_eg% - 2 * ball_sf% - 2 * ball_cf%) / 2 ' side wall length
    RESTORE bmp_vectors
    FOR l2r% = 0 TO 5
        FOR vwv% = 0 TO 2
            vnum% = (l2r% * 3) + vwv%
            READ bmp(vnum%).v.x
            READ bmp(vnum%).v.y
            R2_Norm bmp(vnum%).v, bmp(vnum%).v, 1 '             normalize bumper vector
            Ortho_Norm bmp(vnum%).n, bmp(vnum%).v '             get orthogonal
            SELECT CASE vnum% MOD 3
                CASE 0 '                                        start pocket bevel vector
                    SELECT CASE l2r% MOD 6
                        CASE 0 'left end start
                            R2_Norm bmp(vnum%).v, bmp(vnum%).v, -bmpthk * 1.415: bmp(vnum%).l = Mag(bmp(vnum%).v)
                            bmp(vnum%).s.x = l_eg% + bmp(vnum%).v.x: bmp(vnum%).s.y = b_eg% - ball_cf% + bmp(vnum%).v.y
                        CASE 1 'top left start
                            R2_Norm bmp(vnum%).v, bmp(vnum%).v, -bmpthk * 1.415: bmp(vnum%).l = Mag(bmp(vnum%).v)
                            bmp(vnum%).s.x = l_eg% + ball_cf% + bmp(vnum%).v.x: bmp(vnum%).s.y = t_eg% + bmp(vnum%).v.y
                        CASE 2 'top right start
                            R2_Norm bmp(vnum%).v, bmp(vnum%).v, -bmpthk * 1.118: bmp(vnum%).l = Mag(bmp(vnum%).v)
                            bmp(vnum%).s.x = c_ln% + ball_sf% + bmp(vnum%).v.x: bmp(vnum%).s.y = t_eg% + bmp(vnum%).v.y
                        CASE 3 'right end start
                            R2_Norm bmp(vnum%).v, bmp(vnum%).v, -bmpthk * 1.415: bmp(vnum%).l = Mag(bmp(vnum%).v)
                            bmp(vnum%).s.x = r_eg% + bmp(vnum%).v.x: bmp(vnum%).s.y = t_eg% + ball_cf% + bmp(vnum%).v.y
                        CASE 4 'bottom right start
                            R2_Norm bmp(vnum%).v, bmp(vnum%).v, -bmpthk * 1.415: bmp(vnum%).l = Mag(bmp(vnum%).v)
                            bmp(vnum%).s.x = r_eg% - ball_cf% + bmp(vnum%).v.x: bmp(vnum%).s.y = b_eg% + bmp(vnum%).v.y
                        CASE 5 'bottom left start
                            R2_Norm bmp(vnum%).v, bmp(vnum%).v, -bmpthk * 1.118: bmp(vnum%).l = Mag(bmp(vnum%).v)
                            bmp(vnum%).s.x = c_ln% - ball_sf% + bmp(vnum%).v.x: bmp(vnum%).s.y = b_eg% + bmp(vnum%).v.y
                    END SELECT
                    R2_Mult bmp(vnum%).v, -1 '    invert again after finished
                    bmp(vnum%).e = bmp(vnum%).s: R2_Add bmp(vnum%).e, bmp(vnum%).v, 1
                CASE 1 '                                        straight wall vector
                    SELECT CASE l2r% MOD 6
                        CASE 0, 3: lng% = elng%
                        CASE ELSE: lng% = slng%
                    END SELECT
                    bmp(vnum%).l = lng%
                    bmp(vnum%).s.x = bmp(vnum% - 1).e.x: bmp(vnum%).s.y = bmp(vnum% - 1).e.y
                    bmp(vnum%).e = bmp(vnum%).s: R2_Add bmp(vnum%).e, bmp(vnum%).v, lng%
                CASE 2 '                                        end pocket vector
                    SELECT CASE l2r% MOD 6
                        CASE 1, 4: R2_Norm bmp(vnum%).v, bmp(vnum%).v, bmpthk * 1.118
                        CASE ELSE: R2_Norm bmp(vnum%).v, bmp(vnum%).v, bmpthk * 1.415
                    END SELECT
                    bmp(vnum%).l = Mag(bmp(vnum%).v)
                    bmp(vnum%).s = bmp(vnum% - 1).e
                    bmp(vnum%).e = bmp(vnum%).s: R2_Add bmp(vnum%).e, bmp(vnum%).v, 1
                    R2_Mult bmp(vnum%).v, 1
            END SELECT
        NEXT vwv%
    NEXT l2r%
    bmp_vectors: 'R2 direction vectors for: leading pocket bevel-straight-trailing pocket bevel
    '             corner pockets have 45 degree bevels, side pockets have 60 degree bevels
    DATA 1,-1,0,-1,-1,-1: 'left wall
    DATA 1,1,1,0,1,-2: 'top left wall
    DATA 1,2,1,0,1,-1: 'top right wall
    DATA -1,1,0,1,1,1: 'right wall
    DATA -1,-1,-1,0,-1,2: 'bottom right wall
    DATA -1,-2,-1,0,-1,1: 'bottom left wall
END SUB 'Bump_Vectors

'²²²²²²²²Clear mousebutton input queue²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB ClearMB (var AS INTEGER)
    DO
        WHILE _MOUSEINPUT: WEND
    LOOP UNTIL NOT _MOUSEBUTTON(var)
END SUB 'ClearMB

'²²²²²²²²Ball, Bumper and pocket intersections²²²²²²²²²²²²²²²²²²
SUB ColCheck (var AS INTEGER)
    DIM AS V2 reflec, un
    'CHECK FOR BALL INTERSECTIONS
    disp = _HYPOT(bl(var).d.x, bl(var).d.y) '           amount of ball movement
    FOR x = 0 TO 15 '
        IF x = var THEN _CONTINUE
        IF bl(x).sunk THEN _CONTINUE
        dist = PyT(bl(var).p, bl(x).p) '                calculate distance between var and x
        IF dist < bsiz2 THEN '                          are they closer than two radii, i.e. stuck together
            P2V un, bl(x).p, bl(var).p '                create an 'undo' vector
            R2_Norm un, un, bsiz2 - dist '              size it for overlap amount
            R2_Add bl(var).p, un, 1 '                   add it to the balls position
            'but what if a ball penetrates past the other balls center?
        END IF
        IF dist - bsiz2 < disp THEN '                   if ball x is within reach of magnitude
            disabc## = Ray_Trace##(bl(var).p, bl(var).d, bl(x).p, bsiz2)
            IF disabc## > 0 THEN '                          ray intersects ball x position
                B2BCollision bl(var), bl(x) '   USE THIS ALONE IN THE IF BLOCK FOR GOOD, BUT NOT MATHEMATICAL ACTION
                '                               BALLS WILL OFTEN DEFLECT SLIGHTLY BEFORE CONTACT
            END IF '                                        end: disabc <= 0  aka ball missed
        END IF '                                            end: dist < disp test
    NEXT x
    'CHECK FOR BUMPER INTERSECTIONS
    FOR x% = 0 TO 17
        IF NewlineSegCirc(bmp(x%), bl(var)) = 0 THEN _CONTINUE
        R2_Norm bl(var).n, bl(var).d, 1 '                       get displacement unit vector
        bk% = 0
        DO
            R2_Add bl(var).p, bl(var).n, -1 '                   backup by unit vectors, updating ball position
            bk% = bk% + 1
        LOOP UNTIL NewlineSegCirc(bmp(x%), bl(var)) = 0
        Vec_Mirror reflec, bmp(x%).n, bl(var).d '               get bisecter
        R2_Norm reflec, reflec, -bk% '                          invert & recover backed up unit vectors
        R2_Add bl(var).p, reflec, 1 '                           and add them to ball position
        m! = Mag(bl(var).d) '                                   preserve displacement magnitude
        R2_Norm bl(var).d, reflec, m! '                         set ball displacement to new angle
        'R2_Norm bl(var).d, bl(var).d, m! '                      lose energy in wall bounce (if desired)
        EXIT FOR
    NEXT x%
    'CHECK FOR POCKET INTERSECTIONS
    FOR x% = 0 TO 5
        IF PyT(bl(var).p, hl(x%).p) < hl(x%).r THEN
            bl(var).sunk = -1
        END IF
    NEXT x%
END SUB 'ColCheck

'²²²²²²²²Show an input dialog box²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB Dialog_Box (heading AS STRING, xsiz AS INTEGER, ysiz AS INTEGER, ypos AS INTEGER, bcol AS _UNSIGNED LONG, tcol AS _UNSIGNED LONG)
    'superimpose an image centered input box for various input routines
    cr& = _DEST '                                               save calling destination
    dbox& = _NEWIMAGE(xsiz, ysiz, 32) '                         define box
    _DEST dbox&
    COLOR tcol, &HFF282828 '                                    set text color with grey background
    CLS
    FOR x% = 0 TO 5 '                                           draw bounding box 6 pixels thick
        b~& = -Black * (x% < 2) - bcol * (x% >= 2) '             color=outer two black, balance bcol
        LINE (0 + x%, 0 + x%)-(xsiz - 1 - x%, ysiz - 1 - x%), b~&, B 'draw color border
    NEXT x%
    _PRINTSTRING (_SHR(xsiz, 1) - _SHL(LEN(heading), 2), 31), heading 'print heading two rows below top
    _DEST cr& '                                                 reset to calling destination
    _PUTIMAGE (_SHR(_WIDTH, 1) - _SHR(xsiz, 1), ypos), dbox& '  display box centered over calling destination image
    _FREEIMAGE dbox& '                                          clean up
END SUB 'Dialog_Box

'²²²²²²²²show bumper vectors for development²²²²²²²²²²²²²²²²²²²²
SUB Draw_Vecs
    FOR x% = 0 TO 18
        LINE (bmp(x%).s.x, bmp(x%).s.y)-(bmp(x%).e.x, bmp(x%).e.y), &HFFFF0000
    NEXT x%
END SUB 'Draw_Vecs

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB FCirc (CX AS INTEGER, CY AS INTEGER, RR AS INTEGER, C AS _UNSIGNED LONG, C2 AS _UNSIGNED LONG)
    DIM R AS INTEGER, RError AS INTEGER '                       SMcNeill's circle fill
    DIM X AS INTEGER, Y AS INTEGER
    R = ABS(RR)
    RError = -R
    X = R
    Y = 0
    IF R = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RError = RError + Y * 2 + 1
        IF RError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C2, BF 'these two need white here for 9-15 balls
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C2, BF
            END IF
            X = X - 1
            RError = RError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB 'FCirc

'²²²²²²²²Get key input of valid characters²²²²²²²²²²²²²²²²²²²²²²
FUNCTION Key_In% (mode AS INTEGER, xpos AS INTEGER, ypos AS INTEGER, prompt AS STRING, validchars AS STRING)
    IF mode AND 32 THEN
        _PRINTSTRING (xpos, ypos), prompt
    ELSE
        LOCATE ypos, xpos
        PRINT prompt;
    END IF
    DO
        inChar$ = UCASE$(INKEY$)
        charPos% = INSTR(validchars, inChar$) '                examine the input.
        okchar% = LEN(inChar$) = 1 AND charPos% <> 0
        _LIMIT 30
    LOOP UNTIL okchar% '                                        Stop looping when a valid character is received.
    Key_In% = charPos%
END FUNCTION 'Key_In

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION Limit% (lim AS INTEGER, var AS INTEGER)
    Limit% = lim - ((var - lim) * (var < lim + 1))
END FUNCTION 'Limit%

'²²²²²²²²Compute magnitude of single vector v²²²²²²²²²²²²²²²²²²²
FUNCTION Mag (v AS V2)
    Mag = _HYPOT(v.x, v.y)
END FUNCTION 'Mag

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB MakeBalls
    'create billiard ball hardware images
    'ball colors 1 yellow 2 blue 3 red 4 purple 5 orange 6 green 7 maroon 8 black
    '9 yellow/s 10 blue/s 11 red/s 12 purple/s 13 orange/s 14 green/s 15 maroon/s
    FOR x% = 0 TO 15
        tmp& = _NEWIMAGE(bsiz * 2 + 4, bsiz * 2 + 4, 32)
        _DEST tmp&
        wd% = _SHR(_WIDTH(tmp&), 1)
        ht% = _SHR(_HEIGHT(tmp&), 1)
        IF x% = 0 THEN '                                        Cue ball
            FCirc wd%, ht%, bsiz, bl(x%).c, bl(x%).c
            CIRCLE (wd%, ht%), bsiz + 1, Black
        ELSE '                                                  Solid/stripe numbered balls
            IF x% <= 8 THEN
                FCirc wd%, ht%, bsiz, bl(x%).c, bl(x%).c '      solid
            ELSE
                FCirc wd%, ht%, bsiz, bl(x%).c, White '         stripe
            END IF
            FCirc wd%, ht%, bsiz - 5, White, White '            number circle
            CIRCLE (wd%, ht%), bsiz + 1, Black '                dark outling
            n$ = _TRIM$(STR$(x%))
            t& = _NEWIMAGE(16, 16, 32)
            _DEST t&
            COLOR Black
            _PRINTMODE _KEEPBACKGROUND
            IF LEN(n$) > 1 THEN a = 0 ELSE a = 4
            _PRINTSTRING (a, 0), n$, t& '                       stamp number on ball
            _DEST tmp&
            _PUTIMAGE (8, 8)-(_WIDTH(tmp&) - 8, _HEIGHT(tmp&) - 8), t&, tmp&
            _FREEIMAGE t&
        END IF
        bnum(x%) = _COPYIMAGE(tmp&, 33)
        _FREEIMAGE tmp&
    NEXT x%
END SUB 'MakeBalls

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB MakeCue
    TYPE cueray
        s AS V2 'start
        e AS V2 'end
        v AS V2 'vector
        u AS V2 'unit vector
        g AS V2 'grip start
        t AS V2 'tip start
    END TYPE
    lg% = ytable
    wd% = INT(ytable / 56) '                                    width of cue
    widcl% = wd% / 2 - 1
    'cue colors
    shft& = SaddleBrown 'RawSienna 'Chocolate
    'shfthi& = RawSienna
    grp& = Maroon
    'grphi& = RawUmber 'SaddleBrown
    'taper vectors
    DIM AS cueray t(wd%) 'ts(wd%), te(wd%), tv(wd%), tvu(wd%)
    cue& = _NEWIMAGE(lg%, wd%, 32)
    _DEST cue&
    COLOR , &H00000000
    CLS
    FOR x% = 0 TO wd% - 1 '                                     create radiating taper vectors
        t(x%).s.x = -lg%
        t(x%).s.y = wd% / 2 - 1
        t(x%).e.x = lg% - wd% / 2
        t(x%).e.y = x%
        P2V t(x%).v, t(x%).s, t(x%).e
        R2_Norm t(x%).u, t(x%).v, 1
        t(x%).t = t(x%).s: R2_Add t(x%).t, t(x%).u, Mag(t(x%).v) * .5 + wd% / 2 + 1
        t(x%).g = t(x%).s: R2_Add t(x%).g, t(x%).u, Mag(t(x%).v) * .75
        'IF x% >= wd% - 1 AND x% <= wd% + 1 THEN
        '    s& = shfthi&: g& = grphi&
        'ELSE
        s& = shft&: g& = grp&
        'END IF
        LINE (CINT(t(x%).t.x), CINT(t(x%).t.y))-(CINT(t(x%).g.x), CINT(t(x%).g.y)), s&
        LINE (CINT(t(x%).g.x), CINT(t(x%).g.y))-(CINT(t(x%).e.x), CINT(t(x%).e.y)), g&
    NEXT x%
    LINE (widcl%, widcl% - (wd% * .25 - 1))-(widcl% + wd%, widcl% + (wd% * .25 - 1)), White, BF
    LINE (widcl%, widcl% - (wd% * .25 - 1))-(widcl% + 3, widcl% + (wd% * .25 - 1)), &HFF2F2F2F, BF
    _DEST 0
END SUB 'MakeCue

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB MakeTable
    tmp& = _COPYIMAGE(0)
    _DEST tmp&
    COLOR , &HFF007632 '                                        felt color
    CLS

    FCirc xtable * .5, xt5 / 2, bsiz2, Black, Black '                           top side pocket
    FCirc xtable * .5, ytable - xt5 / 2, bsiz2, Black, Black '                  bottom side pocket
    FCirc xt5 * .75, xt5 * .75, bsiz2 * 1.5, Black, Black '                     upper left corner pocket
    FCirc xt5 * .75, ytable - xt5 * .75, bsiz2 * 1.5, Black, Black '            lower left corner pocket
    FCirc xtable - xt5 * .75, xt5 * .75, bsiz2 * 1.5, Black, Black '            upper right corner pocket
    FCirc xtable - xt5 * .75, ytable - xt5 * .75, bsiz2 * 1.5, Black, Black '   lower right corner pocket

    FOR x% = 0 TO xt5 - bmpthk '                                outer border
        cl& = -Black * (x% < 3) - RawUmber * (x% > 2)
        IF INT(RND * 3) < 1 THEN cl& = &HFF6B572B
        LINE (x%, x%)-(xtable - x%, ytable - x%), cl&, B
    NEXT x%
    FCirc xtable * .75, ytable * .5, 5, Gray, Gray '            cue spot
    FCirc xtable * .75, ytable * .5, 2, White, White
    FCirc xtable * .25, ytable * .5, 5, Gray, Gray '            rack spot
    FCirc xtable * .25, ytable * .5, 2, White, White
    'side pocket width = bsiz * 2.28,   corner pocket width = bsiz2 * 2 throat width
    FOR d% = 0 TO 15 '                                          iterate for thickness and bevel
        'draw left then right top bumpers
        LINE (xt5 + (_SHL(bsiz2, 1) / 1.415) - d%, xt5 - d%)-(_SHR(xtable, 1) - bsiz2 * 1.14 + (d% / 2), xt5 - d%), &HFF005025
        LINE (_SHR(xtable, 1) + bsiz2 * 1.14 - (d% / 2), xt5 - d%)-(xtable - xt5 - (_SHL(bsiz2, 1) / 1.415) + d%, xt5 - d%), &HFF005025
        'draw left then right bottom bumpers
        LINE (xt5 + (_SHL(bsiz2, 1) / 1.415) - d%, ytable - xt5 + d%)-(_SHR(xtable, 1) - bsiz2 * 1.14 + (d% / 2), ytable - xt5 + d%), &HFF005025
        LINE (_SHR(xtable, 1) + bsiz2 * 1.14 - (d% / 2), ytable - xt5 + d%)-(xtable - xt5 - (_SHL(bsiz2, 1) / 1.415) + d%, ytable - xt5 + d%), &HFF005025
        'draw left then right side bumpers
        LINE (xt5 - d%, xt5 + (_SHL(bsiz2, 1) / 1.415) - d%)-(xt5 - d%, ytable - xt5 - (_SHL(bsiz2, 1) / 1.415) + d%), &HFF005025
        LINE (xtable - xt5 + d%, xt5 + (_SHL(bsiz2, 1) / 1.415) - d%)-(xtable - xt5 + d%, ytable - xt5 - (_SHL(bsiz2, 1) / 1.415) + d%), &HFF005025
    NEXT d%
    tbl = _COPYIMAGE(tmp&, 33) '                                Move to hardware image
    _FREEIMAGE tmp&
END SUB 'MakeTable

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION MBS% 'Mouse Button Status  Author: Steve McNeill
    STATIC StartTimer AS _FLOAT
    STATIC ButtonDown AS INTEGER
    CONST ClickLimit## = 0.2 'Less than 1/4th of a second to down, up a key to count as a CLICK.
    '                          Down longer counts as a HOLD event.
    'SHARED Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
    WHILE _MOUSEINPUT 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
        SELECT CASE SGN(_MOUSEWHEEL)
            CASE 1: tempMBS = tempMBS OR 512
            CASE -1: tempMBS = tempMBS OR 1024
        END SELECT
    WEND
    IF _MOUSEBUTTON(1) THEN tempMBS = tempMBS OR 1
    IF _MOUSEBUTTON(2) THEN tempMBS = tempMBS OR 2
    IF _MOUSEBUTTON(3) THEN tempMBS = tempMBS OR 4
    IF StartTimer = 0 THEN
        IF _MOUSEBUTTON(1) THEN 'If a button is pressed, start the timer to see what it does (click or hold)
            ButtonDown = 1: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(2) THEN
            ButtonDown = 2: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(3) THEN
            ButtonDown = 3: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        END IF
    ELSE
        BD = ButtonDown MOD 3
        IF BD = 0 THEN BD = 3
        IF TIMER(0.01) - StartTimer <= ClickLimit THEN 'Button was down, then up, within time limit.  It's a click
            IF _MOUSEBUTTON(BD) = 0 THEN tempMBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
        ELSE
            IF _MOUSEBUTTON(BD) = 0 THEN 'hold event has now ended
                tempMBS = 0: ButtonDown = 0: StartTimer = 0
                Mouse_EndX = _MOUSEX: Mouse_EndY = _MOUSEY
            ELSE 'We've now started the hold event
                tempMBS = tempMBS OR 32 * 2 ^ ButtonDown
            END IF
        END IF
    END IF
    MBS% = tempMBS
END FUNCTION 'MBS%

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION MinOf% (value AS INTEGER, minimum AS INTEGER)
    MinOf% = -value * (value >= minimum) - minimum * (value < minimum)
END FUNCTION

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION NewlineSegCirc (w AS Bump, b AS ball)
    'shorthand version of Bplus' lineSegIntersectCircle
    'utilizing vector math SUBs & UDTs already implemented
    DIM AS V2 d, p
    DIM AS INTEGER rtn, i
    R2_Norm d, w.v, 1 '                                         d is unit vector of wall
    FOR i = 0 TO w.l '
        p = w.s: R2_Add p, d, i '                               add i multiples to wall start position to get p
        'if p within ball radius then intersect true and leave loop
        IF _HYPOT(p.x - b.p.x, p.y - b.p.y) <= bsiz THEN rtn = NOT rtn: EXIT FOR
    NEXT
    NewlineSegCirc = rtn
END FUNCTION 'NewlineSegCirc

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB Ortho_Norm (orth AS V2, vec AS V2)
    orth.x = -vec.y: orth.y = vec.x '                           compute orthogonal
    R2_Norm orth, orth, 1 '                                     and convert it to a unit vector
END SUB 'Ortho_Norm

'²²²²²²²²Convert points st & nd to a vector v²²²²²²²²²²²²²²²²²²²
SUB P2V (v AS V2, st AS V2, nd AS V2)
    v.x = nd.x - st.x
    v.y = nd.y - st.y
END SUB 'P2V

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB Pockets
    FOR x% = 0 TO 5
        SELECT CASE x%
            CASE 0: hl(x%).p.x = xt5 * .75: hl(x%).p.y = ytable - xt5 * .75: hl(x%).r = bsiz2 * 1.5
            CASE 1: hl(x%).p.x = xt5 * .75: hl(x%).p.y = xt5 * .75: hl(x%).r = bsiz2 * 1.5
            CASE 2: hl(x%).p.x = xtable * .5: hl(x%).p.y = xt5 / 2: hl(x%).r = bsiz2
            CASE 3: hl(x%).p.x = xtable - xt5 * .75: hl(x%).p.y = xt5 * .75: hl(x%).r = bsiz2 * 1.5
            CASE 4: hl(x%).p.x = xtable - xt5 * .75: hl(x%).p.y = ytable - xt5 * .75: hl(x%).r = bsiz2 * 1.5
            CASE 5: hl(x%).p.x = xtable * .5: hl(x%).p.y = ytable - xt5 / 2: hl(x%).r = bsiz2
        END SELECT
    NEXT x%
END SUB 'Pockets

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION PyT (var1 AS V2, var2 AS V2)
    PyT = _HYPOT(ABS(var1.x - var2.x), ABS(var1.y - var2.y)) '  distances and magnitudes
END FUNCTION 'PyT

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB R2_Add (var AS V2, var2 AS V2, var3 AS INTEGER)
    var.x = var.x + (var2.x * var3) '                           add (or subtract) two vectors defined by unitpoint
    var.y = var.y + (var2.y * var3) '                           var= base vector, var2= vector to add
END SUB 'R2_Add

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION R2_Dot (var AS V2, var2 AS V2)
    R2_Dot = var.x * var2.x + var.y * var2.y '                  get dot product of var & var2
END FUNCTION 'R2_Dot

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB R2_Mult (vec AS V2, multiplier AS SINGLE)
    vec.x = vec.x * multiplier '                                multiply vector by scalar value
    vec.y = vec.y * multiplier
END SUB 'R2_Mult

'²²²²²²²²Normalize v and regrow to scalar, return in re²²²²²²²²²
SUB R2_Norm (re AS V2, v AS V2, scalar AS SINGLE)
    x! = v.x: y! = v.y '                                        preserve vector v from changes (if desired)
    m! = _HYPOT(x!, y!) '                                       compute magnitude of v
    IF m! = 0 THEN '                                            trap division by zero
        re.x = 0: re.y = 0 '                                    by returning a zero vector
    ELSE '                                                      if magnitude not zero
        re.x = (x! / m!) * scalar '                             shrink to unit vector and rescale x component
        re.y = (y! / m!) * scalar '                               "     "       "       "       " y component
    END IF
END SUB 'R2_Norm

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB RackEmUp
    yoff = bsiz2 + 4
    xoff = SQR((yoff / 2) * (yoff / 2) + yoff * yoff) - 4
    RESTORE start
    FOR rank = 1 TO 5
        FOR b = 1 TO rank
            READ k
            bl(k).sunk = 0
            bl(k).p.x = (.25 * xtable) - (xoff * (rank - 1))
            bl(k).p.y = (.5 * ytable) - ((rank - 1) * (.5 * yoff)) + ((b - 1) * yoff)
    NEXT b, rank
END SUB 'RackEmUp

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION Ray_Trace## (var1 AS V2, var2 AS V2, var3 AS V2, var4 AS _INTEGER64)
    'var1= ball initial position, var2= ball displacement, var3= target ball position, var4= strike radius
    'typical syntax: result = Ray_Trace##(bl(var).p, bl(var).d, bl(x).p, bsiz2)
    dx## = var2.x: dy## = var2.y '                              displacement of ball
    A## = (dx## * dx##) + (dy## * dy##) '                       displacement magnitude squared
    B## = 2 * dx## * (var1.x - var3.x) + 2 * dy## * (var1.y - var3.y)
    C## = (var3.x * var3.x) + (var3.y * var3.y) + (var1.x * var1.x) + (var1.y * var1.y) + -2 * (var3.x * var1.x + var3.y * var1.y) - (var4 * var4)
    Ray_Trace## = (B## * B##) - 4 * A## * C## ' if disabc## < 0 then no intersection =0 tangent >0 intersects two points
END FUNCTION 'Ray_Trace##

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB Respot (var AS INTEGER, p AS V2)
    DO
        ft_avl% = -1 '                                          innocent until proven guilty
        FOR oc% = 1 TO 15
            IF oc% = var THEN _CONTINUE
            IF PyT(p, bl(oc%).p) < bsiz THEN '                  if oc% in the way
                ft_avl% = 0
                p.x = p.x - bsiz2 '                             move back from foot
            END IF
        NEXT oc%
    LOOP UNTIL ft_avl%
    IF NOT StillMoving THEN bl(var).p = p
END SUB 'Respot

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE)
    ' This assumes you have set your drawing location with _DEST or default to screen.
    ' X, Y - is where you want to put the middle of the image
    ' Image - is the handle assigned with _LOADIMAGE
    ' xScale, yScale - are shrinkage < 1 or magnification > 1 on the given axis, 1 just uses image size.
    ' These are multipliers so .5 will create image .5 size on given axis and 2 for twice image size.
    ' radianRotation is the Angle in Radian units to rotate the image
    ' note: Radian units for rotation because it matches angle units of other Basic Trig functions
    '       and saves a little time converting from degree.
    '       Use the _D2R() function if you prefer to work in degree units for angles.

    DIM px(3) AS SINGLE: DIM py(3) AS SINGLE ' simple arrays for x, y to hold the 4 corners of image
    DIM W&, H&, sinr!, cosr!, i&, x2&, y2& '   variables for image manipulation
    W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
    px(0) = -W& / 2: py(0) = -H& / 2 'left top corner
    px(1) = -W& / 2: py(1) = H& / 2 ' left bottom corner
    px(2) = W& / 2: py(2) = H& / 2 '  right bottom
    px(3) = W& / 2: py(3) = -H& / 2 ' right top
    sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation) ' rotation helpers
    FOR i& = 0 TO 3 ' calc new point locations with rotation and zoom
        x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
        px(i&) = x2&: py(i&) = y2&
    NEXT
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB 'RotoZoom3

'²²²²²²²²Returns 0 when all balls have stopped²²²²²²²²²²²²²²²²²²
FUNCTION StillMoving
    s% = 0
    FOR x% = 0 TO 15
        IF bl(x%).d.x <> 0 THEN s% = -1
        IF bl(x%).d.y <> 0 THEN s% = -1
    NEXT x%
    StillMoving = s%
END FUNCTION 'StillMoving

'²²²²²²²²Mirror a vector {in} around a unit bisecter²²²²²²²²²²²²
SUB Vec_Mirror (re AS V2, bi AS V2, in AS V2)
    DIM t AS V2
    IF Mag(bi) <> 1 THEN '                                      if bi is not a unit vector
        R2_Norm t, bi, 1 '                                      normalize to t
    ELSE '                                                      if bi is a unit vector
        t = bi '                                                save it to t
    END IF
    R2_Norm re, t, R2_Dot(in, t) * 2
    R2_Add re, in, -1
END SUB 'Vec_Mirror