Pool

[Clanky]

AI as in, opponent AI - so you can choose 1 or 2 player?
Well, if that's it, that would be an awesome addition!!!
Cheers

[Stonemonkey]

I'm not totally certain but I think I've solved it for the way i've been working on the collisions.

The maths is the same as what I'd come up with before except I'm using it on the square root of the vectors now.

Freebasic code:

[Jim]

Time to plug it in to the yabasic code and see what it looks like!  But the conservation of momentum makes it look hopeful.

Jim

[Stonemonkey]

I'm having some problems with it like that, but seems ok if I go back to the method of just transferring the velocities along the normal but with the square root of the velocity vectors.

EDIT:
my mistake, works pretty well after all.

[Stonemonkey]

I've just been thinking about thi rainstorm:

Code: [Select]

dot_product = (cosine_a*cosine_b + sine_a*sine_b)

  angle = acos(dot_product)
  if (cos(angle < 0) then
    rem both balls are heading towards each other
  fi

and it's not quite right, both balls could be traveling in the same direction but at different speeds and still collide so it doesn't quite work out. What you have to do is find the speed of 1 ball relative to the other and then do the dot product with that and the vector between the 2 balls

dot_product=(cosine_b-cosine_a)*(ball_b_x-ball_a_x)+(sine_b-sine_a)*(ball_b_y-ball_a_y)

[rain_storm]

Thanks stonemonkey but I already spotted that I am now working out how to collide balls so that both can be considered in motion (not by moving them one at a time which was the old way I did it) the trick is to translate one of the balls vector against the others vector so that the other ball can be considered stationary (but its motion is still being considered as a subtraction to the moving balls vector) still workin that part out but this is what I have so far for the collisions (only one moving atm) speed of travel is irrelevant and collisions are still accurate : )

controls - move balls vector with up/down/left/right (both controllers)
the red balls are the destinations the unfilled circle is ball a's vector minus ball b's vector

Code: [Select]

sub distance(px,py, x1,y1, x2,y2)
  local dx,dy,clip_line
  dx = x2 - x1
  dy = y2 - y1
  clip_line = ((px-x1)*dx + (py-y1)*dy) / (dx*dx + dy*dy)
  closest_point_x = (x1 + clip_line*dx)
  closest_point_y = (y1 + clip_line*dy)
  dx = px - closest_point_x
  dy = py - closest_point_y
  return sqrt(dx*dx + dy*dy)
end sub
sub rnd(range)
  rnd$ = time$
  length = len(rnd$)
  local rnd$(length)
  static rnd, seed
  for l = 1 to length
    if (mid$(rnd$,l,1) = "-") then
      rnd$ = left$(rnd$,l-1) + " " + right$(rnd$,length-l)
    else
      rnd$ = left$(rnd$,l-1) + str$(9-val(mid$(rnd$,l,1))) + right$(rnd$,length-l)
    fi
  next l
  seed = ran(rnd)
  if (seed < 1) seed = range + 1
  random = token(rnd$, rnd$())
  for r = 1 to random rnd = val(rnd$(r)) + rnd next
  rnd = ran(rnd) / ran(seed)
  return range*frac(rnd)
end sub

open window 640, 512
window origin "cc"

ball_radius = 30
sum_radii = ball_radius + ball_radius
balls = 1
dim posx(balls), posy(balls)
dim momx(balls), momy(balls)
dim rotx(balls), roty(balls), rotz(balls)
dim newx(balls), newy(balls)

label start
  for a = 0 to balls
0   x = rnd(200) - rnd(200)
    y = rnd(200) - rnd(200)
    for b = 0 to a
    if (a <> b) then
      adjacent = posx(b) - x
      opposite = posy(b) - y
      distance = sqrt(adjacent*adjacent + opposite*opposite)
      if (distance <= sum_radii) goto 0
    fi
    next b
    posx(a) = x
    posy(a) = y
  next a
  wait 0.1

label loop
  setdispbuf draw
  draw = 1 - draw
  setdrawbuf draw
  clear window

  for a = 0 to balls
    setrgb 1, 000, 000, 255
    fill circle posx(a), posy(a), ball_radius
    setrgb 1, 255, 000, 000
    fill circle newx(a), newy(a), ball_radius
    setrgb 1, 255, 255, 000
    line posx(a), posy(a) to newx(a), newy(a)
  next a

  for a = 0 to balls
    posx_a = posx(a)
    posy_a = posy(a)
    momy_a = momy(a)
    rotz_a = rotz(a)
    dirx_a = cos(rotz_a)*momy_a
    diry_a = sin(rotz_a)*momy_a
    newx_a = posx_a + dirx_a
    newy_a = posy_a + diry_a
    travel = sqrt(dirx_a*dirx_a + diry_a*diry_a)
    hyp = travel
    for b = 0 to balls
    if (a <> b) then
      posx_b = posx(b)
      posy_b = posy(b)

'     find the distance and check if  a collision is possible
      adjacent = posx_b - posx_a
      opposite = posy_b - posy_a
      distance = sqrt(adjacent*adjacent + opposite*opposite)
      if (travel < distance-sum_radii) goto 1

