Author Topic: My first attempts at a billiards program  (Read 4728 times)

0 Members and 1 Guest are viewing this topic.

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
My first attempts at a billiards program
« on: March 22, 2020, 01:55:58 pm »
Taking a bit of a break from my usual 3D space based themes to play with 2D collision stuff, even though I am using some procedures from that sort of stuff. I always wanted a pool table, but never really had the room or funds for it.

Some aspects of this seem to work pretty good, others....eh, not so much...

I'm trying to make this work solely upon vector algorithms, without recourse to any sort of trig functions.

Rebound from the stiking ball is not acting as I think it probably should and balls will often overlap rather than bump the adjacent ball out of the way. No pockets yet, I'm just trying to get the physics and the collision limits to work correctly.

Yeah, it's definitely a work in progress, and I'm wondering if I may have to make the collision routine recursive in the case of nearby targets.

The white line from the cue ball is the angle of attack for the cue and the red line is where the ball will go. The length of the white line will determine the force applied, which of course limits the ability to hit hard near the edge of the table, but that is something yet to be worked out.

As usual <esc> will quit.

Updated 3/25/2020

Code: QB64: [Select]
  1.  
  2. 'ball colors 1 yellow 2 blue 3 red 4 purple 5 orange 6 green 7 maroon 8 black
  3. '9 yellow/s 10 blue/s 11 red/s 12 purple/s 13 orange/s 14 green/s 15 maroon/s
  4.  
  5. TYPE Vec2
  6.     x AS SINGLE
  7.     y AS SINGLE
  8.  
  9. TYPE ball
  10.     sunk AS _BYTE '                                             has ball been sunk true/false
  11.     im AS _BYTE '                                               impact register
  12.     c AS _UNSIGNED LONG '                                       ball color
  13.     p AS Vec2 '                                                 position vector
  14.     d AS Vec2 '                                                 direction vector
  15.     n AS Vec2 '                                                 normalized direction vector
  16.     s AS SINGLE '                                               speed
  17.     r AS _BYTE '                                                rack position
  18.  
  19. DIM SHARED bsiz AS INTEGER '                                    radius of ball
  20. DIM SHARED bsiz2 AS INTEGER '                                   ball diameter or sphere of contact
  21. DIM SHARED bl(15) AS ball '                                     ball data
  22. DIM SHARED bnum(15) AS LONG
  23. DIM SHARED origin AS Vec2
  24. origin.x = 0: origin.y = 0
  25.  
  26. 'Set the table size
  27.     xtable = _DESKTOPWIDTH - 100: ytable = xtable / 2
  28.     ytable = _DESKTOPHEIGHT - 80: xtable = ytable * 2
  29.  
  30. bsiz = INT(((xtable / 118.1102) * 2.375) / 2) '                 size balls to table
  31. bsiz2 = bsiz * 2
  32.  
  33. FOR x = 0 TO 15
  34.     READ bl(x).c
  35.     IF x = 0 THEN '                                             starting positions
  36.         bl(x).p.y = INT(ytable * .5)
  37.         bl(x).p.x = INT(xtable * .75)
  38.     ELSE
  39.         'DO
  40.  
  41.         '    bl(x).p.y = INT((RND(1) * (ytable - (bsiz * 2))) + bsiz)
  42.         '    bl(x).p.x = INT((RND(1) * (xtable - (bsiz * 2))) + bsiz)
  43.         '    t = 0
  44.         '    FOR y = 0 TO x - 1
  45.         '        d = ((bl(x).p.x - bl(y).p.x) ^ 2 + (bl(x).p.y - bl(y).p.y) ^ 2) ^ .5
  46.         '        IF d < bsiz * 2 THEN t = -1
  47.         '    NEXT y
  48.         'LOOP UNTIL NOT t
  49.     END IF
  50.  
  51. MakeBalls
  52. RackEmUp
  53.  
  54. a& = _NEWIMAGE(xtable, ytable, 32)
  55. shot& = _NEWIMAGE(xtable, ytable, 32)
  56. _DEST a&: SCREEN a&
  57. COLOR , &HFF3AAF61
  58. 'set up the table
  59. FOR x = 0 TO 2
  60.     LINE (x, x)-(xtable - x, ytable - x), Black, B
  61.     FCirc xtable * .75, ytable * .5, 5, Gray, Gray
  62.     FCirc xtable * .75, ytable * .5, 2, White, White
  63.     CLS
  64.     FOR x = 0 TO 15
  65.         VecAdd bl(x).p, bl(x).d, 1
  66.         VecMult bl(x).d, .99
  67.         ColCheck x
  68.         _PUTIMAGE (INT(bl(x).p.x) - CINT(_WIDTH(bnum(x)) / 2), INT(bl(x).p.y) - CINT(_HEIGHT(bnum(x)) / 2)), bnum(x), a&
  69.     NEXT x
  70.     m1 = _MOUSEBUTTON(1)
  71.     IF m1 THEN
  72.         bl(0).d.x = (bl(0).p.x - _MOUSEX) * 0.05
  73.         bl(0).d.y = (bl(0).p.y - _MOUSEY) * 0.05
  74.         'VecNorm bl(0).d: VecMult bl(0).d, 40
  75.     END IF
  76.     LINE (_MOUSEX, _MOUSEY)-(CINT(bl(0).p.x), CINT(bl(0).p.y))
  77.     'slope of target line
  78.     pathx = CINT(bl(0).p.x) - _MOUSEX: pathy = CINT(bl(0).p.y) - _MOUSEY
  79.     LINE (bl(0).p.x, bl(0).p.y)-(pathx * 1000, pathy * 1000), Blue
  80.     'LINE (bl(0).p.x, bl(0).p.y)-(-(_MOUSEX - bl(0).p.x) + bl(0).p.x, -(_MOUSEY - bl(0).p.y) + bl(0).p.y), Blue
  81.     'd = SQR(((bl(0).p.x - _MOUSEX) * 0.05) * ((bl(0).p.x - _MOUSEX) * 0.05) + ((bl(0).p.y - _MOUSEY) * 0.05) * ((bl(0).p.y - _MOUSEY) * 0.05))
  82.     '_PRINTSTRING (xtable + 4, ytable - 20), STR$(d), a&
  83.     _DISPLAY
  84.     _LIMIT 100 '100 seems good
  85.     'SLEEP
  86.  
  87.  
  88. '                                                               DATA SECTION
  89. hue:
  90. DATA 4294967295,4294967040,4278190335,4294901760,4286578816,4294944000,4278222848,4286578688
  91. DATA 4278190080,4294967040,4278190335,4294901760,4286578816,4294944000,4278222848,4286578688
  92.  
  93. start:
  94. DATA 1,2,15,14,8,3,4,6,11,13,12,7,9,10,5,0
  95.  
  96.  
  97. SUB ColCheck (var AS INTEGER)
  98.  
  99.     'check for ball in displacement radius
  100.     disp = SQR(bl(var).d.x * bl(var).d.x + bl(var).d.y * bl(var).d.y) 'vector magnitude for this iteration
  101.     FOR x = 0 TO 15
  102.         IF x <> var THEN '                                      won't collide with self so skip self check
  103.             IF NOT bl(var).sunk THEN '                          if ball not already out of play
  104.                 dist = PythXY(bl(var).p, bl(x).p) '             calculate distance between var and x
  105.                 IF dist - bsiz2 < disp THEN '                           if ball x is within reach of magnitude
  106.                     'check to see if there is an impact point-  Ray trace routine
  107.                     DIM neari AS Vec2
  108.                     DIM strike AS Vec2
  109.                     DIM strikeorth AS Vec2
  110.                     DIM striker AS Vec2
  111.                     DIM strikee AS Vec2
  112.                     DIM orthox AS Vec2
  113.                     DIM orthoy AS Vec2
  114.  
  115.                     'Using a variation of the collision routine from CTVector.bas
  116.                     'but the damn thing isn't working as envisioned...
  117.                     dx = bl(var).p.x - bl(x).p.x
  118.                     dy = bl(var).p.y - bl(x).p.y
  119.                     A## = (bl(var).d.x * bl(var).d.x) + (bl(var).d.y * bl(var).d.y) 'displacement range
  120.                     B## = 2 * bl(var).d.x * dx + 2 * bl(var).d.y * dy
  121.                     C## = (bl(x).p.x * bl(x).p.x) + (bl(x).p.y * bl(x).p.y) + (bl(var).p.x * bl(var).p.x)_
  122.                          + (bl(var).p.y * bl(var).p.y) + -2 * (bl(x).p.x * bl(var).p.x + bl(x).p.y * bl(var).p.y) - (bsiz2 * bsiz2)
  123.                     disabc## = (B## * B##) - 4 * A## * C##
  124.                     IF disabc## <= 0 THEN 'let's make this <=, since a tangent brush by would ideally not move the ball
  125.                     ELSE
  126.                         t## = (-B## - ((B## * B##) - 4 * A## * C##) ^ .5) / (2 * A##) 'near intersect quadratic gives percentage of displacement to contact
  127.                         neari.x = bl(var).p.x + t## * bl(var).d.x: neari.y = bl(var).p.y + t## * bl(var).d.y 'contact point
  128.                         'now that we have a contact point, we can proceed to deflect the displacements of var and x
  129.                         bl(var).p = neari
  130.                         '// get strike angle unit vector
  131.                         strike.x = bl(x).p.x - neari.x: strike.y = bl(x).p.y - neari.y
  132.                         '// get the two orthogonal vectors to strike
  133.                         orthox.x = -strike.y: orthox.y = strike.x
  134.                         orthoy.x = strike.y: orthoy.y = -strike.x
  135.                         '// add orthogonals to impact point
  136.                         VecAdd orthox, neari, 1: VecAdd orthoy, neari, 1
  137.                         '// add present var displacement to ortho's
  138.                         VecAdd orthox, bl(var).d, 1: VecAdd orthoy, bl(var).d, 1
  139.                         '// check distances and compare, using farthest one for striker's new vector
  140.                         vox = PythXY(orthox, bl(x).p): voy = PythXY(orthoy, bl(x).p)
  141.                         IF vox > voy THEN
  142.                             strikeorth.x = -strike.y: strikeorth.y = strike.x
  143.                         ELSEIF vox = voy THEN
  144.                             strikeorth = strike
  145.                         ELSE
  146.                             strikeorth.x = strike.y: strikeorth.y = -strike.x
  147.                         END IF
  148.                         '// normalize strike vectors
  149.                         VecNorm strike: VecNorm strikeorth
  150.  
  151.  
  152.                         striker = bl(var).d: VecNorm striker '                  get striker unit vector
  153.                         strikee = bl(x).d: VecNorm strikee '                    get strikee unit vector
  154.                         dot = striker.x * strike.x + striker.y * strike.y '     apply to struck balls displacement magnitude along strike
  155.                         dotback = 1 - dot '                                     apply to striking balls displacement along orthogonal of strike
  156.  
  157.                         'get proportion of energy transfer and add it to existing vector of unit x
  158.                         VecMult strike, 0.99 * dot * PythXY(origin, bl(var).d)
  159.                         VecAdd bl(x).d, strike, 1
  160.                         'do the same with var using balance of energy
  161.                         VecMult strikeorth, 0.99 * dotback * PythXY(origin, bl(var).d)
  162.                         'VecAdd bl(var).d, strikeorth, 1
  163.                         bl(var).d = strikeorth
  164.                         'bl(var).d.x = -bl(var).d.x: bl(var).d.y = -bl(var).d.y
  165.                     END IF 'disabc <= 0
  166.                 END IF 'dist < disp
  167.             END IF 'NOT bl(var).sunk
  168.         END IF 'x <> var
  169.     NEXT x
  170.  
  171.     'wall bounces
  172.     IF bl(var).p.x < bsiz OR bl(var).p.x > xtable - bsiz THEN
  173.         bl(var).d.x = -bl(var).d.x
  174.         IF bl(var).p.x < bsiz THEN '                            if beyond left edge
  175.             bl(var).p.y = bl(var).p.y - (bl(var).d.y * ((bl(var).p.x - bsiz) / bl(var).d.x))
  176.             bl(var).p.x = bsiz
  177.         END IF
  178.         IF bl(var).p.x > xtable - bsiz THEN '                   if beyond right edge
  179.             bl(var).p.y = bl(var).p.y - (bl(var).d.y * ((bl(var).p.x - xtable + bsiz) / bl(var).d.x))
  180.             bl(var).p.x = xtable - bsiz
  181.         END IF
  182.     END IF
  183.     IF bl(var).p.y < bsiz OR bl(var).p.y > ytable - bsiz THEN
  184.         bl(var).d.y = -bl(var).d.y
  185.         IF bl(var).p.y < bsiz THEN '                            if beyond top edge
  186.             bl(var).p.x = bl(var).p.x - (bl(var).d.x * ((bl(var).p.y - bsiz) / bl(var).d.y))
  187.             bl(var).p.y = bsiz
  188.         END IF
  189.         IF bl(var).p.y > ytable - bsiz THEN '                   if beyond bottom edge
  190.             bl(var).p.x = bl(var).p.x - (bl(var).d.x * ((bl(var).p.y - ytable + bsiz) / bl(var).d.y))
  191.             bl(var).p.y = ytable - bsiz
  192.         END IF
  193.     END IF
  194.  
  195. END SUB 'ColCheck
  196.  
  197.  
  198. SUB ColCheckold (var AS INTEGER)
  199.  
  200.     DIM strike AS Vec2
  201.     DIM strike90 AS Vec2
  202.     DIM striker AS Vec2
  203.     DIM strikee AS Vec2
  204.     striker = bl(var).d: VecNorm striker
  205.  
  206.     FOR x = 0 TO 15
  207.         IF x <> var THEN '                                      another ball?
  208.             IF NOT bl(var).sunk THEN '                          is ball on table
  209.                 d = _HYPOT(bl(var).p.x - bl(x).p.x, bl(var).p.y - bl(x).p.y)
  210.                 IF d <= bsiz * 2 THEN
  211.                     ''here's the crunchy part
  212.  
  213.                     'we must find the actual impact point, rather than the overlap at iteration point
  214.                     'maybe that will fix the sticking
  215.                     strike.x = bl(x).p.x - bl(var).p.x '        get strike angle unit vector
  216.                     strike.y = bl(x).p.y - bl(var).p.y
  217.                     VecNorm strike
  218.                     'striker = bl(var).d: VecNorm striker '      get striker unit vector
  219.                     'strikee = bl(x).d: VecNorm strikee '        get strikee unit vector
  220.                     ''dot product the striker and strikee
  221.                     'dot = striker.x * strikee.x + striker.y * strikee.y
  222.                     'dotback = 1 - dot
  223.                     'VecMult strike, dot * _HYPOT(bl(var).d.x, bl(var).d.y)
  224.                     'VecAdd bl(x).d, strike, 1
  225.  
  226.                     'a temporary test
  227.                     bl(x).d.x = strike.x * (.8 * bl(var).d.x)
  228.                     bl(x).d.y = strike.y * (.8 * bl(var).d.y)
  229.                     bl(var).d.x = -strike.y * (.2 * bl(var).d.y)
  230.                     bl(var).d.y = -strike.x * (.2 * bl(var).d.x)
  231.                 END IF
  232.             END IF
  233.         END IF
  234.     NEXT x
  235.     IF bl(var).p.x < bsiz OR bl(var).p.x > xtable - bsiz THEN
  236.         bl(var).d.x = -bl(var).d.x
  237.         IF bl(var).p.x < bsiz THEN '                            if beyond left edge
  238.             bl(var).p.y = bl(var).p.y - (bl(var).d.y * ((bl(var).p.x - bsiz) / bl(var).d.x))
  239.             bl(var).p.x = bsiz
  240.         END IF
  241.         IF bl(var).p.x > xtable - bsiz THEN '                   if beyond right edge
  242.             bl(var).p.y = bl(var).p.y - (bl(var).d.y * ((bl(var).p.x - xtable + bsiz) / bl(var).d.x))
  243.             bl(var).p.x = xtable - bsiz
  244.         END IF
  245.     END IF
  246.     IF bl(var).p.y < bsiz OR bl(var).p.y > ytable - bsiz THEN
  247.         bl(var).d.y = -bl(var).d.y
  248.         IF bl(var).p.y < bsiz THEN '                            if beyond top edge
  249.             bl(var).p.x = bl(var).p.x - (bl(var).d.x * ((bl(var).p.y - bsiz) / bl(var).d.y))
  250.             bl(var).p.y = bsiz
  251.         END IF
  252.         IF bl(var).p.y > ytable - bsiz THEN '                   if beyond bottom edge
  253.             bl(var).p.x = bl(var).p.x - (bl(var).d.x * ((bl(var).p.y - ytable + bsiz) / bl(var).d.y))
  254.             bl(var).p.y = ytable - bsiz
  255.         END IF
  256.     END IF
  257.  
  258. END SUB 'ColCheckold
  259.  
  260.  
  261. SUB DisplayBall (var AS INTEGER)
  262.  
  263.  
  264. END SUB 'DisplayBall
  265.  
  266.  
  267.     DIM R AS INTEGER, RError AS INTEGER '                       SMcNeill's circle fill
  268.     DIM X AS INTEGER, Y AS INTEGER
  269.  
  270.     R = ABS(RR)
  271.     RError = -R
  272.     X = R
  273.     Y = 0
  274.     IF R = 0 THEN PSET (CX, CY), C: EXIT SUB
  275.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  276.     WHILE X > Y
  277.         RError = RError + Y * 2 + 1
  278.         IF RError >= 0 THEN
  279.             IF X <> Y + 1 THEN
  280.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C2, BF 'these two need white here for 9-15 balls
  281.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C2, BF
  282.             END IF
  283.             X = X - 1
  284.             RError = RError - X * 2
  285.         END IF
  286.         Y = Y + 1
  287.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  288.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  289.     WEND
  290. END SUB 'FCirc
  291.  
  292.  
  293. SUB MakeBalls
  294.  
  295.     FOR x = 0 TO 15
  296.         'make ball images here
  297.         bnum(x) = _NEWIMAGE(bsiz * 2 + 4, bsiz * 2 + 4, 32)
  298.         _DEST bnum(x)
  299.         IF x = 0 THEN '                                         Cue ball
  300.             FCirc INT(_WIDTH(bnum(x)) / 2), INT(_HEIGHT(bnum(x)) / 2), bsiz, bl(x).c, bl(x).c
  301.             CIRCLE (_WIDTH(bnum(x)) / 2, _HEIGHT(bnum(x)) / 2), bsiz + 1, Black
  302.         ELSE
  303.             'Solids or stripes
  304.             IF x <= 8 THEN
  305.                 FCirc INT(_WIDTH(bnum(x)) / 2), INT(_HEIGHT(bnum(x)) / 2), bsiz, bl(x).c, bl(x).c ' solid
  306.             ELSE
  307.                 FCirc INT(_WIDTH(bnum(x)) / 2), INT(_HEIGHT(bnum(x)) / 2), bsiz, bl(x).c, White '   stripe
  308.             END IF
  309.             FCirc INT(_WIDTH(bnum(x)) / 2), INT(_HEIGHT(bnum(x)) / 2), bsiz - 5, White, White 'number circle
  310.             CIRCLE (_WIDTH(bnum(x)) / 2, _HEIGHT(bnum(x)) / 2), bsiz + 1, Black
  311.             n$ = _TRIM$(STR$(x))
  312.             t& = _NEWIMAGE(16, 16, 32)
  313.             _DEST t&
  314.             COLOR Black
  315.             _PRINTMODE _KEEPBACKGROUND
  316.             IF LEN(n$) > 1 THEN a = 0 ELSE a = 4
  317.             _PRINTSTRING (a, 0), n$, t&
  318.             _DEST bnum(x)
  319.             _PUTIMAGE (8, 8)-(_WIDTH(bnum(x)) - 8, _HEIGHT(bnum(x)) - 8), t&, bnum(x)
  320.             _FREEIMAGE t&
  321.         END IF
  322.     NEXT x
  323.  
  324. END SUB 'MakeBalls
  325.  
  326.  
  327. FUNCTION PythXY (var1 AS Vec2, var2 AS Vec2)
  328.  
  329.     'Use to find distance between two 2D points
  330.     'Also calculate speed/magnitude of updated vectors
  331.  
  332.     PythXY = _HYPOT(ABS(var1.x - var2.x), ABS(var1.y - var2.y))
  333.  
  334. END FUNCTION 'PythXY
  335.  
  336.  
  337. SUB RackEmUp
  338.  
  339.     yoff = bsiz2 + 4
  340.     xoff = SQR((yoff / 2) * (yoff / 2) + yoff * yoff)
  341.  
  342.     RESTORE start
  343.     FOR rank = 1 TO 5
  344.         FOR b = 1 TO rank
  345.             READ k
  346.             bl(k).p.x = (.25 * xtable) - (xoff * (rank - 1))
  347.             bl(k).p.y = (.5 * ytable) - ((rank - 1) * (.5 * yoff)) + ((b - 1) * yoff)
  348.         NEXT b
  349.     NEXT rank
  350.  
  351. END SUB 'RackEmUp
  352.  
  353.  
  354. SUB VecAdd (var AS Vec2, var2 AS Vec2, var3 AS INTEGER)
  355.  
  356.     var.x = var.x + (var2.x * var3) '                        add (or subtract) two vectors defined by unitpoint
  357.     var.y = var.y + (var2.y * var3) '                        var= base vector, var2= vector to add
  358.  
  359. END SUB 'VecAdd
  360.  
  361.  
  362. SUB VecMult (vec AS Vec2, multiplier AS SINGLE)
  363.  
  364.     'multiply vector by scalar value
  365.     vec.x = vec.x * multiplier
  366.     vec.y = vec.y * multiplier
  367.  
  368. END SUB 'VecMult
  369.  
  370. SUB VecNorm (var AS Vec2)
  371.  
  372.     'convert var to unit vector
  373.     m = SQR(var.x * var.x + var.y * var.y)
  374.     var.x = var.x / m
  375.     var.y = var.y / m
  376.  
  377. END SUB 'VecNorm
  378.  
