• Print

Author Topic: Dropping Balls  (Read 322 times)

bplus

  • Hero Member
  • *****
  • Posts: 756
  • B = B + _
Dropping Balls
« on: March 30, 2018, 09:48:41 pm »
Well heck, Make71 and I had a different idea about ball handling!

Here is my newly worked out physics of collisions and bouncing:
Code: [Select]
_TITLE "Dropping Balls by bplus 2018-03-31"
RANDOMIZE TIMER
CONST xmax = 800
CONST ymax = 600

SCREEN _NEWIMAGE(xmax, ymax, 32)

gravity = 1
balls = 8
DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
FOR i = 1 TO balls
    r(i) = rand(15, 20)
    x(i) = rand(r(i), xmax - r(i))
    y(i) = rand(r(i), ymax - r(i))
    c(i) = rand(1, 15)
    dx(i) = rand(1, 3) * rdir
    dy(i) = rand(10, 20)
    rr(i) = rand(200, 255)
    gg(i) = rand(200, 255)
    bb(i) = rand(200, 255)
NEXT
WHILE 1
    CLS
    FOR i = 1 TO balls
        'ready for collision
        a(i) = _ATAN2(dy(i), dx(i))
        power = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
        FOR j = i + 1 TO balls
            IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN
                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
                EXIT FOR
            END IF
        NEXT
        dx(i) = power * COS(a(i))
        dy(i) = power * SIN(a(i))
        dy(i) = dy(i) + gravity
        x(i) = x(i) + dx(i)
        y(i) = y(i) + dy(i)
        IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN
            x(i) = xmax / 2
            y(i) = 0
            dx(i) = rand(1, 3) * rdir
            dy(i) = 0
        END IF
        IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.8
        FOR rad = r(i) TO 1 STEP -1
            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
            fcirc x(i), y(i), rad
        NEXT
    NEXT
    _DISPLAY
    _LIMIT 20
WEND

FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION

FUNCTION rdir ()
    IF RND < .5 THEN rdir = -1 ELSE rdir = 1
END FUNCTION

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 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

Will you still love me, will you still need me, when I'm (QB) 64?

bplus

  • Hero Member
  • *****
  • Posts: 756
  • B = B + _
Re: Dropping Balls
« Reply #1 on: March 31, 2018, 06:55:35 am »
Flaws mostly fixed:
Code: [Select]
_TITLE "Dropping Balls 2 by bplus 2018-03-31"
' attempt to fix
RANDOMIZE TIMER
CONST xmax = 800
CONST ymax = 600

SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60

gravity = 1
balls = 8
DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
FOR i = 1 TO balls
    r(i) = rand(15, 20)
    x(i) = rand(r(i), xmax - r(i))
    y(i) = rand(r(i), ymax - r(i))
    c(i) = rand(1, 15)
    dx(i) = rand(0, 3) * rdir
    dy(i) = rand(10, 20)
    rr(i) = rand(200, 255)
    gg(i) = rand(200, 255)
    bb(i) = rand(200, 255)
NEXT
WHILE 1
    CLS
    FOR i = 1 TO balls
        'ready for collision
        dy(i) = dy(i) + gravity
        a(i) = _ATAN2(dy(i), dx(i))
        power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
        imoved = 0
        FOR j = i + 1 TO balls
            IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN
                imoved = 1
                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
                'update new dx, dy for i and j balls
                power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
                power = .7 * (power1 + power2) / 2
                dx(i) = power * COS(a(i))
                dy(i) = power * SIN(a(i))
                dx(j) = power * COS(a(j))
                dy(j) = power * SIN(a(j))
                x(i) = x(i) + dx(i)
                y(i) = y(i) + dy(i)
                x(j) = x(j) + dx(j)
                y(j) = y(j) + dy(j)
                EXIT FOR
            END IF
        NEXT
        IF imoved = 0 THEN
            x(i) = x(i) + dx(i)
            y(i) = y(i) + dy(i)
        END IF
        IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN
            x(i) = xmax / 2 + rand(0, 100) * rdir
            y(i) = 0
            dx(i) = rand(0, 3) * rdir
            dy(i) = 1
        END IF
        IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.7: x(i) = x(i) + .1 * dx(i)
        FOR rad = r(i) TO 1 STEP -1
            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
            fcirc x(i), y(i), rad
        NEXT
    NEXT
    _DISPLAY
    _LIMIT 20
WEND

FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION

FUNCTION rdir ()
    IF RND < .5 THEN rdir = -1 ELSE rdir = 1