'     check if the balls are heading towards each other
      dot_product = dirx_a*adjacent + diry_a*opposite
      if (dot_product <= 0) goto 1

'     find the closest point along vector to the center of ball
      closest = distance(posx_b,posy_b,posx_a,posy_a,newx_a,newy_a)
      if (closest > sum_radii) goto 1
      nx = closest_point_x
      ny = closest_point_y

'     find the point at which both surfaces just begin to touch
      contact = sqrt(sum_radii*sum_radii - closest*closest)
      minx_a = nx - cos(rotz_a)*contact
      miny_a = ny - sin(rotz_a)*contact

'     check that this is closer than any other collisions
      mx = minx_a - posx_a
      my = miny_a - posy_a
      min_dist = sqrt(mx*mx + my*my)
      if (min_dist < hyp) then
        newx_a = minx_a
        newy_a = miny_a
        hyp = min_dist
      fi
    fi
1   next b
    newx(a) = newx_a
    newy(a) = newy_a
  next a

  newx_a = newx(0) - (newx(1) - posx(1))
  newy_a = newy(0) - (newy(1) - posy(1))
  circle newx_a, newy_a, ball_radius

' controls
  p = peek("port1")
  if    (and(p,   16) <> 0) then momy(0) = momy(0) + 1
  elsif (and(p,   32) <> 0) then rotz(0) = rotz(0) + pi/360
  elsif (and(p,   64) <> 0) then momy(0) = momy(0) - 1
  elsif (and(p,  128) <> 0) then rotz(0) = rotz(0) - pi/360
  elsif (and(p,65535) <> 0) then goto start
  fi
  p = peek("port2")
  if    (and(p,   16) <> 0) then momy(balls) = momy(balls) + 1
  elsif (and(p,   32) <> 0) then rotz(balls) = rotz(balls) + pi/360
  elsif (and(p,   64) <> 0) then momy(balls) = momy(balls) - 1
  elsif (and(p,  128) <> 0) then rotz(balls) = rotz(balls) - pi/360
  elsif (and(p,65535) <> 0) then goto start
  fi
  goto loop

Edit :
 Position the red balls so that they overlap and you can see that the unfilled circle will also overlap the other ball

[rain_storm]

here is a better example nearly have these collisions perfected just that I have to remove the final overlap between both balls. I still dont know why this is happening the distance should have been corrected to bring both balls up to the position where the touch for the first time. Nearly there though ; )

Code: [Select]


sub distance(px,py, x1,y1, x2,y2)
  local dx,dy,clip_line
  dx = x2 - x1
  dy = y2 - y1
  clip_line = ((px-x1)*dx + (py-y1)*dy) / (dx*dx + dy*dy)
  closest_point_x = (x1 + clip_line*dx)
  closest_point_y = (y1 + clip_line*dy)
  dx = px - closest_point_x
  dy = py - closest_point_y
  return sqrt(dx*dx + dy*dy)
end sub
sub rnd(range)
  rnd$ = time$
  length = len(rnd$)
  local rnd$(length)
  static rnd, seed
  for l = 1 to length
    if (mid$(rnd$,l,1) = "-") then
      rnd$ = left$(rnd$,l-1) + " " + right$(rnd$,length-l)
    else
      rnd$ = left$(rnd$,l-1) + str$(9-val(mid$(rnd$,l,1))) + right$(rnd$,length-l)
    fi
  next l
  seed = ran(rnd)
  if (seed < 1) seed = range + 1
  random = token(rnd$, rnd$())
  for r = 1 to random rnd = val(rnd$(r)) + rnd next
  rnd = ran(rnd) / ran(seed)
  return range*frac(rnd)
end sub

open window 640, 512
window origin "cc"

ball_radius = 30
sum_radii = ball_radius + ball_radius
balls = 1
dim posx(balls), posy(balls)
dim momx(balls), momy(balls)
dim rotx(balls), roty(balls), rotz(balls)
dim newx(balls), newy(balls)

label start
  for a = 0 to balls
0   x = rnd(200) - rnd(200)
    y = rnd(200) - rnd(200)
    for b = 0 to a
    if (a <> b) then
      adjacent = posx(b) - x
      opposite = posy(b) - y
      distance = sqrt(adjacent*adjacent + opposite*opposite)
      if (distance <= sum_radii) goto 0
    fi
    next b
    posx(a) = x
    posy(a) = y
  next a
  wait 0.1

