Carambole Billiards (Carom)

[stef]

Hi!

Uploaded this code to code-tank

Simple Billiards simulation

Carambole Type (Carom)

The rules (simple):

With the your cue-ball (allways the white one)  you must  hit both other balls (yellow and red) 

(Normally you play "Three cushion billiard")

Left-click the white ball (must stand still), move around the mouse - the cue-stick will appear - choose distance (the higher the more power) - aim - left-click again.

http://www.underwaredesign.com/pbct/pbct_dataview.php?key=36



Greetings
stef

[stef]

Hi!

Not even one reply!

It seems that billiard-simulations aren't very popular.

But it's more a physiks example ("Newtons second law" and that stuff  :))

The code below is a 15 balls simulation (without pockets)
(It's pretty fast without fps restriction)

Greetings
stef

Edit : Code deleted by autor ( "Mou'I'm a Spammer8'()" leads to a strange result)

2nd edit: " M o u s e x ( ) " leads to a strange result

[thaaks]

I guess you're right, stef, Billiard games are quite outdated. But physics examples are not.
Your collision code is a good one! You could extend the example to use PlayBasic's circle collision for sprites and just do the proper force and angle calculations...

Funny thing occurred with your source code in your post - seems the famous three letter word describing a very intimate relationship between two or more beings (s, e, x) are transformed to 'I am a spammer8'. Happens for example with GetMouse-X() (written with a '-' to avoid replacement).
Once more without '-': GetMouseX()

Kevin, this seems to be a forum setting and should be switched off for code blocks...

Cheers,
Tommy

[stef]

Hi!

Thanks Tommy

Saw it now. Strange

edit:

You could extend the example to use PlayBasic's circle collision for sprites and just do the proper force and angle calculations...

That's of course the point.

The example  you saw makes about 300 (simple) collisions-checks every loop-turn and runs with about 350-400 fps on my laptop (hadn't expect that speed).
Of course with objects of same radius and mass but it's no problem to change the code.

Greetings
stef

[kevin]

All boards have post censoring enabled.  You can thank for the dozens of spam bots that sign up and post for that! (ie. see board stat's) .   AFAIK It can't be selectively activated, it's either ON or OFF.   However, I've removed that keyword for now.

[Ian Price]

Just played it. Well, I say played...

It's a very good example of physics and interactions, but I haven't got a clue how to play it. Now if it was snooker or pool :)

[stef]

Hi!

For playing is only the code in codetank (Cramabol is a real existing type of billiards)

The "15 balls billards" is only "camouflage" of a physics-example (planned first to develope it to a pool simulation, but simplified it :))

Greetings
stef

[stef]

Hi!

This is "extreme billiards"  :) (physics demo)

PlayBASIC Code: [Select]

; PROJECT : extreme billiards
; AUTHOR  : stef
; CREATED : 20.08.2006
; EDITED  : 20.08.2006
; ---------------------------------------------------------------------
OpenScreen 800,600,16,2

;ScreenVsync On
;SetFPS 60

Global bs=300
Global sb#=30
Global table
Global cue
Global ball
Global ind

Global colldist#=sb#

Type tballs
   col
   image
   sprite
   deltax#,deltay#
   x#,y#
   sum#
   angle#
   speed#
   friction#
EndType
   
Global number= 15   ;16 ! balls
Dim ball(number) As tballs

imagedraw()

For ind =0 To number
ball(ind).friction#=0.999


ball(1).x#=100+300+300/2
ball(1).y#=130+300/2
For x=2 To 5
ball(x).x#=ball(x-1).x#+Sin(60)*sb#
ball(x).y#=ball(x-1).y#+Cos(60)*sb#
Next
For x = 6 To 9
   ball(x).x#=ball(x-4).x#
ball(x).y#=ball(x-4).y#-sb#
Next
For x = 10 To 12
   ball(x).x#=ball(x-3).x#
ball(x).y#=ball(x-3).y#-sb#
Next
For x = 13 To 14
   ball(x).x#=ball(x-2).x#
