OK an exorcism has been successfully performed on Maxwell's Demon!

And you might enjoy watching what happens to this:

`' N Balls Collision Study with Angle Adjusting.bas for QB64 fork (B+=MGA) 2017-09-06`

'FIXED!

'After Maxwell's Demon exorcism, now use safe angle around 60% or

' 40% improved collision handling that takes into account balls'

' original angle direction in the rebound.

CONST xmax = 800

CONST ymax = 600

SCREEN _NEWIMAGE(xmax, ymax, 32)

_TITLE "N Balls Collision Study: press spacebar to toggle ball tracking on/off"

'check this out! 192 balls will almost cover area in perfect 2r x 2r squares

CONST nBalls = 190 '<<<<< play with this number ball radius = 25

CONST speed = 1 '<<<<< change _Limit first if not fast enough

clrMode = -1

DIM x(nBalls), y(nBalls), a(nBalls), m(nBalls)

DIM r(nBalls), g(nBalls), b(nBalls)

'init balls

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

'main loop

collisionCnt& = 0: safeCnt& = 0

WHILE 1

'handle keys to toggle ball (spacebar) tracking or end (esc)

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 _RGB(255, 255, 0)

PRINT "Of "; collisionCnt&; " angle adjustments, "; safeCnt&; " used safe (Bonkers) angle."

PRINT

PRINT "Percent safe (Bonkers) angle was used "; INT(safeCnt& / collisionCnt& * 100); "%"

_DISPLAY

SLEEP

END

END IF

END IF

IF clrMode < 0 THEN CLS , _RGB(0, 0, 0)

FOR i = 1 TO nBalls

FOR j = i + 1 TO nBalls

IF m(j) <> 1 THEN 'ball hasn't been touched yet

separation = SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2)

IF separation < 50 THEN 'collision

collisionCnt& = collisionCnt& + 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

'this reduces need to use Safe Angle

IF redArrow < 0 THEN redArrow = redArrow + _PI(2)

blueArrow = _ATAN2(y(j) - y(i), x(j) - x(i)) 'for ball j

'this reduces need to use Safe Angle

IF blueArrow < 0 THEN blueArrow = blueArrow + _PI(2)

' angle in = difference of ball direction and perp on contact ball side

diff = blueArrow - a(i)

'exorcism of Maxwell's Demon

IF diff < 0 THEN diff = diff + _PI(2)

' 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

ELSE

a(i) = redArrow 'safe direction

safeCnt& = safeCnt& + 1

END IF

'j ball's new angle calc like i's

diff = redArrow - a(j)

IF diff < 0 THEN diff = diff + _PI(2)

IF ABS(diff) <= _PI(.5) THEN

a(j) = blueArrow + diff

ELSE

a(j) = blueArrow 'safe direction

safeCnt& = safeCnt& + 1

END IF

m(i) = 1: m(j) = 1 'mark balls with angles adjusted

EXIT FOR

END IF

END IF

NEXT

IF x(i) < 25 THEN a(i) = _PI(1) - a(i): x(i) = 25

IF x(i) > xmax - 25 THEN a(i) = _PI(1) - 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

FOR rd = 25 TO 1 STEP -1

IF m(i) THEN

COLOR _RGB(255 - 5 * rd, 64 - 2 * rd, 0)

ELSE

COLOR _RGB(r(i) - 2 * rd, g(i) - 2 * rd, b(i) - 2 * rd)

END IF

CircleFill x(i), y(i), rd

NEXT

m(i) = 0

NEXT

_DISPLAY

_LIMIT 60

WEND

'Steve McNeil's copied from his forum

SUB CircleFill (CX AS LONG, CY AS LONG, R AS LONG)

DIM Radius AS LONG, RadiusError AS LONG

DIM X AS LONG, Y AS LONG

Radius = ABS(R)

RadiusError = -Radius

X = Radius

Y = 0

IF Radius = 0 THEN PSET (CX, CY): EXIT SUB

' Draw the middle span here so we don't draw it twice in the main loop,

' which would be a problem with blending turned on.

LINE (CX - X, CY)-(CX + X, CY), , BF

WHILE X > Y

RadiusError = RadiusError + Y * 2 + 1

IF RadiusError >= 0 THEN

IF X <> Y + 1 THEN

LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF

LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF

END IF

X = X - 1

RadiusError = RadiusError - X * 2

END IF

Y = Y + 1

LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF

LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF

WEND

END SUB

Johnno, I found a Billiard sim code in ABC packets but it was just demo of 3 balls, no pockets.

So I am working on drawing a pool table, those pockets harder than I anticipated. Then use

bowling code for slowing balls down with this new collision handling.