label loop
  setdispbuf draw
  draw = 1 - draw
  setdrawbuf draw
  clear window

  for a = 0 to balls
    setrgb 1, 000, 000, 255
    fill circle posx(a), posy(a), ball_radius
    setrgb 1, 255, 000, 000
    fill circle newx(a), newy(a), ball_radius
    setrgb 1, 255, 255, 000
    line posx(a), posy(a) to newx(a), newy(a)
  next a

  for a = 0 to balls
    posx_a = posx(a)
    posy_a = posy(a)
    momy_a = momy(a)
    rotz_a = rotz(a)
    dirxa = cos(rotz_a)*momy_a
    dirya = sin(rotz_a)*momy_a
    newxa = posx_a + dirxa
    newya = posy_a + dirya
    travela = sqrt(dirxa*dirxa + dirya*dirya)
    hyp = travela
    for b = 0 to balls
    if (a <> b) then
      posx_b = posx(b)
      posy_b = posy(b)

      momy_b = momy(b)
      rotz_b = rotz(b)
      dirx_b = cos(rotz_b)*momy_b
      diry_b = sin(rotz_b)*momy_b
      dirx_a = dirxa - dirx_b
      diry_a = dirya - diry_b
      newx_a = posx_a + dirx_a
      newy_a = posy_a + diry_a
      travel_a = sqrt(dirx_a*dirx_a + diry_a*diry_a)

'     find the distance and check if  a collision is possible
      adjacent = posx_b - posx_a
      opposite = posy_b - posy_a
      distance = sqrt(adjacent*adjacent + opposite*opposite)
      if (travel_a < distance-sum_radii) goto 1

'     check if the balls are heading towards each other
      dot_product = dirx_a*adjacent + diry_a*opposite
      if (dot_product <= 0) goto 1

'     find the closest point along vector to the center of ball
      closest = distance(posx_b,posy_b,posx_a,posy_a,newx_a,newy_a)
      if (closest > sum_radii) goto 1
      nx = closest_point_x
      ny = closest_point_y

'     find the point at which both surfaces just begin to touch
      contact = sqrt(sum_radii*sum_radii - closest*closest)
      minx_a = nx - cos(rotz_a)*contact
      miny_a = ny - sin(rotz_a)*contact

'     check that this is closer than any other collisions
      mx = minx_a - posx_a
      my = miny_a - posy_a
      min_dist = sqrt(mx*mx + my*my)
      if (min_dist < hyp) then
        dist = min_dist/travel_a
        newxa = posx_a + cos(rotz_a)*momy_a*dist
        newya = posy_a + sin(rotz_a)*momy_a*dist
        hyp = min_dist
      fi
    fi
1   next b
    newx(a) = newxa
    newy(a) = newya
  next a

  newx_a = newx(0) - (newx(1) - posx(1))
  newy_a = newy(0) - (newy(1) - posy(1))
  circle newx_a, newy_a, ball_radius

' controls
  p = peek("port1")
  if    (and(p,   16) <> 0) then momy(0) = momy(0) + 1
  elsif (and(p,   32) <> 0) then rotz(0) = rotz(0) + pi/360
  elsif (and(p,   64) <> 0) then momy(0) = momy(0) - 1
  elsif (and(p,  128) <> 0) then rotz(0) = rotz(0) - pi/360
  elsif (and(p,65535) <> 0) then goto start
  fi
  p = peek("port2")
  if    (and(p,   16) <> 0) then momy(balls) = momy(balls) + 1
  elsif (and(p,   32) <> 0) then rotz(balls) = rotz(balls) + pi/360
  elsif (and(p,   64) <> 0) then momy(balls) = momy(balls) - 1
  elsif (and(p,  128) <> 0) then rotz(balls) = rotz(balls) - pi/360
  elsif (and(p,65535) <> 0) then goto start
  fi
  goto loop




[rain_storm]

I have to abandon the above technique there is a glitch in my interpretation of the algorithm and I simply cannot root it out and it has taken up too much time (I got other proggys on the go including 20 secs compo). It's a major bummer because my own technique will require that the balls all be moved by an amount that is less than the radius where as the above could handle anything (if it were done right) I really can't get it workin so there is no other option left
I feel disappointed but its the best choice, at least things will be moving foward instead of hitting the same brick wall time and again. I think I was a bit too ambitious and the new technique was very much over my head at least I can understand my own solution if things get buggy

[Shockwave]

I felt a bit like that when I was converting Battlezone to Yabasic sometimes, but I have a feeling that you will crack this problem sooner or later. Remember that it's not always possible to get it right first time, you'll find a way.

[GrahamK]

I've written a full pool game, and you are certanly going about it in the correct way for collision.

