Pool
#1
... with a capital T that rhymes with P that stands for Pool.
Code:
' pool table.bas SmallBASIC 0.12.9 (B+=MGA) 2017-09-06
' draw table
'balls
const topBall = 15
const brad = 11  'ball radius 2.25"
const bdia = 22
'table
const tl = 978 'table 100" for 9 foot table, adjust down for pixel ball radius
const txo = (xmax - tl)\2 '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
'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 bumper = rgb(0, 168, 70)
const felt = rgb(0, 128, 50)

drawTable

dim x(topBall), y(topBall), a(topBall),  s(topBall)
dim rack(topBall, 2)

xoff = txo + .25 * tl
yoff = tyo + .5 * tw
spacer = bdia

b = 1
for xx = 0 to 4
 for yy = 0 to xx
   x(b) = xoff - spacer*(xx)
   y(b) = yoff - .5 * spacer * xx + yy * spacer
   rack(b, 0) = x(b) : rack(b, 1) = y(b)
   drawball b
   b += 1
 next
next

x(0) = txo + .75 * tl : y(0) = tyo + .5 * tw
drawball 0
pause

sub drawTable
 local i
 color 1, rgb(0, 94, 62)
 cls
 for i = 60 to 1 step -1
   color rgb(90 - .9 * i, 45 - .7 * i, 30 - .5 * i)
   rect txo - i, tyo - i, rr + i, br + i filled
 next
 rect txo - brad, tyo - brad, rr + brad, br + brad, bumper filled
 color felt
 rect txo, tyo, rr, br, felt filled
 tline txo + .25 * tl, tyo + .5 * tw, txo - bdia, tyo - bdia, pw
 tline txo + .25 * tl, tyo + .5 * tw, txo - bdia, tyo + tw + bdia, pw
 tline txo + tw, tyo - bdia, txo + tw, tyo + tw + bdia, pw
 tline txo + .75 * tl, tyo + .5 * tw, txo + tl + bdia, tyo - bdia, pw
 tline txo + .75 * tl, tyo + .5 * tw, txo + tl + bdia, tyo + tw+bdia, pw
 color 0
 circle txo - bdia, tyo - bdia, pr filled
 circle txo + tw, tyo - bdia, pr filled
 circle txo + tl + bdia, tyo - bdia, pr filled
 circle txo - bdia, tyo + tw + bdia, pr filled
 circle txo + tw, tyo + tw + bdia, pr filled
 circle txo + tl + bdia, tyo + tw + bdia, pr filled
end sub

sub tLine(x1, y1, x2, y2, rThick)
 '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
     circle x1 + dx * i, y1 + dy * i, rThick filled
   next
 else
   circle x1, y1, rThick filled
 end if
end

sub drawball(idx)
 local r, g, b, i
 select case idx
   case 0 : r = 200 : g = 200 : b = 200
   case 1, 9  : r = 145 : g = 145 : b = 0
   case 2, 10 : r = 0   : g = 0   : b = 145
   case 3, 11 : r = 145 : g = 0   : b = 0
   case 4, 12 : r = 0   : g = 0   : b = 50
   case 5, 13 : r = 145 : g = 75  : b = 0
   case 6, 14 : r = 0   : g = 45  : b = 0
   case 7, 15 : r = 50  : g = 0   : b = 50
   case 8 : r = 10   : g = 10   : b = 10
 end select
 for i = brad to 1 step -1
   if i < 5 and idx > 8 then
     color rgb(200+(4-i)*15, 200+(4-i)*15, 200+(4-i)*15)
   else
     color rgb(r, g, b)
   end if
   circle x(idx), y(idx), i filled
   if r then r += 5
   if g then g += 5
   if b then b += 5
 next
end sub


Attached Files Thumbnail(s)

B += x
Reply
#2
My screen does not look like this one....  all I get to see is the green area that displays the balls and cue ball. The rest of the table appears to be 'off screen'. Kind of like a closeup of the center of the table. Program was not edited. Cut and paste only.

May your journey be free of incident.

Live long and prosper.
Reply
#3
Hey Johnno,

You must be sure you are running code in a maximized window, I am betting you are running in less than full screen.

The SB code screen should be maximized (your + button? in upper right corner) before you run code.

BTW this needs a working screen space of at least 1100 pixels wide and about 550 - 600 high (so far, probably will need 700 before finished).

Remember in SB, you don't set the display window size, it uses the entire screen it has available to it.


Append:
If that doesn't work, try a WINDOW command to reset coordinates.
B += x
Reply
#4
Cool... Maximizing the screen did it... That loud noise that you will probably hear will be the sound of my right palm hitting my forehead...

J
May your journey be free of incident.

Live long and prosper.
Reply
#5
A slight modification to the top and bottom centre pockets.