« Last Edit: March 25, 2020, 09:51:50 pm by OldMoses »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: My first attempts at a billiards program
« Reply #1 on: March 22, 2020, 04:55:47 pm »
Hey nice balls!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: My first attempts at a billiards program
« Reply #2 on: March 25, 2020, 01:24:51 am »
Need a table? The ball action is worse than I remember! I must of been modifying it... anyway the table is kind of nice :)

Code: QB64: [Select]
  1. _TITLE "Pool v1 by bplus 2018-04-07"
  2. 'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
  3. 'translated from:
  4. ' pool table.bas SmallBASIC 0.12.9 (B+=MGA) 2017-09-06
  5.  
  6. CONST xmax = 1280
  7. CONST ymax = 740
  8. SCREEN _NEWIMAGE(xmax, ymax, 32)
  9.  
  10. 'balls
  11. CONST topBall = 15
  12. CONST brad = 11 'ball radius 2.25"
  13. CONST bdia = 22
  14. 'table
  15. CONST tl = 978 'table 100" for 9 foot table, adjust down for pixel ball radius
  16. CONST txo = (xmax - tl) * .5 'table x offset from left side of screen
  17. CONST tw = 489 'table 50" for 9 foot table, adjust down for pixel ball radius
  18. CONST tyo = (ymax - tw) \ 2 ' same border for 1280 wide screen
  19. CONST mt = txo + .5 * tl
  20. 'pockets
  21. CONST pw = 40 'pockey width less than 2 balls across
  22. CONST pr = 20
  23. 'rails
  24. CONST lr = txo
  25. CONST rr = txo + tl
  26. CONST tr = tyo
  27. CONST br = tyo + tw
  28.  
  29. 'color
  30. CONST bumper&& = _RGB32(0, 168, 70)
  31. CONST felt&& = _RGB32(0, 128, 50)
  32. 'DIM SHARED mx, my
  33. DIM SHARED x(topBall), y(topBall), a(topBall), dx(topBall), dy(topBall), s(topBall), c(topBall), z(topBall)
  34. DIM SHARED rack(topBall, 2)
  35.  
  36. drawTable
  37. eightBallRack
  38. BallInHand
  39.  
  40.     IF x(0) = -1000 THEN BallInHand
  41.     getCueBallAngle
  42.     'get speed of cue  how much do I need?
  43.  
  44.     notDone = 1
  45.     WHILE notDone
  46.         drawTable
  47.         CP 1, "Watch Ball Action!"
  48.         notDone = 0
  49.         FOR i = 0 TO topBall
  50.             a(i) = _ATAN2(dy(i), dx(i))
  51.             IF s(i) <> 0 THEN s(i) = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
  52.             imoved = 0
  53.             FOR j = i + 1 TO topBall
  54.  
  55.                 ' The following is STATIC's adjustment of ball positions if overlapping
  56.                 ' before calcultion of new positions from collision
  57.                 ' Displacement vector and its magnitude.  Thanks STxAxTIC !
  58.                 nx = x(j) - x(i)
  59.                 ny = y(j) - y(i)
  60.                 nm = SQR(nx ^ 2 + ny ^ 2)
  61.                 IF nm < 1 + bdia THEN
  62.                     imoved = 1
  63.                     nx = nx / nm
  64.                     ny = ny / nm
  65.  
  66.                     ' Regardless of momentum exchange, separate the balls along the lone connecting them.
  67.                     DO WHILE nm < 1 + bdia
  68.                         flub = .001 '* RND
  69.  
  70.                         x(j) = x(j) + flub * nx
  71.                         y(j) = y(j) + flub * ny
  72.  
  73.                         x(i) = x(i) - flub * nx
  74.                         y(i) = y(i) - flub * ny
  75.  
  76.                         nx = x(j) - x(i)
  77.                         ny = y(j) - y(i)
  78.                         nm = SQR(nx ^ 2 + ny ^ 2)
  79.                         nx = nx / nm
  80.                         ny = ny / nm
  81.                     LOOP
  82.  
  83.  
  84.                     imoved = 1
  85.                     a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
  86.                     a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
  87.                     'update new dx, dy for i and j balls
  88.                     s(j) = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
  89.                     power = .7 * (s(i) + s(j)) / 2
  90.                     dx(i) = power * COS(a(i))
  91.                     dy(i) = power * SIN(a(i))
  92.                     dx(j) = power * COS(a(j))
  93.                     dy(j) = power * SIN(a(j))
  94.                     x(i) = x(i) + dx(i)
  95.                     y(i) = y(i) + dy(i)
  96.                     x(j) = x(j) + dx(j)
  97.                     y(j) = y(j) + dy(j)
  98.  
  99.  
  100.                 END IF
  101.             NEXT
  102.             IF imoved = 0 THEN
  103.                 x(i) = x(i) + dx(i)
  104.                 y(i) = y(i) + dy(i)
  105.             END IF
  106.  
  107.             IF x(i) < lr + brad THEN
  108.                 IF y(i) > tr + 17 AND y(i) < br - 17 THEN
  109.                     a(i) = _PI - a(i): x(i) = lr + brad
  110.                 ELSE
  111.                     x(i) = -1000 'pocketed
  112.                 END IF
  113.             END IF
  114.  
  115.             IF x(i) > rr - brad THEN
  116.                 IF y(i) > tr + 17 AND y(i) < br - 17 THEN
  117.                     a(i) = _PI - a(i): x(i) = rr - brad
  118.                 ELSE
  119.                     x(i) = -1000 'pocket
  120.                 END IF
  121.             END IF
  122.  
  123.             IF y(i) < tr + brad THEN
  124.                 IF (x(i) > lr + 17 AND x(i) < mt - 9) OR (x(i) > mt + 9 AND x(i) < rr - 17) THEN
  125.                     a(i) = -a(i): y(i) = tr + brad
  126.                 ELSE
  127.                     x(i) = -1000 ' pocket
  128.                 END IF
  129.             END IF
  130.  
  131.             IF y(i) > br - brad THEN
  132.                 IF (x(i) > lr + 17 AND x(i) < mt - 9) OR (x(i) > mt + 9 AND x(i) < rr - 17) THEN
  133.                     a(i) = -a(i): y(i) = br - brad
  134.                 ELSE
  135.                     x(i) = -1000 ' pocket
  136.                 END IF
  137.             END IF
  138.  
  139.             IF a(i) > _PI * 2 THEN a(i) = a(i) - _PI * 2
  140.             IF a(i) < 0 THEN a(i) = a(i) + _PI * 2
  141.  
  142.             IF s(i) > 0 THEN s(i) = s(i) - .01
  143.             IF s(i) < .05 THEN s(i) = 0
  144.  
  145.             'update ball position
  146.             IF x(i) <> -1000 THEN
  147.                 IF s(i) <> 0 THEN notDone = 1
  148.                 x(i) = x(i) + COS(a(i)) * s(i)
  149.                 y(i) = y(i) + SIN(a(i)) * s(i)
  150.                 drawball i
  151.             END IF
  152.  
  153.             c(i) = 0
  154.         NEXT
  155.         _DISPLAY
  156.         _LIMIT 20
  157.     WEND
  158.     'check status of balls pocketed...
  159.  
  160. FUNCTION rand% (lo%, hi%)
  161.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  162.  
  163.  
  164. SUB getCueBallAngle 'get speed too
  165.     'local i, mx, my
  166.  
  167.     m = _MOUSEINPUT
  168.     mb = _MOUSEBUTTON(1)
  169.     lastmx = _MOUSEX
  170.     lastmy = _MOUSEY
  171.  
  172.  
  173.     WHILE mb = 0
  174.         m = _MOUSEINPUT
  175.         mb = _MOUSEBUTTON(1)
  176.         mx = _MOUSEX
  177.         my = _MOUSEY
  178.         IF mx <> lastmx OR my <> lastmy THEN
  179.             IF mx > txo + brad AND mx < txo + tl - brad THEN
  180.                 lastmx = mx
  181.                 IF my > tyo + brad AND my < tyo + tw - brad THEN
  182.                     lastmy = my
  183.                     drawTable
  184.                     FOR i = 0 TO topBall
  185.                         drawball i
  186.                     NEXT
  187.                     CP 1, "Click for cue ball angle"
  188.                     COLOR _RGB32(255, 255, 255)
  189.                     LINE (x(0), y(0))-(mx, my)
  190.                 END IF
  191.             END IF
  192.         END IF
  193.         _DISPLAY
  194.         _LIMIT 100
  195.     WEND
  196.     s(0) = SQR((my - y(0)) ^ 2 + (mx - x(0)) ^ 2) / 10
  197.     IF s(0) < 5 THEN s(0) = 10
  198.     IF s(0) > 10 THEN s(0) = 20
  199.     a(0) = _ATAN2(my - y(0), mx - x(0))
  200.     dx(0) = s(0) * COS(a(0))
  201.     dy(0) = s(0) * SIN(a(0))
  202.     IF a(0) < 0 THEN a(0) = a(0) + 2 * _PI
  203.     drawTable
  204.     FOR i = 0 TO topBall
  205.         drawball i
  206.     NEXT
  207.     CP 1, "Cue Ball angle is " + STR$(a(0)) + ", speed is " + STR$(s(0))
  208.     _DISPLAY
  209.  
  210. SUB BallInHand
  211.     CP 1, "Ball 'in hand' behind table head line, click place for cue ball."
  212.     m = _MOUSEINPUT
  213.     mb = _MOUSEBUTTON(1)
  214.     mx = _MOUSEX
  215.     my = _MOUSEY
  216.  
  217.     WHILE mb = 0 'wait for click
  218.         m = _MOUSEINPUT
  219.         mb = _MOUSEBUTTON(1)
  220.         mmx = _MOUSEX
  221.         mmy = _MOUSEY
  222.  
  223.  
  224.         IF mmx > txo + .75 * tl AND mmx < txo + tl - brad THEN mx = mmx
  225.         IF mmy > tyo + brad AND mmy < tyo + tw - brad THEN my = mmy
  226.         _LIMIT 100
  227.     WEND
  228.     x(0) = mx: y(0) = my
  229.     drawball 0
  230.     _DISPLAY
  231.  
  232. SUB eightBallRack
  233.     'local xoff, yoff, spacer, b, xx, yy, i, rndB, saveI, shuff
  234.     xoff = txo + .25 * tl
  235.     yoff = tyo + .5 * tw
  236.     spacer = bdia
  237.     b = 1
  238.     FOR xx = 0 TO 4
  239.         FOR yy = 0 TO xx
  240.             x(b) = xoff - spacer * (xx)
  241.             y(b) = yoff - .5 * spacer * xx + yy * spacer
  242.             rack(b, 0) = x(b): rack(b, 1) = y(b)
  243.             b = b + 1
  244.         NEXT
  245.     NEXT
  246.     DIM shuff(topBall)
  247.     FOR i = 1 TO topBall
  248.         shuff(i) = i
  249.     NEXT
  250.     FOR i = topBall TO 2 STEP -1
  251.         rndB = rand(1, i)
  252.         SWAP shuff(i), shuff(rndB)
  253.     NEXT
  254.     FOR i = 1 TO topBall
  255.         IF shuff(i) = 8 THEN saveI = i
  256.         z(i) = RND * 2 * _PI
  257.     NEXT
  258.     SWAP shuff(saveI), shuff(5)
  259.     FOR i = 1 TO topBall
  260.         x(shuff(i)) = rack(i, 0)
  261.         y(shuff(i)) = rack(i, 1)
  262.         drawball shuff(i)
  263.     NEXT
  264.     _DISPLAY
  265.  
  266. SUB drawTable
  267.     'local i
  268.     COLOR &HFF000088, _RGB32(0, 94, 62)
  269.     CLS
  270.     FOR i = 60 TO 1 STEP -1
  271.         COLOR _RGB32(90 - .9 * i, 45 - .7 * i, 30 - .5 * i)
  272.         rect txo - i, tyo - i, rr + i, br + i, 1
  273.     NEXT
  274.     COLOR bumper&&
  275.     rect txo - brad, tyo - brad, rr + brad, br + brad, 1
  276.     COLOR felt&&
  277.     rect txo, tyo, rr, br, 1
  278.     tLine txo + .25 * tl, tyo + .5 * tw, txo - bdia, tyo - bdia, pw
  279.     tLine txo + .25 * tl, tyo + .5 * tw, txo - bdia, tyo + tw + bdia, pw
  280.     tLine txo + tw, tyo - bdia, txo + tw, tyo + tw + bdia, pw
  281.     tLine txo + .75 * tl, tyo + .5 * tw, txo + tl + bdia, tyo - bdia, pw
  282.     tLine txo + .75 * tl, tyo + .5 * tw, txo + tl + bdia, tyo + tw + bdia, pw
  283.     COLOR 0
  284.     fcirc txo - bdia, tyo - bdia, pr
  285.     fcirc txo + tw, tyo - bdia, pr
  286.     fcirc txo + tl + bdia, tyo - bdia, pr
  287.     fcirc txo - bdia, tyo + tw + bdia, pr
  288.     fcirc txo + tw, tyo + tw + bdia, pr
  289.     fcirc txo + tl + bdia, tyo + tw + bdia, pr
  290.     _DISPLAY
  291.  
  292. SUB tLine (x1, y1, x2, y2, rThick)
  293.     'x1, y1 is one endpoint of line
  294.     'x2, y2 is the other endpoint of the line
  295.     'rThick is the radius of the tiny circles that will be drawn
  296.     '   from one end point to the other to create the thick line
  297.     'Yes, the line will then extend beyond the endpoints with circular ends.
  298.  
  299.     'local length, stepx, stepy, dx, dy, i
  300.     rThick = INT(rThick / 2): stepx = x2 - x1: stepy = y2 - y1
  301.     length = INT((stepx ^ 2 + stepy ^ 2) ^ .5)
  302.     IF length THEN
  303.         dx = stepx / length: dy = stepy / length
  304.         FOR i = 0 TO length
  305.             fcirc x1 + dx * i, y1 + dy * i, rThick
  306.         NEXT
  307.     ELSE
  308.         fcirc x1, y1, rThick
  309.     END IF
  310.  
  311. SUB drawball (idx)
  312.     'local r, g, b, i, ra, x1, y1
  313.     SELECT CASE idx
  314.         CASE 1, 9: r = 125: g = 125: b = 0
  315.         CASE 2, 10: r = 0: g = 0: b = 145
  316.         CASE 3, 11: r = 145: g = 0: b = 0
  317.         CASE 4, 12: r = 0: g = 0: b = 50
  318.         CASE 5, 13: r = 145: g = 75: b = 0
  319.         CASE 6, 14: r = 0: g = 45: b = 0
  320.         CASE 7, 15: r = 100: g = 0: b = 80
  321.         CASE 8: r = 10: g = 10: b = 10
  322.     END SELECT
  323.     FOR i = brad TO 1 STEP -1
  324.         IF idx = 0 OR idx > 8 THEN
  325.             COLOR _RGB32(255 - i * 8, 255 - i * 8, 255 - i * 8)
  326.         ELSE
  327.             COLOR _RGB32(r, g, b)
  328.         END IF
  329.         fcirc x(idx), y(idx), i
  330.         IF r THEN r = r + 7
  331.         IF g THEN g = g + 7
  332.         IF b THEN b = b + 7
  333.     NEXT
  334.     IF idx > 8 THEN
  335.         COLOR _RGB32(r, g, b)
  336.         ra = z(idx)
  337.         x1 = x(idx) + 9 * COS(ra): y1 = y(idx) + 9 * SIN(ra)
  338.         tLine x(idx), y(idx), x1, y1, 6
  339.         x1 = x(idx) + 9 * COS(ra - _PI): y1 = y(idx) + 9 * SIN(ra - _PI)
  340.         tLine x(idx), y(idx), x1, y1, 6
  341.     END IF
  342.  
  343. SUB CP (lineNumber, mess$)
  344.     ttw = 8: tth = 16
  345.     COLOR _RGB32(0, 0, 0)
  346.     rect 0, th * lineNumber, xmax, th * lineNumber + th, 1
  347.     COLOR _RGB32(255, 255, 255), _RGB32(0, 94, 62)
  348.     _PRINTSTRING ((xmax - ttw * LEN(mess$)) / 2, tth * lineNumber), mess$
  349.     _DISPLAY
  350.  
  351. SUB rect (x1, y1, x2, y2, fill)
  352.     IF fill THEN LINE (x1, y1)-(x2, y2), , BF ELSE LINE (x1, y1)-(x2, y2), , B
  353.  
  354. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  355. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  356.     DIM subRadius AS LONG, RadiusError AS LONG
  357.     DIM X AS LONG, Y AS LONG
  358.  
  359.     subRadius = ABS(R)
  360.     RadiusError = -subRadius
  361.     X = subRadius
  362.     Y = 0
  363.  
  364.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  365.  
  366.     ' Draw the middle span here so we don't draw it twice in the main loop,
  367.     ' which would be a problem with blending turned on.
  368.     LINE (CX - X, CY)-(CX + X, CY), , BF
  369.  
  370.     WHILE X > Y
  371.         RadiusError = RadiusError + Y * 2 + 1
  372.         IF RadiusError >= 0 THEN
  373.             IF X <> Y + 1 THEN
  374.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  375.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  376.             END IF
  377.             X = X - 1
  378.             RadiusError = RadiusError - X * 2
  379.         END IF
  380.         Y = Y + 1
  381.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  382.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  383.     WEND
  384.  
  385.  

 