Part of the secret to this (and sorry if someone else has talked about it, I've not been through the full thread), is down to slicing the time up.
one way is to break the calculation into very small time spans, recalculate the ball positions, collision check then repeat, this means the balls move in very small steps (so you end up with movements which would be less than the radius). This can then be optimised, because it's only important for the collision part. So, if you can calculate how long it would take for the first collision to take place, you can jump that many slices and continue from there.


While you are working on your 20second intro, I'll see if I can dig out some code/links for you. Afraid it won't be in yabasic, but I can see what I can come up with if it helps.

[rain_storm]

Are the vectors shortened for all moving balls? Such that only one collision happens at a time unless two collisions occur simultaeniously? Also are collisions with the bunkers treated in the same fashion. This is an interesting approach and cleans up the whole bussiness of a ball being overlapped by another ball just because it happened to be too close to the collision (like in the pack) I dont mind that the code isn't Yabasic as long as it is in some form basic I should be able to makeuse of it?

[GrahamK]

yeah, generally consider all collisions as the same, ball-ball and ball-sides.
If something is moving at 10 units per second, you would just consider it as 1 unit per 10th so everything would be divided by 10. It may need a smaller step but you have to balance that against how many calculations you perform. The smaller the step, the less chance of simultanious collisions (which is the perfect situation).

If you do happen to have multiple collisions, I did something like this.
1) Loop through balls finding first collision,
2) resolve that collision
3) go back and loop through the balls from the beginning again.
It can get a bit deadlooped there, which you can usually check for (and for example, ignore something that's already been resolved once).

If you get it working well with these timesteps, you can put in the optimization, which is along the lines of
1) Loop through each ball
2) see if it's possible for this to collide with edges (speed vector line/ edge line intersection), add collision point / distance to a list of collisions
3) compare with all other balls (speed vector line / speed vector line intersection), add collision point / distance to a list of collisions
4) distance between current position and collision position indicates how long it would take for that collision to take place
5) repeat for each ball
6) List of collisions should show which one is first, and therefore how long the step needs to be (instead of the fixed time above)
7) resolve this first collision, and go back to 1 (although this can be optimized to say only recalculate the balls effected in the collision)
This is obviously using lines for simplicity, but it's not too much work to make it a little more fuzzy to include the ball radius.

[rain_storm]

Thanks GrahamK thats sounds solid i think I will do the loop once to detect collisions and just determine which happens first. then once the loop completes start a new loop to update all positions
Well this is what I have to work with, my own solution where only one ball moves at a time movement is limited to less than radius but momentum is conserved and trajectories look good. I will include you're suggestions asap. And thanks for the help really good idea and well explained 

Code: [Select]

open window 640, 512
window origin "cc"

holes = 5
dim hx(holes), hy(holes)
data -280,-140, 000,-140, 280,-140
data -280, 140, 000, 140, 280, 140
for a = 0 to holes read hx(a), hy(a) next

colrs = 3
dim red(colrs), grn(colrs), blu(colrs)
data 255,255,255, 255,255,000, 255,000,000, 100,100,100
for a = 0 to colrs read red(a), grn(a), blu(a) next

fric = 0.999
damp = 0.990
bump = 0.900
radi = 10
hradi = radi*1.5
sum_radi = (radi+radi)^2
sum_hradi = hradi^2
minx = -270
miny = -130
maxx =  270
maxy =  130

label setup
  balls = 15
  redim posx(balls), posy(balls)
  redim dirx(balls), diry(balls)
  redim colr(balls)

  for a = 0 to balls
    colr(a) = mod(a,2)+1
    dirx(a) = ran(5) - ran(5)
    diry(a) = ran(5) - ran(5)
00  posx(a) = ran(200) - ran(200)
    posy(a) = ran(100) - ran(100)
    for b = 0 to a
      if (a <> b) then
        adj = posx(b) - posx(a)
        opp = posy(b) - posy(a)
        hyp = adj^2 + opp^2
        if (hyp < sum_radi) goto 00
      fi
    next
  next
  colr(0) = 0
  colr(balls) = 3
  motionless = 0

label main
  setdispbuf draw
  draw = 1 - draw
  setdrawbuf draw
  clear window
  if (and(peek("port1"),16384) <> 0) goto setup

  setrgb 1, 000, 100, 000
  fill box minx-radi, miny-radi to maxx+radi, maxy+radi
  setrgb 1, 255,255,255
  for a = 0 to holes circle hx(a), hy(a), hradi next
  for a = 0 to balls
    for b = 1.0 to 0.1 step -0.1
      setrgb 1, red(colr(a))*(1-b), grn(colr(a))*(1-b), blu(colr(a))*(1-b)
      fill circle posx(a), posy(a), radi*b
    next
  next

  if (motionless = balls) goto setup
  motionless = 0
  for a = 0 to balls
    if (dirx(a)^2 + diry(a)^2 > 0.00001) then
      dxa = dirx(a)*fric
      dya = diry(a)*fric
      pxa = posx(a)
      pya = posy(a)
      for b = a+1 to balls
        adj = posx(b) - pxa
        opp = posy(b) - pya
        dist = adj^2 + opp^2
        if (dist < sum_radi) then
          dist = sqrt(dist)
          nx = adj / dist
          ny = opp / dist

          cx = (pxa+posx(b))/2
          cy = (pya+posy(b))/2
          pxa = cx - nx*radi
          pya = cy - ny*radi
          posx(b) = cx + nx*radi
          posy(b) = cy + ny*radi

          product = ((dirx(b)-dxa)*nx + (diry(b)-dya)*ny) * damp
          sx = nx * product
          sy = ny * product
          dxa = dxa + sx
          dya = dya + sy
          dirx(b) = dirx(b) - sx
          diry(b) = diry(b) - sy
        fi
      next

      pxa = pxa + dxa
      pya = pya + dya
      if    (pxa < minx) then
        pxa =  minx
        dxa = -dxa*bump
        dya =  dya*bump
      elsif (pxa > maxx) then
        pxa =  maxx
        dxa = -dxa*bump
        dya =  dya*bump
      fi
      if    (pya < miny) then
        pya = miny
        dxa =  dxa*bump
        dya = -dya*bump
      elsif (pya > maxy) then
        pya =  maxy
        dxa =  dxa*bump
        dya = -dya*bump
      fi

      posx(a) = pxa
      posy(a) = pya
      dirx(a) = dxa
      diry(a) = dya

      for b = 0 to holes
        adj = pxa - hx(b)
        opp = pya - hy(b)
        if (adj^2 + opp^2 < sum_hradi) then
          for c = a to balls-1
            posx(c) = posx(c+1)
            posy(c) = posy(c+1)
            dirx(c) = dirx(c+1)
            diry(c) = diry(c+1)
            colr(c) = colr(c+1)
          next
          balls = balls - 1
        fi
      next
    else motionless = motionless + 1
    fi
  next
  goto main