Add these 'tlines' immediately after the other 'tlines' and let me know what you think?

    tline(txo + tw, tyo - bdia,(txo + tw)+20, (tyo - bdia)+50,pw)
    tline(txo + tw, tyo - bdia,(txo + tw)-20, (tyo - bdia)+50,pw)
    tline(txo + tw, tyo + tw + bdia,(txo + tw)-20, (tyo + tw + bdia)-50,pw)
    tline(txo + tw, tyo + tw + bdia,(txo + tw)+20, (tyo + tw + bdia)-50,pw)
J
May your journey be free of incident.

Live long and prosper.
Reply
#6
Hi J,

Your new tLines make the width at center pockets wider than corners. I tried something like that making two X's XX with tLines and made the center pocket width even wider! But it did make bumpers exactly same...

I confess I don't like the 90 degree bumper corners to side pockets, nor do I like how far back the holes in the corners are. There, it looks like a ball could stop before falling in.

Perhaps mounting 6 trapezoidal bumpers on table, THEN figure out where the holes fit.

I have worked on redesign of striped balls and shuffling the setup for a game of Eight-ball.

Code:
' pool table.bas SmallBASIC 0.12.9 (B+=MGA) 2017-09-06
' draw table
'balls
randomize timer

const topBall = 15
const brad = 11  'ball radius 2.25"
const bdia = 22
'table
const tl = 978 'table 100" for 9 foot table, adjust down for pixel ball radius
const txo = (xmax - tl)\2 '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
'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 bumper = rgb(0, 168, 70)
const felt = rgb(0, 128, 50)

drawTable

dim x(topBall), y(topBall), a(topBall),  s(topBall)
dim rack(topBall, 2)

xoff = txo + .25 * tl
yoff = tyo + .5 * tw
spacer = bdia

b = 1
for xx = 0 to 4
 for yy = 0 to xx
   x(b) = xoff - spacer*(xx)
   y(b) = yoff - .5 * spacer * xx + yy * spacer
   rack(b, 0) = x(b) : rack(b, 1) = y(b)
   if b = 5 then x8 = x(b) : y8 = 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
next
swap shuff(saveI), shuff(5)
for i = 1 to topBall
 x(shuff(i)) = rack(i, 0)
 y(shuff(i)) = rack(i, 1)
 drawball shuff(i)
next

x(0) = txo + .75 * tl : y(0) = tyo + .5 * tw
drawball 0
pause

def rand(lo, hi) = (rnd * (hi - lo + 1)) \ 1 + lo

sub drawTable
 local i
 color 1, rgb(0, 94, 62)
 cls
 for i = 60 to 1 step -1
   color rgb(90 - .9 * i, 45 - .7 * i, 30 - .5 * i)
   rect txo - i, tyo - i, rr + i, br + i filled
 next
 rect txo - brad, tyo - brad, rr + brad, br + brad, bumper filled
 color felt
 rect txo, tyo, rr, br, felt filled
 tline txo + .25 * tl, tyo + .5 * tw, txo - bdia, tyo - bdia, pw
 tline txo + .25 * tl, tyo + .5 * tw, txo - bdia, tyo + tw + bdia, pw
 tline txo + tw, tyo - bdia, txo + tw, tyo + tw + bdia, pw
 tline txo + .75 * tl, tyo + .5 * tw, txo + tl + bdia, tyo - bdia, pw
 tline txo + .75 * tl, tyo + .5 * tw, txo + tl + bdia, tyo + tw+bdia, pw
 color 0
 circle txo - bdia, tyo - bdia, pr filled
 circle txo + tw, tyo - bdia, pr filled
 circle txo + tl + bdia, tyo - bdia, pr filled
 circle txo - bdia, tyo + tw + bdia, pr filled
 circle txo + tw, tyo + tw + bdia, pr filled
 circle txo + tl + bdia, tyo + tw + bdia, pr filled
end sub

sub tLine(x1, y1, x2, y2, rThick)
 '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
     circle x1 + dx * i, y1 + dy * i, rThick filled
   next
 else
   circle x1, y1, rThick filled
 end if
end

sub drawball(idx)
 local r, g, b, i, ra, x1, y1
 select case idx      
   case 1, 9  : r = 125 : g = 125 : b = 0
   case 2, 10 : r = 0   : g = 0   : b = 145
   case 3, 11 : r = 145 : g = 0   : b = 0
   case 4, 12 : r = 0   : g = 0   : b = 50
   case 5, 13 : r = 145 : g = 75  : b = 0
   case 6, 14 : r = 0   : g = 45  : b = 0
   case 7, 15 : r = 100  : g = 0   : b = 80
   case 8 : r = 10  : g = 10  : b = 10
 end select
 for i = brad to 1 step -1
   if idx = 0 or idx > 8 then
     color rgb(255 - i * 8, 255 - i * 8, 255 - i * 8)
   else
     color rgb(r, g, b)
   end if
   circle x(idx), y(idx), i filled
   if r then r += 7
   if g then g += 7
   if b then b += 7
 next
 if idx > 8 then
   color rgb(r, g, b)
   ra = rnd * 2 * pi
   x1 = x(idx) + 7 * cos(ra) : y1 = y(idx) + 7 * sin(ra)
   tline x(idx), y(idx), x1, y1, 8
   x1 = x(idx) + 7 * cos(ra-pi) : y1 = y(idx) + 7 * sin(ra-pi)
   tline x(idx), y(idx), x1, y1, 8
 end if