ball(x).y#=ball(x-2).y#-sb#
Next
For x = 15 To 15
   ball(x).x#=ball(x-1).x#
ball(x).y#=ball(x-1).y#-sb#
Next



Next
ball(0).x#=100+300/2;cueball
ball(0).y#=130+300/2

;---------------------------------------loop
Do

RenderToScreen
Cls RGB(0,0,0)

DrawImage table, 70,100,0
DrawAllSprites

CircleC MouseX(),MouseY(),3,1,RGB(255,0,0)

   If LeftMouseButton()=1 And PointHitSprite(MouseX(),MouseY(),ball(0).sprite)
      FlushMouse
      If ball(0).deltax#=0 And ball(0).deltay#=0
      hit=1
      EndIf
   EndIf
   
   If hit=1
      If GetDistance2D(MouseX(),MouseY(),ball(0).x#,ball(0).y#)>sb#/2
      If GetDistance2D(MouseX(),MouseY(),ball(0).x#,ball(0).y#)<50
         CircleC ball(0).x#,ball(0).y#,50,0,RGB(255,0,0)
      DrawRotatedImage cue,MouseX(),MouseY(),(GetAngle2D(MouseX(),MouseY(),ball(0).x#,ball(0).y#))-90,1,1,-5,-296,1      
      If LeftMouseButton()=1
         FlushMouse
         
      ball(0).speed#=GetDistance2D(MouseX(),MouseY(),ball(0).x#,ball(0).y#)*0.5
      ball(0).angle#=GetAngle2D(MouseX(),MouseY(),ball(0).x#,ball(0).y#)
      ball(0).deltax#=(Cos(ball(0).angle#))*ball(0).speed#
      ball(0).deltay#=(Sin(ball(0).angle#))*ball(0).speed#
      hit=0
   EndIf
EndIf

EndIf   
EndIf   
   
For ind=0 To number
      moveballs()
Next

print "FPS: "+str$(fps())      


Sync
Loop
WaitKey

Function imagedraw()

table=NewImage(600+60,300+60)
RenderToImage table
Cls RGB(80,30,20)

BoxC 20,20,640,340,1,RGB(90,90,90)
BoxC 30,30,630,330,1,RGB(0,0,120)
BoxC 30,30,630,330,0,RGB(0,30,0)


For y= 40 To 320 Step 10
   For x = 40 To 620 Step 10
CircleC x,y,2,1,RGB(50,50,50)
Next
Next


cue=GetFreeImage()
CreateFXImage cue,10,300
RenderToImage cue

TriC 0,0,5,600,10,0,RGB(100,80,50)
TriC 2,0,5,600,8,0,RGB(150,100,50)
TriC 4,0,5,600,6,0,RGB(200,150,50)
BoxC 3,296,7,300,1,RGB(50,50,155)


For ind =0 To number

ball(ind).image=GetFreeImage()
CreateFXImage ball(ind).image,bs,bs

Login required to view complete source code

[hatonastick]

Actually this would come in handy for the game I'm working on.  On a few levels there will be indestructable asteroids and I wanted them to ricochet off of each other.

[stef]

Hi hatonastick

Let your light shine! :)

PS. Some of my progs doesn't work properly any more.
The reason is the correction of the bug in command "GetAngle2D()" by Kevin.
Particularly the "roc and ufo2" codes would need changes.
But the only really interesting thing in tis codes is the particle engine.
Will probably use it in my newest creation "steam particle engine"

Greetings
stef

[stef]

Hi!

This will be the last code of billiards-series

I named it "Big Bang"

It's a Physics demo of collisions (including size and mass calculation)
(with "number=40" (41 balls) it makes 1804 collisionchecks every loop-turn)

Greetings
stef

PS.
Because it's my birthday I thought "Big Bang" goes well to this. :)

PlayBASIC Code: [Select]

; PROJECT : Big Bang
; AUTHOR  : stef
; CREATED : 25.08.2006
; EDITED  : 25.08.2006
; ---------------------------------------------------------------------

;Physics demo
;collision of objects 
;calculating size and mass

;click white ball, move mouse around, aim click again


OpenScreen 800,600,16,2

;ScreenVsync On
;SetFPS 60

Global bs=300

Global cue
Global ball
Global ind

Type tballs
   size#
   radius#
   mass#
   col
   image
   sprite
   deltax#,deltay#
   x#,y#
   sum#
   angle#
   speed#
   friction#
EndType
   
Global number= 40   
Dim ball(number) As tballs


; size of balls
For ind =1 To number
ball(ind).friction#=0.9999

ball(ind).size# = rndrange(10,50)
ball(ind).radius#= ball(ind).size#/2
next
ball(0).size# = 30
ball(0).radius#= 30/2


;mass of ball ( here is it related to size ; volum of sphere)
for x = 0 to number
   ball(x).mass#= 4/3*pi#*ball(x).radius#^3
next


;position of balls
for x = 1 to number
ball(x).x#=400
ball(x).y#=300
Next

ball(0).x#=100;cueball
ball(0).y#=500

imagedraw()

;---------------------------------------loop
Do

RenderToScreen
Cls RGB(0,0,0)


DrawAllSprites

CircleC MouseX(),MouseY(),3,1,RGB(255,0,0)

   If LeftMouseButton()=1 And PointHitSprite(MouseX(),MouseY(),ball(0).sprite)
      FlushMouse
      If ball(0).deltax#=0 And ball(0).deltay#=0
      hit=1
      EndIf
   EndIf
   
   If hit=1
      If GetDistance2D(MouseX(),MouseY(),ball(0).x#,ball(0).y#)>sb#/2
      If GetDistance2D(MouseX(),MouseY(),ball(0).x#,ball(0).y#)<50
         CircleC ball(0).x#,ball(0).y#,50,0,RGB(255,0,0)
      DrawRotatedImage cue,MouseX(),MouseY(),(GetAngle2D(MouseX(),MouseY(),ball(0).x#,ball(0).y#))-90,1,1,-5,-296,1      
      If LeftMouseButton()=1
         FlushMouse
         
      ball(0).speed#=GetDistance2D(MouseX(),MouseY(),ball(0).x#,ball(0).y#)*1
      ball(0).angle#=GetAngle2D(MouseX(),MouseY(),ball(0).x#,ball(0).y#)
      ball(0).deltax#=(Cos(ball(0).angle#))*ball(0).speed#
      ball(0).deltay#=(Sin(ball(0).angle#))*ball(0).speed#
      hit=0
   EndIf
EndIf

EndIf   
EndIf   
   
For ind=0 To number
      moveballs()
Next

print "FPS: "+str$(fps())      


Sync
Loop
WaitKey

Function imagedraw()


cue=GetFreeImage()
CreateFXImage cue,10,300
RenderToImage cue

TriC 0,0,5,600,10,0,RGB(100,80,50)
TriC 2,0,5,600,8,0,RGB(150,100,50)
TriC 4,0,5,600,6,0,RGB(200,150,50)
BoxC 3,296,7,300,1,RGB(50,50,155)


For ind =0 To number

ball(ind).image=GetFreeImage()
CreateFXImage ball(ind).image,bs,bs
RenderToImage ball(ind).image

For x=bs/2 To 0 Step -5
   

 r=rnd(1):g=rnd(1):b=rnd(1)

If ind=0 Then r=1:g=1:b=1

CircleC bs/2,bs/2-1,x,1,RGB((255-x)*r,(255-x)*g,(255-x)*b)
Next
ScaleImage ball(ind).image,ball(ind).size#,ball(ind).size#,1


Login required to view complete source code

[Ian Price]

Happy Birthday! :D

Excellent work btw (way too fast though - I'm getting over 247FPS!).

[kevin]

Lovely demo as always  and  Happy Birthday

[thaaks]

Happy Birthday, Stef!

Is the number of balls in any way related with your age??? Naaa, just kidding, no one is this old except me  ;D

Hope you have a nice party and a bunch of presents!

[empty]

Happy Birthday! :)