[GrahamK]

Glad I can be of some help.

I've done a bit of code, I may be able to post it tomorrow.

[Tetra]

I've made a picture to aid what Graham had to say.

Heres my interpritation.
The red ball has moved a certain amount (say 100 units) from frame 1 to frame 2. a certain amount of time has aslo passed between frame 1 and frame 2 ( t1 + t2  say 0.1s). At somepoint between frame 1 and frame 2 the red ball has hit the black ball.

So in the calculation, you loop through from frame 1 to frame 2 by 1 unit at a time until you find the point the red ball touches the black ball. That means, it takes a total time of t1 before the ball hits the black ball. the remaining time is t2 and thats how long the black ball has to travel before being in the correct place at frame 2,

Heres the pic to go with the text. Its not very accurate, but it shows the principal of what should happen

[GrahamK]

Yep, that's about it.

I've managed to get some code working which shows collision response etc. I'll post it later on (In Cobra I'm afraid, but reasonably readable... I'm biased tho )

[JumpMan]

here is a pool game with source in c and ogl. Maybe it can help.
another pool game

[GrahamK]

ok, here you go... Not as well commented as I'd hoped, but I'll try and answer any questions.
I've included an exe and the source here as this won't compile under the demo of cobra.

It's not perfect, as there are a few niggles in the collision response (no comments about sticky balls!), but I hope it helps.
Only thing which isn't described, is that Cobra has a command LineIntersectPt, which takes two lines (4 coordinates) and tells you if they intersect, and where. The other helpful command is pointdistance, which just returns the distance between two points. Other than that, most of the rest should convert reasonably simply.

Main bits of handy code are in Iteration, and ballballcollision.

Code: [Select]

program
  uses pure2d,keyset                                   
 
const
    rad=10
    preserve=0.9 // amount of energy preserved after collision
 
type aball=record
    x,y:real
    dx,dy:real
    col:integer
endtype

type intersect=record
    b1,b2:^aball
    wall:integer
    x,y:real   
    count:integer=255
endtype
 
procedure ReDrawScreen
var
    ball:^aball
    coll:^intersect
begin
    ////writelog('Redraw')
    Rectc(100,50,700,550,ToRGBA(255,255,255),FALSE)
    Rectc(100+rad,50+rad,700-rad,550-rad,ToRGBA(100,100,100),FALSE)

    loop ball through balls
        ellipse(ball.x,ball.y,rad,rad,ball.col,false)   
    endloop

    loop ball through balls
        Line(ball.x,ball.y,ball.x+ball.dx,ball.y+ball.dy,ToRGBA(0,255,255))   
    endloop
       
    loop coll through collisions
        Rect(coll.x-4,coll.y-4,9,9,ToRGBA(0,coll.count,0),FALSE)
        coll.count = coll.count-1
        if coll.count<0 then free(coll)
    endloop

end


procedure Init
var
    ball:^aball
begin
        ball = newitem(balls)
        ball.x = Rand(120,680)
        ball.y = Rand(70,530)
        ball.dx = Rnd(-50,50)
        ball.dy = Rnd(-50,50)
        ball.col = ToRGBA(255,255,255)
end

procedure CreateBalls(count:integer=10)
var
    ball,b2:^aball
    ok : boolean
    x,y:real
begin
    while count >0
        ok = false
        while not ok
            x = Rand(120,680)
            y = Rand(70,530)
                   
            ok = true
            // keep balls apart no overlap
            loop b2 through balls
                if sqrt((b2.x-x)*(b2.x-x)+(b2.y-y)*(b2.y-y)) < 50 then ok = false                         
            endloop
        wend
           
            ball = newitem(balls)
            ball.col = ToRGBA(255,0,0)
            ball.x=x
            ball.y=y

            ball.dx = Rnd(-10,10)
            ball.dy = Rnd(-10,10)
           
           
        dec(count)
    wend

end

procedure BallWallCollision(b:^aball,wall:integer,cx,cy:real,tstep:real=0.1)
var
    cdist,tdist,prop:real
    dx,dy:real