end sub


Attached Files Thumbnail(s)

B += x
Reply
#7
Yeah. That's why I tried the modification. Not a big fan of 90 degree bumpers... lol  Experiment with the "20's" to modify the angle. On a real table, balls often get caught in the 'area' in front of the corner pockets, I wouldn't be too concerned about it. The 'corners' of the bumper ends are normally 'rounded' to help prevent a ball from getting caught. But, not all that important, at this stage... lol The 'stripes' are a nice touch. Good job.

J
May your journey be free of incident.

Live long and prosper.
Reply
#8
Yikes! My collision model is completely in adequate for breaking a rack of balls, neither is it very good with easy cue ball / object ball shots. (Nether is SB very good updating screen fast enough, but that could be fixed using QB64.)  Dang!

Johnno, the width of pockets is just a little detail compared to these other problems.
B += x
Reply
#9
Code:
H& = _NEWIMAGE(1366, 768, 256)
SCREEN H&
_DELAY .5
wide = _WIDTH(H&)
high = _HEIGHT(H&)
XPOCKETsEPS = 6
ypOCKETseps = 3
distanceBetX = wide / XPOCKETsEPS
DistanceBetY = high / ypOCKETseps
CenterCueX! = 2 * distanceBetX
CenterCueY! = DistanceBetY * (ypOCKETseps / 2)
TYPE BallRec
    x AS SINGLE
    y AS SINGLE
    xspeed AS SINGLE
    yspeed AS SINGLE
    mass AS SINGLE
    radius AS SINGLE
    COR AS SINGLE
    colr AS LONG
END TYPE
'* 0 can be the cue ball
RESTORE Colors
REDIM ball(0 TO 15) AS BallRec
FOR s& = 0 TO 15
    ball(s&).xspeed = 0
    ball(s&).yspeed = 0
    ball(s&).mass = 1
    ball(s&).radius = 15
    ball(s&).COR = 1 '* use CalcVelocitiesCOR() to calculate rebound angles and speeds
    '* READ ball(s&).colr
NEXT
'* algorithmic placement of object balls -- the break would go right to left
'* and rebound equations -- reset object balls to perfectly still .xspeed=0, .yspeed=0. Cue hitting them will affect their speeds and such
xoff! = 0
yooff = 0
ballindex& = 1
FOR column = 1 TO 5
    FOR row = 1 TO column
        CIRCLE (CenterCueX! + xoff!, CenterCueY! + yoff!), ball(ballindex&).radius, ball(ballindex&).colr
        yoff! = yoff! + 2 * ball(ballindex&).radius
        ball(ballindex&).x = CenterCueX! + xoff!
        ball(ballindex&).y = CenterCueY! + yoff!
        ball(ballindex&).xspeed = 0
        ball(ballindex&).yspeed = 0
        ballindex& = ballindex& + 1
    NEXT
    xoff! = xoff! - 2 * 15 * COS(2 * 3.14159 / 12)
    yoff! = (-column) * 15
NEXT
_DELAY 10
SCREEN 0
_FREEIMAGE H&
SYSTEM
Colors:
DATA *

of course, you'll have to swap positions of ball 8 and 5 and 11 and 12 OR 14 and 15 to get a semi-regulation rack. The BallRec TYPE can be used in my NSpace collision detection algo with a couple more additions. I'd use the TYPE that's in the listing. Yes. more parameters than you need, but the collision detection is radial, perfect for pool balls.
Reply
#10
Hi codeguy,

Thanks for checking this out!

I am not sure what to make of this code, it doesn't do anything for me, do you have a screen shot? I suspect this is just a beginning and/or I am supposed to plug-in my own stuff.

What is COR in the BallRec?

"Semi-regulation" rules? For 8 ball, all I remember is that 8 has to go in middle and 2 corner balls should be different? Generally the distribution in the rack is random (which I had coded) and people would object if all stripes on one side or corner and all solids somewhere else. Straight pool will probably have much stricter rules...

Oh hey, maybe not random, maybe alternate: stripe, solid, stripe, solid.... just the color of stripe or solids does not matter.
B += x
Reply
#11
COR is coefficient of restitution. This determines how much energy is conserved during a collision. The more toward zero, the softer the objects and therefore more dissipation of impact energy. For the pool balls, I's set them between (80-90) percent to account for rails, felt and such. otherwise the collisions will not result in slowing balls unless you want to make things more complex by dealing with coefficients of friction. I would advise against that as it involves a LOT of very time-consuming higher-order math and such.
Reply
#12
You may want to add a COR for the rails too and recalculate the ball velocities accordingly. Otherwise, you will end up with balls indefinitely maintaining speed. There is a lot of complexity to absolutely physically correct results. A close-enough approach is recommended. Many games do exactly the same thing and we do not notice.
Reply