END FUNCTION

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 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

Will you still love me, will you still need me, when I'm (QB) 64?

Ashish

  • Hero Member
  • *****
  • Posts: 604
  • Eat.... Sleep.... CODE.... Repeat.....
Re: Dropping Balls
« Reply #2 on: March 31, 2018, 07:06:13 am »
Nice simulation, bplus!
if (Me.Success) {Me.Improve();} else {Me.TryAgain();}

aKFrameWork - http://bit.ly/aKFrameWork
p5js.bas - http://bit.ly/p5jsbas
Menu System - http://bit.ly/guiMenuBar

OpenGL Demos - http://bit.ly/openGLdemos

STxAxTIC

  • Newbie
  • *
  • Posts: 18
Re: Dropping Balls
« Reply #3 on: March 31, 2018, 07:17:40 am »
Heya bplus,

The spherical collision detection part looks rather tight. However I do wonder which equation you're using for momentum transfer. Occasionally there are a few backwards or other wacky bounces.

I derived the "correct" formula once - which maybe you did for this as well. Tell me if the equation at the bottom of page 2 (attached) squares up with what you are doing. (There are more pages beyond this that have to do with uncertainty propagation if interested down the road).

bplus

  • Hero Member
  • *****
  • Posts: 756
  • B = B + _
Re: Dropping Balls
« Reply #4 on: March 31, 2018, 08:33:13 am »
Thanks Ashish!

Hi STxAxTic,
       
'ready for collision
dy(i) = dy(i) + gravity   'update dy vector component with more gravity applied to it, next update new angle for ball i
a(i) = _ATAN2(dy(i), dx(i))  '<<< this line converts dx and dy vector components to the angle of the vector
power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5  '<<< this line tells me the magnitude of the vector (how long it is)
imoved = 0   '<<< signal i ball moved in collision, 0 means not moved
FOR j = i + 1 TO balls
   IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN   '<<< we have collision
      imoved = 1 '<<< OK we are going to move ball i because of the collision
      a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))     '<<< collision angle ball i to j
      a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))     '<<< collision angle ball j to i

     
      power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5  '<<< magnitude of j balls vector before collision
      power = .7 * (power1 + power2) / 2     '<<< "momemtum split, average of two vector magnitudes,
                                                               'I am ignoring mass  ;D (I think I can if all masses are approx equal)
 
      'update new dx, dy for i and j balls
      dx(i) = power * COS(a(i))                    ' all the new vector dx, dy components from power average and collision angles
      dy(i) = power * SIN(a(i))
      dx(j) = power * COS(a(j))
      dy(j) = power * SIN(a(j))

      x(i) = x(i) + dx(i)                                'update x, y from new dx and dy
      y(i) = y(i) + dy(i)
      x(j) = x(j) + dx(j)
      y(j) = y(j) + dy(j)
      EXIT FOR
   END IF
NEXT

The funny business occurs when a ball is on the floor and another ball hits it (at just the wrong way). I don't allow the ball on the floor to move where it is supposed to because that would put it through the floor and out of the picture. So the ball on the floor never gets out of the way properly of the ball hitting it, my bad.

I am keeping the balls moving on floor with this line so balls aren't glued and stuck (until struck).
IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.7: x(i) = x(i) + .1 * dx(i) '<<< last part

The .7 * is removing some elastic energy when balls hit each other or the floor.
« Last Edit: March 31, 2018, 09:03:14 am by bplus »
Will you still love me, will you still need me, when I'm (QB) 64?

bplus

  • Hero Member
  • *****
  • Posts: 756
  • B = B + _
Re: Dropping Balls
« Reply #5 on: March 31, 2018, 09:54:38 am »
Sound effects added, a little off when lots of sound all at once, but fun to listen to:
Code: [Select]
_TITLE "Dropping Balls 2 w sound by bplus 2018-03-31"
' attempt to fix
RANDOMIZE TIMER
CONST xmax = 800
CONST ymax = 600

SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60

gravity = 1
balls = 8
DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
FOR i = 1 TO balls
    r(i) = rand(15, 20)
    x(i) = rand(r(i), xmax - r(i))
    y(i) = rand(r(i), ymax - r(i))
    c(i) = rand(1, 15)
    dx(i) = rand(0, 3) * rdir
    dy(i) = rand(10, 20)
    rr(i) = rand(200, 255)
    gg(i) = rand(200, 255)
    bb(i) = rand(200, 255)
