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


discern Collider.bas
08-31-2017, 12:02 PM
Post: #1
 (Print Post)
discern Collider.bas
Well this works well when 2 balls are equal distant from future point of collision and they close in on each other at equal angles. (No mass therefore no momentum, speed remains constant.)

Code Snippet: [Select]
'discern Collider.bas SmallBASIC 0.12.9 (B+=MGA) 2017-08-29

'center screen
cx = xmax/2  'the ball directions will go to here, the center
cy = ymax/2
startDistance = ymax/2 - 30

'both balls
r = 25  'radius
s = 10  'speed


for a1 = 0 to pi step pi/12
  for a2 = pi to 2*pi step pi/12
  
  cls
  ? int(deg(a1)), int(deg(a2))
  b1x = cx + startDistance * cos(a1)
  b1y = cy + startDistance * sin(a1)
  b2x = cx + startDistance * cos(a2)
  b2y = cy + startDistance * sin(a2)
  b1a = atan2(cy - b1y, cx - b1x)
  if b1a < 0 then b1a = b1a + 2*pi
  b2a = atan2(cy - b2y, cx - b2x)
  if b2a < 0 then b2a = b2a + 2*pi

  clrMode = 1  'track ball
  while sqr((b1x - cx)^2 + (b1y - cy)^2) <= startDistance + .5
    k = INKEY
    IF LEN(k) THEN
      IF ASC(k) = 32 THEN clrMode = -1 * clrMode
      IF ASC(k) = 27 AND LEN(k) = 1 THEN
        END
      fi
    END IF
    IF clrMode < 0 THEN CLS
    
    separation = SQR((b1x - b2x) ^ 2 + (b1y - b2y) ^ 2)
    IF separation < 2*r THEN
      redArrow = ATAN2(b2y - b1y, b2x - b1x)
      if redArrow < 0 then redArrow = redArrow + 2*pi
      
      blueArrow = ATAN2(b1y - b2y, b1x - b2x)  'for ball j
      if blueArrow < 0 then blueArrow = blueArrow + 2*pi
      
      fixGap = 50 - separation + 2 'can't have balls on top of each other
      'fixGap b1y separating balls otherwise the new angles will cause
      ' balls to wrap around each other as if mating
      ' don't believe me? comment next 4 lines out!!!
      'DO THIS BEFORE calculating collsion angles!!!
      b1x = b1x + .5*fixGap * COS(blueArrow)
      b1y = b1y + .5*fixGap * SIN(blueArrow)
      b2x = b2x + .5*fixGap * COS(redArrow)
      b2y = b2y + .5*fixGap * SIN(redArrow)
      
     'recalc arrows
      redArrow = ATAN2(b2y - b1y, b2x - b1x)
      if redArrow < 0 then redArrow = redArrow + 2*pi
      
      blueArrow = ATAN2(b1y - b2y, b1x - b2x)  'for ball j
      if blueArrow < 0 then blueArrow = blueArrow + 2*pi
      
      gt = 0
      ' angle in = difference of ball direction and perp on contact ball side
      if blueArrow > b1a then diff = blueArrow - b1a : gt = 1 else diff = b1a - blueArrow
      
      ' angle out = add difference to perp on ball side of tangent
      ' DO NOT change from redArrow direction b1y more than pi/2, 90 degrees!
      'if abs(diff) <= pi then
        if gt then b1a = redArrow + diff else b1a = redArrow - diff
      'else
      '  b1a = redArrow - diff/2
      '  color 15
      '  circle cx, cy, startdistance
      'fi
      color rgb(128, 0, 0)
      arrow b1x, b1y, redArrow, 150
      gt = 0
      'j ball's  new angle calc like i's
      if redArrow > b2a then diff = redArrow - b2a : gt = 1  else diff = b2a - redArrow
      'if abs(diff) <= pi  then
        if gt then b2a = blueArrow + diff else b2a = blueArrow - diff
      'else
      '  b2a = blueArrow - diff/2
      'fi
      color rgb(0, 0, 128)
      arrow b2x, b2y, blueArrow, 150
      hit = 1
      color rgb(255, 255, 0)
      circle b1x, b1y, r
      arrow b1x, b1y, b1a, 100
      color rgb(0, 255, 255)
      circle b2x, b2y, r
      arrow b2x, b2y, b2a, 100
      delay 500
    END IF

    b1x = b1x + s*cos(b1a)
    b1y = b1y + s*sin(b1a)
    
    b2x = b2x + s*cos(b2a)
    b2y = b2y + s*sin(b2a)
    
    color 12
    circle b1x, b1y, r
    'arrow b1x, b1y, b1a, 100
    color 9
    circle b2x, b2y, r
    'arrow b2x, b2y, b2a, 100
    
  wend
  delay 500
  next
next
pause

sub arrow(x0, y0, a, d)
  local x1, y1, x2, y2, x3, y3
  x1 = x0 + d * cos(a)
  y1 = y0 + d * sin(a)
  line x0, y0, x1, y1
  x2 = x1 + .1 * d * cos(a + pi + pi/6)
  y2 = y1 + .1 * d * sin(a + pi + pi/6)
  line x1, y1, x2, y2
  x3 = x1 + .1 * d * cos(a + pi - pi/6)
  y3 = y1 + .1 * d * sin(a + pi - pi/6)
  line x1, y1, x3, y3
