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


Collision multiple balls
09-06-2017, 09:21 PM (This post was last modified: 09-06-2017 09:27 PM by bplus.)
Post: #11
 (Print Post)
RE: Collision multiple balls
OK an exorcism has been successfully performed on Maxwell's Demon!

And you might enjoy watching what happens to this:

Code Snippet: [Select]
' 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.

B += _
Find all posts by this user
Like Post
09-06-2017, 09:44 PM
Post: #12
 (Print Post)
RE: Collision multiple balls
Nicely done.... I even fiddled with the 'speed' and the number of spheres. Looks like you licked that problem... Cool.

J

ps: ABC packets?

May your journey be free of incident.

Live long and prosper.
Find all posts by this user
Like Post
09-06-2017, 09:48 PM (This post was last modified: 09-06-2017 09:52 PM by bplus.)
Post: #13
 (Print Post)
RE: Collision multiple balls
Andy_A brought ABC packets to our attention here:
http://www.thejoyfulprogrammer.com/qb64/...9378647608

The billiard sim is under ABC Demos. It ran without error straight from a copy / paste! very cool!

B += _
Find all posts by this user
Like Post
09-06-2017, 11:23 PM
Post: #14
 (Print Post)
RE: Collision multiple balls
Cool... Viewing some listings are garbled but most are ok. Only checked few so far. I'll be book-marking that site... Thanks

J

May your journey be free of incident.

Live long and prosper.
Find all posts by this user
Like Post



Forum Jump:


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




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