begin
    // walls are easy as they act purely mirrors, and don't react to the impact
    // should really do sphere to plane collision, but too lazy in this version
    ////writelog('Collision: in ('+b.dx+','+b.dy+')')
   
    // first work out how far into the move the collision occured, needed to calc new position
    tdist = Sqrt((b.dx*b.dx)+(b.dy*b.dy))*tstep
    dx = cx-b.x
    dy = cy-b.y
    cdist = Sqrt((dx*dx)+(dy*dy))
    if tdist = cdist then
        prop = 0
    else
        prop = 1-(cdist/tdist)
    endif
   
    if (wall <2) then // horizontal walls
        b.dy=-(b.dy*preserve)       
    else         
        b.dx=-(b.dx*preserve)
    endif     
    //writelog('Collision: tdist ('+tdist+') cdist('+cdist+') prop('+(prop)+')')
    // reposition ball at collision point, then move it out by amount Left after the collision
    b.x = cx + (b.dx * prop)
    b.y = cy + (b.dy * prop)
end

procedure BallBallCollision(b1,b2:^aball,substep:real)
var
    b1sx,b1sy,b2sx,b2sy,mb1,mb2,mt:real // speeds
    vel1,vel2:real
    mv,vm,mt2,ep,fac:real;
    b1tob2vx,b1tob2vy:real // vector between balls
    b1uvectorX,b1uvectory:real // normal speed vector
    cosine,mvcosine:real
begin

      // calculate ball/ball collision
      // Move balls to collision positions,
          b1.x = b1.x+(b1.dx*substep)
          b1.y = b1.y+(b1.dy*substep) 
                           
          b2.x = b2.x+(b2.dx*substep)
          b2.y = b2.y+(b2.dy*substep)         
      //calculate the new speeds for both
     
      b1SX = b1.dx
  b1Sy =b1.dy

    b2SX = b2.dx
  b2Sy = b2.dy
     
      vel1 = Sqrt((b1sx*b1sx)+(b1sy*b1sy))
      vel2 = Sqrt((b2sx*b2sx)+(b2sy*b2sy))
                                 
      mb1=vel1
  mb2=vel2
  mt = mb1+mb2
     
      //   subtract second ball speed from first
b1sx = b1sx - b2sx
b1sy = b1sy - b2sy

    // calculate magnitude
mv = Sqrt((b1sx*b1sx)+(b1sy*b1sy))
    if mv = 0 then mv = 0.00001 // trap for div 0 case

// calculate vector between balls
b1tob2vX = b2.x - b1.x
b1tob2vy = b2.y - b1.y
   
    //normalise vector between balls
vm = Sqrt((b1tob2vx*b1tob2vx)+(b1tob2vy*b1tob2vy))
    if vm = 0 then vm = 0.00001
     
b1tob2vX = b1tob2vx / vm
b1tob2vy = b1tob2vy / vm
   
    // create a normal of the speed vector
b1uvectorX = b1sx / mv
b1uvectory = b1sy / mv
   
    // create dot product
cosine = (b1uvectorx*b1tob2vx)+(b1uvectory*b1tob2vy)
mvcosine = cosine * mv
   
    //multiply interball vector
b1tob2vx=b1tob2vx*mv
b1tob2vy=b1tob2vy*mv

    //subtract from speed vector
b1sx = b1sx - b1tob2vx
b1sy = b1sy - b1tob2vy

    //add ball 2's speed back to 1
b1sx = b1sx + b2sx
b1sy = b1sy + b2sy
 
    //and add new speed to ball 2's
b2sx = b2sx + b1tob2vx
b2sy = b2sy + b1tob2vy
   
    vel1 = Sqrt((b1sx*b1sx)+(b1sy*b1sy))
Vel2 = Sqrt((b2sx*b2sx)+(b2sy*b2sy))
mt2 = vel1 + vel2
   
    If mt2 <> mt Then
//rescale momentum to correct rounding errors
ep=preserve // amount of energy preserved
fac = ((mt*ep)/mt2)
fac = fac * fac

    b1sx = b1sx * fac
b1sy = b1sy * fac
b2sx = b2sx * fac
b2sy = b2sy * fac
   
    // now reset internal vectors
b1.dx = b1sx
    b1.dy = b1sy
    b2.dx = b2sx
    b2.dy = b2sy
   

end

procedure Iteration(timestep:real=0.1)
var
    b1,b2:^aball       
    x1,x2,y1,y2,dx,dy:real
    x1c,x2c,y1c,y2c,dxc,dyc:real
    ix,iy:real
    coll:boolean
    ccount:integer 
    substep:real