end sub


Attached File(s) Image(s)
   

B += _
Find all posts by this user
Like Post
08-31-2017, 12:14 PM (This post was last modified: 08-31-2017 12:25 PM by bplus.)
Post: #2
 (Print Post)
RE: discern Collider.bas
"Collision test.bas" has been modified to handle ball collisions approximately 75% of time like in "discern Collider.bas" code but some ball strikes don't work and a safety angle is used to insure the ball is reflected though not in accurate angle. Still it works 75% more accurately than Bonkers type collision handling.
Code Snippet: [Select]
' collision test.bas SmallBASIC 0.12.9 (B+=MGA) 2017-08-25
' advance from Bonkers Collision

CONST nBalls = 20 '<<<<< play with this number ball radius = 50
CONST speed = 10 '<<<<< change _Limit first if not fast enough
clrMode = -1
DIM x(nBalls), y(nBalls), a(nBalls), c(nBalls), r(nBalls), g(nBalls), b(nBalls)

FOR i = 1 TO nBalls
   x(i) = RND * xmax
   y(i) = RND * ymax
   a(i) = RND * PI*2
   r(i) = RND * 200 + 55
   g(i) = RND * 200 + 55
   b(i) = RND * 200 + 55
NEXT

WHILE 1
 k = INKEY
 IF LEN(k) THEN
   IF ASC(k) = 32 THEN clrMode = -1 * clrMode
   IF ASC(k) = 27 AND LEN(k) = 1 THEN
     cls
     color 15
     if cct <> 0 then perc = sc / cct * 100
     ? "collisions = ";cct;"  safe angles = ";sc;"  or ";int(perc);"%"
     showpage
     pause
     END
   fi
 END IF
 IF clrMode < 0 THEN CLS

 FOR i = 1 TO nBalls
   FOR j = i + 1 TO nBalls
     IF c(j) <> 1 THEN
       separation = SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2)
       IF separation < 50 THEN 'collision
         cct += 2
         'perpendiculars to tangent of collision
         ' in old BONKERs programs this WAS the new angle after collision!
         redArrow = ATAN2(y(i) - y(j), x(i) - x(j)) 'for ball i
         if redArrow < 0 then redArrow = redArrow + 2*pi
         blueArrow = ATAN2(y(j) - y(i), x(j) - x(i)) 'for ball j
         if blueArrow < 0 then blueArrow = blueArrow + pi * 2
         
         ' angle in = difference of ball direction and perp on contact ball side
         diff = blueArrow - a(i)
         
         ' angle out = add difference to perp on ball side of tangent
         ' DO NOT change from redArrow direction by more than pi/2, 90 degrees!
         IF ABS(diff) <= PI*.5 THEN
           a(i) = redArrow + diff 'good! an improvement on Bonkers
         ELSE
           a(i) = redArrow 'safe direction to take when don't know better
           sc++
         END IF
         
         
         'do agin for other ball
         'j ball's  new angle calc like i's
         diff = redArrow - a(j)
         IF ABS(diff) <= PI*.5 THEN
           a(j) = blueArrow + diff 'improved direction based on ball angle
         ELSE
           a(j) = blueArrow 'safe direction to take
           sc++
         END IF
         
         c(i) = 1: c(j) = 1 'mark balls with angles adjusted
         EXIT FOR
       END IF
     END IF
   NEXT
   
   IF x(i) < 25 THEN a(i) = PI - a(i): x(i) = 25
   IF x(i) > xmax - 25 THEN a(i) = pi - a(i): x(i) = xmax - 25
   IF y(i) < 25 THEN a(i) = -a(i): y(i) = 25
   IF y(i) > ymax - 25 THEN a(i) = -a(i): y(i) = ymax - 25
   IF a(i) > pi*2 THEN a(i) = a(i) - pi*2
   IF a(i) < 0 THEN a(i) = a(i) + pi*2

   x(i) = x(i) + COS(a(i)) * speed
   y(i) = y(i) + SIN(a(i)) * speed

   IF 1 THEN
     FOR rr = 25 TO 1 STEP -1
       IF c(i) THEN
         COLOR RGB(255 - 5 * rr, 64 - 2 * rr, 0)
       ELSE
         COLOR rgb(r(i)-2*rr, g(i)-2*rr, b(i)-2*rr)
       END IF
       Circle x(i), y(i), rr filled
     NEXT
   END IF
   c(i) = 0
 NEXT
 showpage
 delay 50
WEND


Attached File(s) Image(s)
       

B += _
Find all posts by this user
Like Post
08-31-2017, 05:19 PM
Post: #3
 (Print Post)
RE: discern Collider.bas
... am I correct in assuming that both demonstrations are conducted in a vacuum and that, even though there are collisions, the loss of momentum due to said collisions, are not factored into the trajectories? Yes or no, it's still pretty cool... Nice job.

May your journey be free of incident.

Live long and prosper.
Find all posts by this user
Like Post
08-31-2017, 05:26 PM
Post: #4
 (Print Post)
RE: discern Collider.bas
Yes, the demonstrations were conducted in my mind.

No gravity, no mass, no friction, no...

B += _
Find all posts by this user
Like Post



Forum Jump:


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




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