pool table.PNG
« Last Edit: March 25, 2020, 01:26:12 am by bplus »

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: My first attempts at a billiards program
« Reply #3 on: March 25, 2020, 05:44:25 am »
Amazing! Nice graphics
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline Dimster

  • Forum Resident
  • Posts: 500
    • View Profile
Re: My first attempts at a billiards program
« Reply #4 on: March 25, 2020, 10:02:13 am »
OldMoses - keep going. Great action on those balls. Seem to get an excellent angle to the bounce off the cushions. In your plans for a "finished" product, would those aiming lines still be visible? I'm thinking the white line would become the cue stick but not sure is the orange(yellow?) line will still be used?

bplus - you do game tables so well. I love the event horizon action on the side pockets of those balls travelling along the rails. I always believed, if I hit ball soft enough to hug the rail, the gravity well of the side pocket should draw that ball into the hole as it passed the opening. Was always my Achilles heal in poke pool.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: My first attempts at a billiards program
« Reply #5 on: March 25, 2020, 12:11:43 pm »
Quote
bplus - you do game tables so well. I love the event horizon action on the side pockets of those balls travelling along the rails. I always believed, if I hit ball soft enough to hug the rail, the gravity well of the side pocket should draw that ball into the hole as it passed the opening. Was always my Achilles heal in poke pool.