begin
    b1 = firstitem(balls)
    ////writelog('In Collision: ('+b1.dx+','+b1.dy+')')
   


    loop b1 through balls
                                       
   
      if ((b1.dx*b1.dx)+(b1.dy*b1.dy)) < 0.0001 then
            b1.dx = 0
            b1.dy = 0
      endif
     
       
      if (b1.dx<>0) or (b1.dy<>0) then
        // only process moving balls     
        x1 = b1.x
        y1 = b1.y   
        dx = (b1.dx*timestep)
        dy = (b1.dy*timestep) 
        x2 = b1.x+dx
        y2 = b1.y+dy
                                       
        cleartype(b2)
        ccount= 0       
        // check against walls (cheat.. move walls in by radius, takes care of fuzz automatically 
        coll=LineIntersectPt(x1,y1,x2,y2,100+rad,50+rad,700-rad,50+rad,ix,iy)
        if coll then
            addintersect(b1,b2,ix,iy,0)
            ballwallcollision(b1,0,ix,iy,timestep)
            inc(ccount)
        else
          coll=LineIntersectPt(x1,y1,x2,y2,100+rad,550-rad,700-rad,550-rad,ix,iy)
          if coll then
              addintersect(b1,b2,ix,iy,1)
              ballwallcollision(b1,1,ix,iy,timestep)
              inc(ccount)
          else
            coll=LineIntersectPt(x1,y1,x2,y2,100+rad,50+rad,100+rad,550-rad,ix,iy)
            if coll then
                addintersect(b1,b2,ix,iy,2)
                ballwallcollision(b1,2,ix,iy,timestep)
                inc(ccount)
            else
              coll=LineIntersectPt(x1,y1,x2,y2,700-rad,50+rad,700-rad,550-rad,ix,iy)
              if coll then
                  addintersect(b1,b2,ix,iy,3)
                  ballwallcollision(b1,3,ix,iy,timestep)
                  inc(ccount)
              endif
            endif
          endif
        endif
       
        if ccount = 0 then // no wall collisions, so we'll step through the other balls looking for collision

            loop b2 through balls
                if not (b1 = b2) then // don't check collisions with yourself silly!
                    x1c = b2.x
                    y1c = b2.y
                    dxc = (b2.dx*timestep)
                    dyc = (b2.dy*timestep) 
                   
                    coll = false
                   
                    // perform a simple 'swept sphere' type calculation (there is better maths, but it should work)
                    // number of iterations is up to you, the more you do the better the accuracy (I'm doing 30)
                    substep = 0
                    while (substep <= timestep) and (not coll)
                        //if distance between two centers is < 2 x Radius, they've collided.
                        if PointDistance(x1+(dx*substep),y1+(dy*substep),x1c+(dxc*substep),y1c+(dyc*substep)) < (rad*2) then
                            coll=true
                            ix = ((x1+(dx*substep)) + (x1c+(dxc*substep)))/2   
                            iy = ((y1+(dy*substep)) + (y1c+(dyc*substep)))/2   
                        else
                            substep = substep + (timestep/30)
                        endif                                           
                    wend
                   
                    if coll then
                        addintersect(b1,b2,ix,iy,3)
                        BallBallCollision(B1,b2,substep)                         
                    endif
                   
                endif
            endloop 
                 
       
       
        endif
       

        if ccount = 0 then // collision reaction covers movement in case of collisions   
            b1.x = b1.x+(b1.dx*timestep)
            b1.y = b1.y+(b1.dy*timestep)
        else
            ////writelog('Collision: out2 ('+b1.dx+','+b1.dy+')')
        endif

     endif
     
    endloop



end

procedure AddIntersect(b1,b2:^aball,x,y:real,wall:integer)
var
    coll:^intersect
begin
    coll = newitem(collisions)
    coll.b1 = b1
    coll.b2 = b2
    coll.wall = wall
    coll.x = x     
    coll.y = y
end

var
    balls : list of aball
    collisions: list of intersect
    ball:^aball
 
begin
  OpenScreen(800,600,32,FALSE,5)     
 
  Randomize
             
  init
  createballs(10)
 
  while (not keydown(vk_escape)) and (not ExitRequested)
    cls
    Iteration(0.05)
    redrawscreen
    flip
  wend
 
  closescreen
end



[rain_storm]

Thanks GrahamK I will give it a look through, Well here is the current state of the collisions there doesn't seem to be any bugs in here still keepin the balls speed under 1 radius per frame but to tell you the truth I dont think it needs to be any faster than this. At full speed the pack breaks preatty well and scatters them all around the table.

controls
left/right = aim
down = increase power
up = reduce power
X = shoot

Code: [Select]

open window 640, 512
window origin "cc"

holes = 5
dim hx(holes), hy(holes)
data -280,-140, 000,-140, 280,-140
data -280, 140, 000, 140, 280, 140
for a = 0 to holes read hx(a), hy(a) next

colrs = 3
dim red(colrs), grn(colrs), blu(colrs)
data 255,255,255, 255,255,000, 255,000,000, 100,100,100
for a = 0 to colrs read red(a), grn(a), blu(a) next

fric = 0.998
damp = 0.991
bump = 0.950
radi = 12
hradi = radi*1.5
sum_radi = (radi+radi)^2
sum_hradi = hradi^2
minx = -270
miny = -130
maxx =  270
maxy =  130