NEXT
WHILE 1
    CLS
    FOR i = 1 TO balls
        'ready for collision
        dy(i) = dy(i) + gravity
        a(i) = _ATAN2(dy(i), dx(i))
        power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
        imoved = 0
        FOR j = i + 1 TO balls
            IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN
                imoved = 1
                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
                'update new dx, dy for i and j balls
                power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
                power = .7 * (power1 + power2) / 2
                dx(i) = power * COS(a(i))
                dy(i) = power * SIN(a(i))
                dx(j) = power * COS(a(j))
                dy(j) = power * SIN(a(j))
                x(i) = x(i) + dx(i)
                y(i) = y(i) + dy(i)
                x(j) = x(j) + dx(j)
                y(j) = y(j) + dy(j)
                snd 120 + r(i) * 250, r(j) * .15
                EXIT FOR
            END IF
        NEXT
        IF imoved = 0 THEN
            x(i) = x(i) + dx(i)
            y(i) = y(i) + dy(i)
        END IF
        IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN
            x(i) = xmax / 2 + rand(0, 100) * rdir
            y(i) = 0
            dx(i) = rand(0, 3) * rdir
            dy(i) = 1
        END IF
        IF y(i) + r(i) > ymax + gravity THEN snd (y(i) + r(i) - (ymax + gravity)) * 100 + r(i) * 20, 6 'only when hits floor, not for rolling balls
        IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.7: x(i) = x(i) + .1 * dx(i)

        FOR rad = r(i) TO 1 STEP -1
            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
            fcirc x(i), y(i), rad
        NEXT
    NEXT
    _DISPLAY
    _LIMIT 20
WEND

FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION

FUNCTION rdir ()
    IF RND < .5 THEN rdir = -1 ELSE rdir = 1
END FUNCTION

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 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

SUB snd (frq, dur)
    SOUND frq / 2.2, dur * .01
END SUB
:)
Will you still love me, will you still need me, when I'm (QB) 64?

Pete

  • Hero Member
  • *****
  • Posts: 7439
  • Cuz I sez so varmint!
Re: Dropping Balls
« Reply #6 on: March 31, 2018, 11:05:42 am »
Well you're really going balls out on this project. Nice effects! Very little code to do these simulations. I guess because I lack an interest in graphics, it's a little hard for me to see what this type of application could be applied to; although, I have a hunch it is just slightly more technology than is currently being deployed in autonomous Uber vehicles.

Pete  ;D ;D
Give a man a program, and he does one thing for a day. Teach a man to program, and he does one thing for a lifetime.

Petr

  • Hero Member
  • *****
  • Posts: 656
Re: Dropping Balls
« Reply #7 on: April 01, 2018, 07:50:00 am »
Beautiful simulation. It behaves like as in reality. Thanks for sharing.  :)
Coding is relax.

STxAxTIC

  • Newbie
  • *
  • Posts: 18
Re: Dropping Balls
« Reply #8 on: April 01, 2018, 09:38:05 am »
Heya bplus,

Here is a version that implements the momentum exchange equation I posted earlier. I had to flip your y-coordinate and removed any trig functions in favor of vectors. It also does a little bit more to prevent overlapping. I didn't go overboard with tiny details because the main point would be kind of obscured. Have fun with this tweak:

(I turned gravity way down but the scene does settle down after a few moments. At that point, you can see that a slightly finer algorithm to stop the jitters would be the next step.)

UPDATED APRIL 2
Code: [Select]
_TITLE "Dropping Balls 2 by bplus 2018-03-31 (mod by STxAxTIC)"
' attempt to fix
RANDOMIZE TIMER
CONST xmax = 800
CONST ymax = 600

SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60

gravity = 0.4
balls = 25
DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
FOR i = 1 TO balls
    r(i) = rand(15, 20)
    x(i) = rand(-80 + r(i), 80 - r(i))
    y(i) = rand(-200 + r(i), 300 - r(i))
    c(i) = rand(1, 15)
    dx(i) = rand(-2, 2)
    dy(i) = rand(-.5, .5)
    rr(i) = rand(200, 255)
    gg(i) = rand(200, 255)
    bb(i) = rand(200, 255)
NEXT