Ah, one of those flaws that become an asset? Actually they aren't supposed to fall in if they don't cross the rectangle that bumpers make. And I thought I put angles on bumpers at side pockets.

What is really blowing my mind is how slow this is running. I know I was redrawing everything and that bogs things down considerable. But back before version 1.3, Walter's or QB64 v1.2, oh I noted the version last developer model before v1.2 came out, it did run balls faster, really! I would have dropped this code ages ago if it ran as fast as it runs now in 1.4 ??? And the cue ball is acting oddly... shooting itself off unprovoked? like we are back to having to clear mouse clicks. eh!

Well the table ain't bad I can fix side pockets and now think where there is bumper the balls would be stopped from going outside a rectangle boundary farther into holes. Hey Circle Intersect Line Segment function call!

Maybe OLdMoses wants to build his own table? or call in Brunswick ;-))

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: My first attempts at a billiards program
« Reply #6 on: March 25, 2020, 09:53:58 pm »
OldMoses - keep going. Great action on those balls. Seem to get an excellent angle to the bounce off the cushions. In your plans for a "finished" product, would those aiming lines still be visible? I'm thinking the white line would become the cue stick but not sure is the orange(yellow?) line will still be used?

I am figuring on a cue stick graphic, and the target line will probably be gone after I get the balls to behave correctly.

