﻿ discern Collider.bas

 discern Collider.bas
08-31-2017, 12:02 PM
Post: #1
(Print Post)
 bplus Posting Freak Posts: 1,127 Likes Given: 329 Likes Received: 192 in 164 posts Joined: Apr 2017 Country of Origin::
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)

http://www.laughfactory.com/jokes/joke-of-the-day
worse than Pete's
08-31-2017, 12:14 PM (This post was last modified: 08-31-2017 12:25 PM by bplus.)
Post: #2
(Print Post)
 bplus Posting Freak Posts: 1,127 Likes Given: 329 Likes Received: 192 in 164 posts Joined: Apr 2017 Country of Origin::
"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)

http://www.laughfactory.com/jokes/joke-of-the-day
worse than Pete's
08-31-2017, 05:19 PM
Post: #3
(Print Post)
 johnno56 Member Posts: 151 Likes Given: 4 Likes Received: 26 in 24 posts Joined: Apr 2017 Country of Origin::
... 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.
08-31-2017, 05:26 PM
Post: #4
(Print Post)
 bplus Posting Freak Posts: 1,127 Likes Given: 329 Likes Received: 192 in 164 posts Joined: Apr 2017 Country of Origin::
Yes, the demonstrations were conducted in my mind.

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