WHILE 1
    CLS
    FOR i = 1 TO balls
        'ready for collision
        dy(i) = dy(i) - gravity
        FOR j = i + 1 TO balls

            ' Displacement vector and its magnitude.
            nx = x(j) - x(i)
            ny = y(j) - y(i)
            nm = SQR(nx ^ 2 + ny ^ 2)
            IF nm < 1 + r(i) + r(j) THEN
                nx = nx / nm
                ny = ny / nm

                ' Regardless of momentum exchange, separate the balls along the lone connecting them.
                DO WHILE nm < 1 + r(i) + r(j)
                    flub = .001 '* RND

                    x(j) = x(j) + flub * nx
                    y(j) = y(j) + flub * ny

                    x(i) = x(i) - flub * nx
                    y(i) = y(i) - flub * ny

                    nx = x(j) - x(i)
                    ny = y(j) - y(i)
                    nm = SQR(nx ^ 2 + ny ^ 2)
                    nx = nx / nm
                    ny = ny / nm
                LOOP

                ' Momentum exchange vector. Note the damping factor in front of qmag.
                ndotu2 = nx * dx(j) + ny * dy(j)
                ndotu1 = nx * dx(i) + ny * dy(i)
                qmag = ndotu2 - ndotu1
                qmag = .85 * qmag
                qx = qmag * nx
                qy = qmag * ny

                ' Calculate new velocities.
                dx(j) = dx(j) - qx
                dy(j) = dy(j) - qy
                dx(i) = dx(i) + qx
                dy(i) = dy(i) + qy

                EXIT FOR
            END IF
        NEXT
        IF x(i) < -400 + r(i) THEN dx(i) = -dx(i)
        IF x(i) > 400 - r(i) THEN dx(i) = -dx(i)
        IF y(i) < -300 + r(i) THEN dy(i) = -.85 * dy(i): y(i) = y(i) + dy(i)

        x(i) = x(i) + dx(i)
        y(i) = y(i) + dy(i)

        FOR rad = r(i) TO 1 STEP -1
            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
            fcirc x(i) + 400, -y(i) + 300, rad
        NEXT

    NEXT

    _DISPLAY
    _LIMIT 30
WEND

FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION

FUNCTION rdir ()
    IF RND < .5 THEN rdir = -1 ELSE rdir = 1
END FUNCTION

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 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
« Last Edit: April 02, 2018, 03:08:38 pm by STxAxTIC »

bplus

  • Hero Member
  • *****
  • Posts: 756
  • B = B + _
Re: Dropping Balls
« Reply #9 on: April 02, 2018, 09:34:57 am »
Hi STxAxTIC,

Why 75 balls, what are you covering up?  ;D

Back to 8 balls, that gravity is so slight it's like floating in outer space and when one hits another they really frick'in go sailing!

It appears you not only flipped Y axis but moved the origin to middle or screen? Which to me makes it a nightmare to subtract x from another x specially if one x is right or origin and the other to left (likewise same problem with y's and up and down). Imagine collision of two balls near origin one in one quadrant and the other in another. You could square and sqr everything for magnitudes but again angles are nightmare of deciding and adjusting for which quadrant.

I tried to reproduce my sim such that when balls go past left or right edge they are restarted by dropping from top of screen but what is top? Gravity changes don't seem to affect much??? what a mess to figure out to try to compare Apples to Apples...

I did like how you worked out the "overlap" problem, the biggest flaw in my sim, but I like Ed12345's version better (allot less monkeying around (if it works)).

Will you still love me, will you still need me, when I'm (QB) 64?

STxAxTIC

  • Newbie
  • *
  • Posts: 18
Re: Dropping Balls
« Reply #10 on: April 02, 2018, 03:19:20 pm »
Hi again,

I moved the overlap chunk before the collision chunk - I should have done that in the first place and probably caused some ugliness. See updated code above. That said (and this is tough love, not real criticism):

As for the rest of your response, I beg you to realize that Ed's method (the one where you push the sphere around with the mouse, right?) acts tight for N=2 particles. I point out that *any* algorithm would work that tight for such a trivial case. Not to mention there is no actual dynamics there - only detecting collisions and moving quasi-statically.

Also, you're entitled to your opinion on coordinate systems to frame such motion. While I'll do you the dignity of *not* quote-mining, I have to isolate and ask: what is so hard about doing math a number line with negative numbers?  I don't see the idea of putting the origin in the middle of the screen as a hindrance whatsoever. Plus, it doesn't violate the right hand rule, nor the intuition that increasing Y should mean increasing height. The crappy native coordinate system of QB64 violates both of these - and this has done arguably more to help people *mis*understand geometry than if they had ignored the subject altogether. With a vector approach, I don't mess with quadrants, trig functions, inverse trig functions, angles, or any of that nonsense. Seeing your other work(s), I think you are ready to approach geometry this way.

As for the actual motion/dynamics, do heed the proper physics if you want realism. I insert my praise (again) for a vector approach here for brevity. Again, see the updated code.

EDIT: I didn't tend much to the behavior on the sides of the screen - just naive reflections. Nor is the code optimized to show off any particular case. The parameters are kindof arbitrary, matching the spirit of your prototype.

Good day bplus.

bplus

  • Hero Member
  • *****
  • Posts: 756
  • B = B + _
Re: Dropping Balls
« Reply #11 on: April 02, 2018, 05:20:43 pm »
Hi STxAxTIC,

Thanks for all the love, tough or not. ;)