label setup
  balls = 15
  redim posx(balls), posy(balls)
  redim dirx(balls), diry(balls)
  redim colr(balls)
  restore setup_balls
  for a = 0 to balls
    colr(a) = mod(a,2)+1
    dirx(a) = 0
    diry(a) = 0
    read posx(a), posy(a)
  next
  dirx(0) = ran(10)
  colr(0) = 0
  colr(balls) = 3
  motionless = balls+1

label main
  setdispbuf draw
  draw = 1 - draw
  setdrawbuf draw
  clear window
  setrgb 1, 000, 100, 000
  fill box minx-radi, miny-radi to maxx+radi, maxy+radi
  setrgb 1, 255,255,255
  for a = 0 to holes circle hx(a), hy(a), hradi next
  for a = 0 to balls
    for b = 1.0 to 0.1 step -0.1
      setrgb 1, red(colr(a))*(1-b), grn(colr(a))*(1-b), blu(colr(a))*(1-b)
      fill circle posx(a), posy(a), radi*b
    next
  next
  if (motionless > balls) then
    ctrl(peek("port1"))
  else
    force = 0
    angle = 0
    motionless = 0
    collisions()
  fi
  goto main

sub ctrl(c)
  if    (and(c, 32) <> 0) then
    angle = angle + pi / 4096
  elsif (and(c,128) <> 0) then
    angle = angle - pi / 4096
  fi
  if    (and(c, 16) <> 0) then
    force = force - 0.01
    if (force < 0) force = 0
  elsif (and(c, 64) <> 0) then
    force = force + 0.01
    if (force > radi) force = radi
  fi

  if (and(c,16384) <> 0) then
    dirx(0) = cos(angle)*force
    diry(0) = sin(angle)*force
    motionless = 1
  else
    x = posx(0)
    y = posy(0)
    cs = cos(angle)*force
    sn = sin(angle)*force
    ct = cos(angle+pi/2)
    tn = sin(angle+pi/2)
    x1 = x - cs*10
    y1 = y - sn*10
    x2 = x1 - cos(angle)*200
    y2 = y1 - sin(angle)*200
    setrgb 1, 255, 255, 255
    line x,y to x+cs*30,y+sn*30
    setrgb 1, 255, 220, 180
    fill triangle x1+ct*2,y1+tn*2 to x2+ct*5,y2+tn*5 to x2-ct*5,y2-tn*5
    fill triangle x1+ct*2,y1+tn*2 to x1-ct*2,y1-tn*2 to x2-ct*5,y2-tn*5
  fi
end sub

sub collisions()
  for a = 0 to balls
    if (dirx(a)^2 + diry(a)^2 > 0.0001) then
      dxa = dirx(a)*fric
      dya = diry(a)*fric
      pxa = posx(a)
      pya = posy(a)
      for b = 0 to balls
        if (a <> b) then
          adj = posx(b) - pxa
          opp = posy(b) - pya
          dist = adj^2 + opp^2
          if (dist < sum_radi) then
            dist = sqrt(dist)
            nx = adj / dist
            ny = opp / dist

            cx = (pxa+posx(b))/2
            cy = (pya+posy(b))/2
            pxa = cx - nx*radi
            pya = cy - ny*radi
            posx(b) = cx + nx*radi
            posy(b) = cy + ny*radi

            product = ((dirx(b)-dxa)*nx + (diry(b)-dya)*ny) * damp
            sx = nx * product
            sy = ny * product
            dxa = dxa + sx
            dya = dya + sy
            dirx(b) = dirx(b) - sx
            diry(b) = diry(b) - sy
          fi
        fi
      next

      pxa = pxa + dxa
      pya = pya + dya
      if    (pxa < minx) then
        pxa =  minx
        dxa = -dxa*bump
        dya =  dya*bump
      elsif (pxa > maxx) then
        pxa =  maxx
        dxa = -dxa*bump
        dya =  dya*bump
      fi
      if    (pya < miny) then
        pya = miny
        dxa =  dxa*bump
        dya = -dya*bump
      elsif (pya > maxy) then
        pya =  maxy
        dxa =  dxa*bump
        dya = -dya*bump
      fi

      posx(a) = pxa
      posy(a) = pya
      dirx(a) = dxa
      diry(a) = dya

      for b = 0 to holes
        adj = pxa - hx(b)
        opp = pya - hy(b)
        if (adj^2 + opp^2 < sum_hradi) then
          col = colr(a)
          for c = a to balls-1
            posx(c) = posx(c+1)
            posy(c) = posy(c+1)
            dirx(c) = dirx(c+1)
            diry(c) = diry(c+1)
            colr(c) = colr(c+1)
          next
          posx(balls) = pxa
          posy(balls) = pya
          dirx(balls) = dxa
          diry(balls) = dya
          colr(balls) = col
          balls = balls - 1
        fi
      next
    else motionless = motionless + 1
    fi
  next
end sub

label setup_balls
data -140,000
data  100,000, 120,010, 140,-20, 120,-10, 140,020
data  160,-30, 160,010, 160,030, 180,000, 160,-10
data  180,-40, 180,-20, 180,040, 180,020, 140,000



[Clanky]

Very Nice rain!!! 
Is that the final, or just a visual collision simulation?