You are not logged in or registered. Please login or register to use the full functionality of this board...
SIGN IN Join Our Community For FREE


Pool
09-07-2017, 03:02 AM
Post: #1
 (Print Post)
Pool
... with a capital T that rhymes with P that stands for Pool.
Code Snippet: [Select]
' 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 File(s) Image(s)
   

B += _
Find all posts by this user
Like Post
09-07-2017, 05:48 AM
Post: #2
 (Print Post)
RE: Pool
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.
Find all posts by this user
Like Post
09-07-2017, 11:39 AM (This post was last modified: 09-07-2017 01:19 PM by bplus.)
Post: #3
 (Print Post)
RE: Pool
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 += _
Find all posts by this user
Like Post
09-07-2017, 03:47 PM
Post: #4
 (Print Post)
RE: Pool
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.
Find all posts by this user
Like Post
09-07-2017, 06:14 PM
Post: #5
 (Print Post)
RE: Pool
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.
Find all posts by this user
Like Post
09-07-2017, 09:46 PM
Post: #6
 (Print Post)
RE: Pool
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 Snippet: [Select]
' 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 File(s) Image(s)
   

B += _
Find all posts by this user
Like Post
09-08-2017, 12:13 AM
Post: #7
 (Print Post)
RE: Pool
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.
Find all posts by this user
Like Post
09-09-2017, 05:13 PM (This post was last modified: 09-09-2017 05:15 PM by bplus.)
Post: #8
 (Print Post)
RE: Pool
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 += _
Find all posts by this user
Like Post



Forum Jump:


User(s) browsing this thread: 1 Guest(s)




QB64 Member Project - Dakapo
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - Quarto
QB64 Member Project - Rotating Background
QB64 Member Project - MAPTRIANGLE
QB64 Member Project - Martin Fractals version one
QB64 Member Project - OpenGL Triangles
QB64 Member Project - Dreamy Clock
QB64 Member Project - Martin Fractals version four
QB64 Member Project - Connect Four
QB64 Member Project - Line Thickness
QB64 Member Project - Pivet version one
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Amazon
QB64 Member Project - Foursight
QB64 Member Project - Bowditch curve
QB64 Member Project - Score 4
QB64 Member Project - Martin Fractals version three
QB64 Member Project - Basic Dithering
QB64 Member Project - Inside Moves
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - Spiro Roses
QB64 Member Project - Qubic
QB64 Member Project - Sabotage
QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - Domain
QB64 Member Project - Touche
QB64 Member Project - Rubix's Magic
QB64 Member Project - Color Rotating Text
QB64 Member Project - Input
QB64 Member Project - Kings Court
QB64 Member Project - Swirl
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Pivot version two
QB64 Member Project - Isolation
QB64 Member Project - Blokus
QB64 Member Project - Othello
QB64 Member Project - Algeria Weather
QB64 Member Project - RGB Color Wheel
QB64 Member Project - Kings Valley verion one
QB64 Member Project - Overboard
QB64 Member Project - ARB Checkers
QB64 Member Project - Full Color LED Sign
QB64 Member Project - Point Blank
QB64 Member Project - Exit
QB64 Member Project - Spinning Color Wheel
QB64 Member Project - Color Triangles
QB64 Member Project - 9 Board
QB64 Member Project - Splatter