I am liking the 2nd version of you mods except, as you say, all the jitters at bottom of screen.

I have tried some mods to compare 8 balls bouncing and colliding and being redropped when they pass the left or right edge of screen.
Code: [Select]
_TITLE "Dropping Balls STxAxTIC mod 2, 2018-04-02"
' bplus modified to TRY to compare Apples to Apples
' increased gravity
' decreased elasticity rebound factor to .5
' when balls move out of sight left or right edge, they are restated by dropping again
' removed c() as not being used

RANDOMIZE TIMER
CONST xmax = 800
CONST ymax = 600

SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60

gravity = 1
balls = 8
DIM x(balls), y(balls), r(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
FOR i = 1 TO balls
    r(i) = rand(15, 20)
    x(i) = rand(-80 + r(i), 80 - r(i))
    y(i) = rand(-200 + r(i), 300 - r(i))
    dx(i) = rand(-2, 2)
    dy(i) = rand(-.5, .5)
    rr(i) = rand(200, 255)
    gg(i) = rand(200, 255)
    bb(i) = rand(200, 255)
NEXT

WHILE 1
    CLS
    FOR i = 1 TO balls
        'ready for collision
        dy(i) = dy(i) - gravity
        FOR j = i + 1 TO balls

            ' Displacement vector and its magnitude.
            nx = x(j) - x(i)
            ny = y(j) - y(i)
            nm = SQR(nx ^ 2 + ny ^ 2)
            IF nm < 1 + r(i) + r(j) THEN
                nx = nx / nm
                ny = ny / nm

                ' Regardless of momentum exchange, separate the balls along the lone connecting them.
                DO WHILE nm < 1 + r(i) + r(j)
                    flub = .001 '* RND

                    x(j) = x(j) + flub * nx
                    y(j) = y(j) + flub * ny

                    x(i) = x(i) - flub * nx
                    y(i) = y(i) - flub * ny

                    nx = x(j) - x(i)
                    ny = y(j) - y(i)
                    nm = SQR(nx ^ 2 + ny ^ 2)
                    nx = nx / nm
                    ny = ny / nm
                LOOP

                ' Momentum exchange vector. Note the damping factor in front of qmag.
                ndotu2 = nx * dx(j) + ny * dy(j)
                ndotu1 = nx * dx(i) + ny * dy(i)
                qmag = ndotu2 - ndotu1
                qmag = .5 * qmag '< B+ change from .85 to .5
                qx = qmag * nx
                qy = qmag * ny

                ' Calculate new velocities.
                dx(j) = dx(j) - qx
                dy(j) = dy(j) - qy
                dx(i) = dx(i) + qx
                dy(i) = dy(i) + qy

                EXIT FOR
            END IF
        NEXT
        'bplus changed to redrop ball when ball moves out of sight left or right
        IF x(i) < -400 - r(i) OR x(i) > 400 + r(i) THEN
            x(i) = rand(-200 + r(i), 200 - r(i)) 'increse spread from original
            y(i) = rand(200, 300 + r(i)) 'drop from near top of screen but spread out y
            dx(i) = rand(-2, 2)
            dy(i) = rand(-.5, .5)
        END IF
        IF y(i) < -300 + r(i) THEN dy(i) = -.5 * dy(i): y(i) = y(i) + dy(i) '< bplus change to .5

        x(i) = x(i) + dx(i)
        y(i) = y(i) + dy(i)

        FOR rad = r(i) TO 1 STEP -1
            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
            fcirc x(i) + 400, -y(i) + 300, rad
        NEXT

    NEXT

    _DISPLAY
    _LIMIT 30
WEND

FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION

FUNCTION rdir ()
    IF RND < .5 THEN rdir = -1 ELSE rdir = 1
END FUNCTION

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 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

Will you still love me, will you still need me, when I'm (QB) 64?

  • Print