I do need to work in a proper table graphic, but I figured I need to get the ball action working right first. I'm a total neophyte to this sort of graphics game.

I put the balls in a starting "rack", but I'm not impressed by the break action and the balls will flip places sometimes when crowded along the edge or clustered together.

In studying the dynamics of ball impact, I had to correct the rebound characteristics of the "striking" ball relative to the struck one. That took some head scratching, but it seems to be working better. I posted the improvements to the OP code.

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: My first attempts at a billiards program
« Reply #7 on: March 25, 2020, 10:06:40 pm »
One interesting bug with this one is the tendency for the program to crash with no errors or warnings. It just stops. Kinda hard to have an idea why without any sort of feedback. I notice that it will do so often when one ball gets stuck behind another along the bumper.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: My first attempts at a billiards program
« Reply #8 on: March 25, 2020, 10:17:06 pm »
Hi OldMoses,

Ball action on 1-on-1 shots pretty good, I am running out of room for drawing cue ball back when it is at the edge of the screen like playing pool in a closet.

Shut downs might be division by zero or nan's a result that is infinity. STx code fix for overlapping balls, see Dropping Balls in Samples.

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: My first attempts at a billiards program
« Reply #9 on: March 25, 2020, 10:27:23 pm »
Yes the short strike near a bumper is a limitation. I've got an idea to make it so that you can press and hold the mousebutton and have a force indicator build up, then release of the button will shoot the ball at the force built at the moment of release.

Thanks for the heads up to the Dropping Balls, I'll check that one out.