Angle Collisions

[james2464]

Yeah honestly I'm not sure what the solution looks like for fast objects that collide...I'm just guessing it's line/line because you can maybe detect ahead of time where it will hit, rather than what I'm doing now which is just step by step. So something like a fast bullet (round shape or whatever) probably needs a different method that can see ahead to know how far away the wall is. Hoping to understand this eventually.

[bplus]

I think I mentioned before don't have speed > radius maybe even .5 * radius, it could jump out of the radius circle detection of the circle location. A bullet is more like a point which is a very small circle.

[james2464]

I think I mentioned before don't have speed > radius maybe even .5 * radius, it could jump out of the radius circle detection of the circle location. A bullet is more like a point which is a very small circle.

Yes this is very true.   And that's why I wonder how to be able to go faster than .5 * radius.   A small bullet would be speeding maybe 100* radius.    Interesting.

[bplus]

Good question now you are making me think...

Ah I usually worry about circle Intersect circle the easiest collision detection IMHO. For that you look at 2 radius the bullet almost nothing but also the radius of targets... Catching bullets at border "use to be" just seeing if the new bullet x,y was past a line border. "Use to be" before some crazy guy came up with jagged borders!

[james2464]

Ok so here is basically the same program, modified into a hockey game.  An example of a possible need to use another type of collision detection, for faster moving objects. 

Code: (Select All)

'AI HOCKEY demo

'(AI = approaching idiot)
'james2464

'CONTROLS:
'Space Bar :  Faceoff at center ice
'Escape key:  Quit

Dim Shared scx, scy As Integer
scx = 800: scy = 600
Screen _NewImage(scx, scy, 32)

Const PI = 3.141592654#
Randomize Timer

Dim Shared x, y, h, xv, yv, ndpx, ndpy, rx, ry, rt, i2w, i2ws
Dim Shared cpa, cpb, a, b, a2, b2, sbx, sby, newxv, newyv, oldxv, oldyv
Dim Shared lastcollision, collisiontype, correctionwasmade


Dim Shared bg&
bg& = _NewImage(scx + 1, scy + 1, 32)


Dim Shared c(30) As Long

colour1


Type fixedwall
    x1 As Integer
    x2 As Integer
    y1 As Integer
    y2 As Integer
    b As Integer
    bx1 As Integer
    bx2 As Integer
    by1 As Integer
    by2 As Integer
    xx As Single
    yy As Single
    wlen As Single
    nx As Single
    ny As Single
    sc As Single
    sc1 As Single
    sc2 As Single
End Type
Dim Shared w(50) As fixedwall




Dim Shared walltotal, ballrad

ballrad = 3 'ball radius
walltotal = 12

For t = 1 To walltotal
    w(t).b = ballrad + 2
Next t

Dim Shared home, visitor As Integer
home = 0
visitor = 0


wallsetup


_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen


'start
xv01 = (Rnd * 2 - 1) * 10
yv01 = (Rnd * 2 - 1) * 10
sbx01 = 400
sby01 = 300

xv = xv01 'starting ball x velocity
yv = yv01 'starting ball y velocity
sbx = sbx01 'starting x position
sby = sby01 'starting y position

flag = 0

Do

    _Limit 30
    Cls
    _PutImage (0, 0)-(scx, scy), bg&, 0 'draw background

    'rcirc = Rnd * 20 + 3 'display  to show program is active
    'Circle (700, 100), rcirc, c(6)

    'Paint (400, 300), c(30), c(1)

    '=====================================================

    '_MouseHide


    sbx = sbx + xv
    sby = sby + yv
    If sbx > (770 - ballrad) Then
        If sby > 270 Then
            If sby < 330 Then
                Locate 5, 49
                Print "GOAL"
                Color c(1)
                _Display
                visitor = visitor + 1
                _Delay 1.
                faceoff
            End If
        End If
    End If

    If sbx < (30 + ballrad) Then
        If sby > 270 Then
            If sby < 330 Then
                Locate 5, 49
                Print "GOAL"
                Color c(1)
                _Display
                home = home + 1
                _Delay 1.
                faceoff
            End If
        End If
    End If

    If sbx > (770 - ballrad) Then
        xv = xv * -.9
        t = sbx - (770 - ballrad)
        sbx = sbx - t
    End If

    If sby > (500 - ballrad) Then
        yv = yv * -.9
        t = sby - (500 - ballrad)
        sby = sby - t
    End If

    If sbx < (30 + ballrad) Then
        xv = xv * -.9
        t = (30 + ballrad) - sbx
        sbx = sbx + t
    End If

    If sby < (100 + ballrad) Then
        yv = yv * -.9
        t = (100 + ballrad) - sby
        sby = sby + t
    End If

    '=====================================================
    'player movements - random plus
    For p = 1 To 10
        tdx = sbx - w(p).x1: tdy = sby - w(p).y1: tdh = _Hypot(tdx, tdy)
        If tdh < 100 Then 'move toward the puck if it's nearby
            If sbx > w(p).x1 Then
                w(p).x1 = w(p).x1 + 5: w(p).x2 = w(p).x2 + 5
            Else
                w(p).x1 = w(p).x1 - 5: w(p).x2 = w(p).x2 - 5
            End If
            If sby > w(p).y1 Then
                w(p).y1 = w(p).y1 + 3: w(p).y2 = w(p).y2 + 3
            Else
                w(p).y1 = w(p).y1 - 3: w(p).y2 = w(p).y2 - 3
            End If

        Else
            xp = Rnd * 10 - 5: yp = Rnd * 6 - 3 'random movement
        End If


        If tdh < 7 Then 'shoot puck
            If p < 6 Then
                xv = xv - 7
            Else
                xv = xv + 7
            End If
        End If
        w(p).x1 = w(p).x1 + xp: w(p).x2 = w(p).x2 + xp
        w(p).y1 = w(p).y1 + yp: w(p).y2 = w(p).y2 + yp
        If w(p).x1 < 35 Then
            w(p).x1 = w(p).x1 + 10: w(p).x2 = w(p).x2 + 10
        End If
        If w(p).x1 > 765 Then
            w(p).x1 = w(p).x1 - 10: w(p).x2 = w(p).x2 - 10
        End If
        If w(p).y1 < 105 Then
            w(p).y1 = w(p).y1 + 10: w(p).y2 = w(p).y2 + 10
        End If
        If w(p).y2 > 495 Then
            w(p).y1 = w(p).y1 - 10: w(p).y2 = w(p).y2 - 10
        End If
    Next p

    'goalie movements - follow puck

    If sby > 300 Then
        w(11).y1 = w(11).y1 + 3: w(11).y2 = w(11).y2 + 3
        w(12).y1 = w(12).y1 + 3: w(12).y2 = w(12).y2 + 3
    End If
    If sby < 300 Then
        w(11).y1 = w(11).y1 - 3: w(11).y2 = w(11).y2 - 3
        w(12).y1 = w(12).y1 - 3: w(12).y2 = w(12).y2 - 3
    End If

    'limits
    If w(11).y1 < 270 Then
        w(11).y1 = w(11).y1 + 3: w(11).y2 = w(11).y2 + 3
    End If
    If w(11).y1 > 300 Then
        w(11).y1 = w(11).y1 - 3: w(11).y2 = w(11).y2 - 3
    End If
    If w(12).y1 < 270 Then
        w(12).y1 = w(12).y1 + 3: w(12).y2 = w(12).y2 + 3
    End If
    If w(12).y1 > 300 Then
        w(12).y1 = w(12).y1 - 3: w(12).y2 = w(12).y2 - 3
    End If



    wallupdate
    '=====================================================
    correctionwasmade = 0: collisiontype = 0
    rt = 0
    rt = nearestwall 'determine the nearest wall
    'Line (w(rt).x1, w(rt).y1)-(w(rt).x2, w(rt).y2), c(4) 'highlight the nearest wall (green)

    nearestwallcheck 'check the nearest wall for collision

    If cpb > 0 Then
        If rt = lastcollision Then
            'Locate 1, 1
            'Print i2ws; i2w
            'Line (cpb, cpa)-(cpb + x, cpa - y), c(2) 'collision to point I
            'Line (cpb, cpa)-(sbx, sby), c(2) 'collision to point I
            'Line (cpb, cpa)-(cpb - oldxv * ballrad * 4, cpa - oldyv * ballrad * 4), c(1) 'collision to point I
            'Line (cpb + x, cpa - y)-(cpb + rx, cpa + ry), c(4) 'line A
            'Line (cpb, cpa)-(cpb + newxv * ballrad * 4, cpa + newyv * ballrad * 4), c(1) 'collision to point R
            'Line (cpb, cpa)-(cpb + ndpx * 50, cpa - ndpy * 50), c(5) 'line N
            'Circle (cpb, cpa), 2, c(4) 'circle the collision point
        End If

    Else
        rt = 0
        cpa = 0: cpb = 0: x = 0: y = 0
        rx = 0: ry = 0: ndpx = 0: ndpy = 0
    End If



    '=====================================================
    Circle (sbx, sby), (ballrad - 1), c(0) 'screen location of ball
    Paint (sbx, sby), c(0), c(0)
    '_Delay .5 'use to step through animation to see each frame separately

    h = _Hypot(xv, yv)
    If h > 12 Then
        yv = yv * .95
        xv = xv * .95
    End If


    If _KeyDown(32) Then '                                IF space bar was pressed
        faceoff
    End If


    If _KeyDown(27) Then '                                IF escape key was pressed
        End
    End If






    displayspd = _Hypot(xv, yv)
    'Locate 1, 1
    'Print "LEFT and RIGHT keys : Ball radius:"; Int(ballrad)
    'Print "UP and DOWN keys : Speed:"; Int(displayspd)
    'Print "SPACE BAR : Random Restart"
    'Print "ESC : Quit"

    _Display
    If mouseclick2 = 1 Then flag = 1

Loop Until flag = 1

'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================





Function nearestwall
    nearestwall = 0
    scoretobeat = 1000
    closest = 0
    Locate 1, 1
    For ct = 1 To walltotal 'get each wall endpoints and mid point distances from ball
        tdx1 = Abs(sbx - w(ct).x1)
        tdy1 = Abs(sby - w(ct).y1)
        score1 = _Hypot(tdx1, tdy1) 'distance from ball center to line endpoint 1
        tdx2 = Abs(sbx - w(ct).x2)
        tdy2 = Abs(sby - w(ct).y2)
        score2 = _Hypot(tdx2, tdy2) 'distance from ball center to line endpoint 2
        If score2 < score1 Then
            lowscore = score2: low$ = "E2"
        Else
            lowscore = score1: low$ = "E1"
        End If
        tdxx = Abs(sbx - w(ct).xx)
        tdyy = Abs(sby - w(ct).yy)
        score3 = _Hypot(tdxx, tdyy) 'distance from ball center to line mid point
        If score3 < lowscore Then
            lowscore = score3: low$ = "M"
        End If
        x = sbx - w(ct).xx: y = 0 - sby + w(ct).yy
        dx = -x * w(ct).ny * -1: dy = y * w(ct).nx
        ndp = dx + dy
        score4 = Abs(ndp) 'distance ball center to side of wall (using vector dot product) aka "POINT N"

        'find if score4 is valid (ball is within the line, if outside then endpoints are used)
        ndpx = w(ct).ny * (ndp): ndpy = w(ct).nx * (ndp) 'screen position of point N

        score4distx = Abs(sbx - (w(ct).xx + ndpx))
        score4disty = Abs(sby - (w(ct).yy - ndpy))
        score4disth = _Hypot(score4distx, score4disty)
        If score4disth <= w(ct).wlen Then 'if within the line segment then score4 counts

            If score4 < ballrad * 5 Then
                'display line N
                'Line (w(ct).xx, w(ct).yy)-(w(ct).xx + ndpx, w(ct).yy - ndpy), c(ct)
                'Circle (w(ct).xx + ndpx, w(ct).yy - ndpy), 2, c(ct)
            End If

            If score4 < lowscore Then
                lowscore = score4: low$ = "N"
            End If
        End If

        w(ct).sc = lowscore
        If lowscore < scoretobeat Then
            scoretobeat = lowscore
            closest = ct
        End If
        'Print ct; w(ct).sc; "scores"; score1; score2; score3; score4; low$
    Next ct

    nearestwall = closest

End Function


Sub faceoff
    Cls
    _Delay 1.
    wallsetup
    _PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen

    ballrad = 3
    xv = (Rnd * 2 - 1) * 10
    yv = (Rnd * 2 - 1) * 10
    sbx = 400 'starting x position
    sby = 300 'starting y position

End Sub



Sub nearestwallcheck

    'start by getting position info

    x = sbx - w(rt).xx: y = 0 - sby + w(rt).yy 'location relative to wall mid point
    h = (_Hypot(-x, y))
    dx = -x * w(rt).ny * -1: dy = y * w(rt).nx: ndp = dx + dy

    'dot product V.N - used to find distance of N
    ndpx = w(rt).ny * ndp
    ndpy = w(rt).nx * ndp


    'calculate new vector  (point R)
    th1 = _Atan2(-y, x) 'radian value of ball (point I)
    th2 = _Atan2(-ndpy, ndpx) 'radian value of line N  (orthagonal to wall)
    thd = th1 - th2 'find difference
    th3 = th2 - thd 'subtract difference from line N
    rx = Cos(th3) * h: ry = Sin(th3) * h 'point R position - th3 * length of point I to collision point


    'angled wall endpoints
    a = w(rt).ny * w(rt).wlen: b = w(rt).nx * w(rt).wlen: a2 = a * -1: b2 = b * -1

    'find length of line A
    segx = Abs(x - rx): segy = Abs((w(rt).yy - y) - (w(rt).yy + ry)): sega = _Hypot(segx, segy)

    'find distance from point I to wall endpoints
    i2w1x = Abs(x - b): i2w1y = Abs(a + y): i2w2x = Abs(x + b): i2w2y = Abs(y - a)
    i2wh1 = _Hypot(i2w1x, i2w1y): i2wh2 = _Hypot(i2w2x, i2w2y)

    If i2wh1 < i2wh2 Then 'determine which end the ball is closer to
        i2ws = 1: i2w = i2wh1
    Else
        i2ws = 2: i2w = i2wh2
    End If


    If sega < (w(rt).wlen * 2) Then

        If Abs(ndp) <= ballrad Then
            'side collision

            positioncorrection 'perform correction


            collisionpointa = w(rt).ny * (sega / 2)
            collisionpointb = w(rt).nx * (sega / 2)
            If i2ws = 1 Then
                cpa = w(rt).yy + collisionpointa: cpb = w(rt).xx + collisionpointb
            End If
            If i2ws = 2 Then
                cpa = w(rt).yy - collisionpointa: cpb = w(rt).xx - collisionpointb
            End If

            sidecollisionvector 'find new vector
        End If

    Else
        If i2w <= ballrad Then '*****  collision with endpoint of the line  *****

            If i2ws = 1 Then
                cpa = w(rt).yy - a2: cpb = w(rt).xx + b
                endpointcollision1
            End If

            If i2ws = 2 Then
                cpa = w(rt).yy - a: cpb = w(rt).xx + b2
                endpointcollision2
            End If
        End If
    End If

End Sub




Sub positioncorrection '(for side collisions)
    x = sbx - w(rt).xx: y = 0 - sby + w(rt).yy 'location relative to wall mid point
    h = (_Hypot(-x, y))
    dx = -x * w(rt).ny * -1: dy = y * w(rt).nx: ndp = dx + dy
    pastline1 = ballrad - Abs(ndp)
    If pastline1 > 0 Then
        '=================================
        ballspd = _Hypot(xv, yv)
        cor2 = pastline1 / ballspd
        corx = xv * cor2: cory = yv * cor2
        csbx = sbx - corx: csby = sby - cory
        '=================================
        pastline2 = ballrad - Abs(ndp)
        sbx = csbx
        sby = csby
    End If
End Sub






Sub sidecollisionvector
    tx = xv: ty = yv: th = _Hypot(tx, ty)
    tx2 = tx / th: ty2 = ty / th
    spd = _Hypot(tx, ty) 'speed of existing motion vector
    th1 = _Atan2(tx, -ty) 'radian value of motion vector
    th2 = _Atan2(-ndpy, ndpx) 'radian value of line N
    thd = th1 - th2 'find difference
    th3 = th2 - thd 'subtract difference from line N
    newxv = Sin(th3): newyv = Cos(th3)
    oldxv = tx2: oldyv = ty2
    xv = newxv * spd: yv = newyv * spd * -1
    newh = _Hypot(xv, yv)
    newxv = xv / newh: newyv = yv / newh
    lastcollision = rt
End Sub






Sub endpointcollision1
    tx = x - b: ty = y + a2: th = _Hypot(tx, ty) 'tx, ty are distances from ball to end of line
    If th < ballrad Then
        past1 = ballrad - th
        'position correction
        txv = xv: tyv = yv: tspd = _Hypot(xv, yv)
        cor2 = past1 / tspd
        corx = xv * cor2: cory = yv * cor2
        'Locate 1, 1
        'Print "End1"; ballrad; th; past1; tspd; cor2; xv; corx; yv; cory
        'Print sbx; sby
        '_Display
        'Sleep
        'apply correction
        csbx = sbx - corx: csby = sby - cory
        tx = tx - corx: ty = ty - cory: th = _Hypot(tx, ty)
        sbx = csbx: sby = csby
        'Print "corrected"; sbx; sby
        '_Display
        'Sleep
    End If
    'continue to calculate new vector
    tx2 = tx / th: ty2 = ty / th 'tx2, ty2 are normalized
    txv = Abs(xv): tyv = Abs(yv): spd = _Hypot(txv, tyv)
    oldxv = xv: oldyv = yv
    oldh = _Hypot(xv, yv)
    oldxv = oldxv / oldh: oldyv = oldyv / oldh
    xv = tx2 * spd: yv = ty2 * spd * -1
    newh = _Hypot(xv, yv)
    newxv = xv / newh: newyv = yv / newh
    lastcollision = rt
End Sub





Sub endpointcollision2
    tx = x - b2: ty = y - a: th = _Hypot(tx, ty)
    If th < ballrad Then
        past2 = ballrad - th
        'position correction
        txv = xv: tyv = yv: tspd = _Hypot(xv, yv)
        cor2 = past2 / tspd
        corx = xv * cor2: cory = yv * cor2
        'Locate 1, 1
        'Print "End2"; ballrad; th; past2; tspd; cor2; xv; corx; yv; cory
        'Print sbx; sby
        '_Display
        'Sleep
        'apply correction
        csbx = sbx - corx: csby = sby - cory
        tx = tx - corx: ty = ty - cory: th = _Hypot(tx, ty)
        sbx = csbx: sby = csby
        'Print "corrected"; sbx; sby
        '_Display
        'Sleep
    End If
    'continue to calculate new vector
    tx2 = tx / th: ty2 = ty / th
    txv = Abs(xv): tyv = Abs(yv): spd = _Hypot(txv, tyv)
    oldxv = xv: oldyv = yv
    oldh = _Hypot(xv, yv)
    oldxv = oldxv / oldh: oldyv = oldyv / oldh
    xv = tx2 * spd: yv = ty2 * spd * -1
    newh = _Hypot(xv, yv)
    newxv = xv / newh: newyv = yv / newh
    lastcollision = rt
End Sub



Sub wallsetup

    'outer border
    Line (30, 100)-(770, 500), c(11), BF
    'goal
    Line (30, 270)-(20, 330), c(1), B
    Line (770, 270)-(780, 330), c(1), B
    'center line
    Line (395, 100)-(405, 500), c(13), BF
    'blue line
    Line (295, 100)-(305, 500), c(17), BF
    Line (495, 100)-(505, 500), c(17), BF
    'goal line
    Line (30, 100)-(35, 500), c(13), BF
    Line (30, 270)-(60, 330), c(13), B
    Line (765, 100)-(770, 500), c(13), BF
    Line (740, 270)-(770, 330), c(13), B


    'skaters
    w(1).x1 = 110: w(1).x2 = 100: w(1).y1 = 200: w(1).y2 = 220
    w(2).x1 = 100: w(2).x2 = 110: w(2).y1 = 350: w(2).y2 = 370
    w(3).x1 = 250: w(3).x2 = 245: w(3).y1 = 200: w(3).y2 = 220
    w(4).x1 = 245: w(4).x2 = 250: w(4).y1 = 350: w(4).y2 = 370
    w(5).x1 = 300: w(5).x2 = 300: w(5).y1 = 270: w(5).y2 = 290

    w(6).x1 = 660: w(6).x2 = 670: w(6).y1 = 200: w(6).y2 = 220
    w(7).x1 = 670: w(7).x2 = 660: w(7).y1 = 350: w(7).y2 = 370
    w(8).x1 = 515: w(8).x2 = 520: w(8).y1 = 200: w(8).y2 = 220
    w(9).x1 = 520: w(9).x2 = 515: w(9).y1 = 350: w(9).y2 = 370
    w(10).x1 = 470: w(10).x2 = 470: w(10).y1 = 270: w(10).y2 = 290

    'goalies
    w(11).x1 = 40: w(11).x2 = 40: w(11).y1 = 285: w(11).y2 = 315
    w(12).x1 = 760: w(12).x2 = 760: w(12).y1 = 285: w(12).y2 = 315

    'rink corners
    'w(13).x1 = 29: w(13).x2 = 90: w(13).y1 = 160: w(13).y2 = 99
    'w(14).x1 = 770: w(14).x2 = 710: w(14).y1 = 160: w(14).y2 = 100
    'w(15).x1 = 770: w(15).x2 = 710: w(15).y1 = 440: w(15).y2 = 500
    'w(16).x1 = 30: w(16).x2 = 90: w(16).y1 = 440: w(16).y2 = 500

    For wct = 1 To walltotal
        w(wct).bx1 = w(wct).x1: w(wct).bx2 = w(wct).x2
        w(wct).by1 = w(wct).y1: w(wct).by2 = w(wct).y2
        'orient outer box
        If w(wct).bx1 > w(wct).bx2 Then
            t = w(wct).bx1
            w(wct).bx1 = w(wct).bx2
            w(wct).bx2 = t
        End If
        If w(wct).by1 > w(wct).by2 Then
            t = w(wct).by1
            w(wct).by1 = w(wct).by2
            w(wct).by2 = t
        End If

        w(wct).bx1 = w(wct).bx1 - w(wct).b: w(wct).bx2 = w(wct).bx2 + w(wct).b
        w(wct).by1 = w(wct).by1 - w(wct).b: w(wct).by2 = w(wct).by2 + w(wct).b
        'If wct > 12 Then
        'Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(1) 'rink corners
        'End If
        'Line (w(wct).bx1, w(wct).by1)-(w(wct).bx2, w(wct).by2), c(2), B
        w(wct).xx = (w(wct).x2 - w(wct).x1) / 2 + w(wct).x1
        w(wct).yy = (w(wct).y2 - w(wct).y1) / 2 + w(wct).y1
        'Circle (w(wct).xx, w(wct).yy), 5, c(4)
        tx = w(wct).x2 - w(wct).xx: ty = w(wct).y2 - w(wct).yy
        w(wct).wlen = _Hypot(tx, ty)
        w(wct).nx = tx / w(wct).wlen 'normalized wall angle
        w(wct).ny = ty / w(wct).wlen 'normalized wall angle
    Next wct


    Circle (400, 300), 10, c(13)
    Circle (400, 300), 80, c(13)
End Sub



Sub wallupdate
    Locate 3, 20
    Print "Visitor: "; visitor
    Locate 3, 65
    Print "Home: "; home

    'outer border
    Line (30, 100)-(770, 500), c(1), B

    For wct = 1 To 12
        Select Case wct
            Case Is < 6
                Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(3)
            Case 11
                Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(3)
            Case Else
                Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(7)
        End Select
        w(wct).xx = (w(wct).x2 - w(wct).x1) / 2 + w(wct).x1
        w(wct).yy = (w(wct).y2 - w(wct).y1) / 2 + w(wct).y1

        Select Case wct
            Case Is < 6
                Circle (w(wct).xx, w(wct).yy), 3, c(3)
            Case 11
                Circle (w(wct).xx, w(wct).yy), 3, c(3)
            Case Else
                Circle (w(wct).xx, w(wct).yy), 3, c(7)
        End Select

        tx = w(wct).x2 - w(wct).xx: ty = w(wct).y2 - w(wct).yy
        w(wct).wlen = _Hypot(tx, ty)
        w(wct).nx = tx / w(wct).wlen 'normalized wall angle
        w(wct).ny = ty / w(wct).wlen 'normalized wall angle
    Next wct
End Sub





Sub colour1
    c(0) = _RGB(0, 0, 0)
    c(1) = _RGB(255, 255, 255)
    c(2) = _RGB(255, 255, 0)
    c(3) = _RGB(100, 0, 0)
    c(4) = _RGB(0, 255, 0)
    c(5) = _RGB(0, 255, 255)
    c(6) = _RGB(255, 0, 255)
    c(7) = _RGB(30, 30, 100)
    c(8) = _RGB(150, 150, 250)
    c(9) = _RGB(250, 150, 150)
    c(10) = _RGB(150, 250, 150)
    c(11) = _RGB(150, 150, 150)
    c(12) = _RGB(255, 255, 0)
    c(13) = _RGBA(100, 0, 0, 150)
    c(14) = _RGB(0, 255, 0)
    c(15) = _RGB(0, 255, 255)
    c(16) = _RGB(255, 0, 255)
    c(17) = _RGBA(30, 30, 100, 150)
    c(18) = _RGB(150, 150, 250)
    c(19) = _RGB(250, 150, 150)
    c(20) = _RGB(150, 250, 150)
    c(21) = _RGB(255, 255, 255)
    c(22) = _RGB(255, 255, 0)
    c(23) = _RGB(255, 0, 0)
    c(24) = _RGB(0, 255, 0)
    c(25) = _RGB(0, 255, 255)
    c(26) = _RGB(255, 0, 255)
    c(27) = _RGB(30, 30, 255)
    c(28) = _RGB(150, 150, 250)
    c(29) = _RGB(250, 150, 150)
    c(30) = _RGBA(0, 0, 0, 5)
End Sub

[bplus]

Oh man that is cute! I gotta try that with circle players.

[TempodiBasic]

@james2464
very fine hockey autoplay!
I cannot prove it , but it seems sometimes the ball goes trough the goalkeeper.

@Bplus
strange the effect of end of line stucking the bouncing!
Running your code I have noticed that stucking of ball on a penisula is a switching between 2 lines but there is no moves
moreover the 2 status of bouncing ball have the same blu vector....

[triggered]

Alright here's how you do angle collisions. To do it right, you need to (i) conserve momentum, and (ii) conserve energy. If you're a real mac daddy, you can reflect shapes with arbitrary boundaries (so long as they're closed), AND create and manipulate new shapes while the program is running. This program does all four. It was written before my Option Explicit days so I don't stand by the style and I don't update it anymore. It perfects collisions but does not quite do condensed matter particularly well.

Code: (Select All)

' Display
Screen _NewImage(800, 600, 32)
_ScreenMove (_DesktopWidth \ 2 - _Width \ 2) - 3, (_DesktopHeight \ 2 - _Height \ 2) - 29
_Title "Collisions - Version 9"
_Delay 1

' Meta
start:
Clear
Cls
Randomize Timer

' Data structures
Type Vector
    x As Double
    y As Double
End Type

Dim Shared vtemp As Vector

' Object type
Type Object
    Centroid As Vector
    Collisions As Long
    CollisionSwitch As Integer
    DeltaO As Double
    DeltaV As Vector
    Diameter As Double
    Elements As Integer
    Fixed As Integer
    Mass As Double
    MOI As Double
    PartialNormal As Vector
    Omega As Double
    Shade As _Unsigned Long
    Velocity As Vector
End Type

' Object storage
Dim Shared Shape(300) As Object
Dim Shared PointChain(300, 500) As Vector
Dim Shared TempChain(300, 500) As Vector
Dim Shared ShapeCount As Integer
Dim Shared SelectedShape As Integer

' Dynamics
Dim Shared CollisionCount As Integer
Dim Shared ProximalPairs(300 / 2, 1 To 2) As Integer
Dim Shared ProximalPairsCount As Integer
Dim Shared ContactPoints As Integer
Dim Shared CPC, FPC, RST, VD, SV As Double

' Environment
Dim Shared ForceField As Vector ' Ex: gravity

' Initialize
ShapeCount = 0
CollisionCount = 0

' Prompt
Cls
Call cprintstring(16 * 17, "WELCOME!                    ")
Call cprintstring(16 * 16, "Press 1 for Pool prototype  ")
Call cprintstring(16 * 15, "Press 2 for Wacky game      ")
Call cprintstring(16 * 14, "Press 3 for Concentric rings")
Call cprintstring(16 * 13, "Press 4 for Walls only      ")
Call cprintstring(16 * 12, "Press 5 for Angle pong game ")
_Display

'_KeyClear
'Do
'    kk = _KeyHit
'    Select Case kk
'        Case Asc("1")
'            Call SetupPoolGame
'            Exit Do
'        Case Asc("2")
'            Call SetupWackyGame
'            Exit Do
'        Case Asc("3")
'            Call SetupRings
'            Exit Do
'        Case Asc("4")
'            Call SetupWallsOnly
'            Exit Do
'        Case Asc("5")
'            Call SetupAnglePong
'            Exit Do
'        Case Else
'            _KeyClear
'    End Select
'    _Limit 60
'Loop

Call SetupAnglePong

Call Graphics
Call cprintstring(-16 * 4, "During Play:")
Call cprintstring(-16 * 6, "Move mouse to select closest object (by centroid).")
Call cprintstring(-16 * 7, "Boost velocity with arrow keys or W/S/A/D.        ")
Call cprintstring(-16 * 8, "Boost angluar velocity with Q/E.                  ")
Call cprintstring(-16 * 9, "Drag and fling object with Mouse 1.               ")
Call cprintstring(-16 * 10, "Rotate selected object with Mousewheel.           ")
Call cprintstring(-16 * 11, "Halt all motion with ESC.                         ")
Call cprintstring(-16 * 12, "Create new ball with Mouse 2.                     ")
Call cprintstring(-16 * 13, "Initiate creative mode with SPACE.                ")
Call cprintstring(-16 * 14, "Restart by pressing R during motion.              ")
Call cprintstring(-16 * 16, "PRESS ANY KEY TO BEGIN.")
_Display
Do: Loop Until (_KeyHit > 0)
While (_MouseInput): Wend
_KeyClear

' Main loop
Do
    If (UserInput = -1) Then GoTo start
    Call PairDynamics(CPC, FPC, RST)
    Call FleetDynamics(VD, SV)
    Call Graphics
    _Limit 120
Loop

End

Function UserInput
    TheReturn = 0
    ' Keyboard input
    kk = _KeyHit
    Select Case kk
        Case 32
            Do: Loop Until _KeyHit
            While _MouseInput: Wend
            _KeyClear
            Call cprintstring(16 * 17, "Drag Mouse 1 counter-clockwise to draw a new shape.")
            Call cprintstring(16 * 16, "Make sure centroid is inside body.                 ")
            Call NewMouseShape(7.5, 150, 15)
            Cls
        Case 18432, Asc("w"), Asc("W") ' Up arrow
            Shape(SelectedShape).Velocity.y = Shape(SelectedShape).Velocity.y * 1.05 + 1.5
        Case 20480, Asc("s"), Asc("S") ' Down arrow
            Shape(SelectedShape).Velocity.y = Shape(SelectedShape).Velocity.y * 0.95 - 1.5
        Case 19200, Asc("a"), Asc("A") ' Left arrow
            Shape(SelectedShape).Velocity.x = Shape(SelectedShape).Velocity.x * 0.95 - 1.5
        Case 19712, Asc("d"), Asc("D") ' Right arrow
            Shape(SelectedShape).Velocity.x = Shape(SelectedShape).Velocity.x * 1.05 + 1.5
        Case Asc("e"), Asc("E")
            Shape(SelectedShape).Omega = Omega * 0.5 - .02
        Case Asc("q"), Asc("Q")
            Shape(SelectedShape).Omega = Omega * 1.5 + .02
        Case Asc("r"), Asc("R")
            TheReturn = -1
        Case 27
            For k = 1 To ShapeCount
                Shape(k).Velocity.x = .000001 * (Rnd - .5)
                Shape(k).Velocity.y = .000001 * (Rnd - .5)
                Shape(k).Omega = .000001 * (Rnd - .5)
            Next
    End Select
    If (kk) Then
        _KeyClear
    End If

    ' Mouse input
    mb = 0
    mxold = 999999999
    myold = 999999999
    Do While _MouseInput
        x = _MouseX
        y = _MouseY
        If (x > 0) And (x < _Width) And (y > 0) And (y < _Height) Then
            x = x - (_Width / 2)
            y = -y + (_Height / 2)
            rmin = 999999999
            For k = 1 To ShapeCount
                dx = x - Shape(k).Centroid.x
                dy = y - Shape(k).Centroid.y
                r2 = dx * dx + dy * dy
                If (r2 < rmin) Then
                    rmin = r2
                    SelectedShape = k
                End If
            Next
            If (_MouseButton(1)) Then
                If (mb = 0) Then
                    mb = 1
                    vtemp.x = x - Shape(SelectedShape).Centroid.x
                    vtemp.y = y - Shape(SelectedShape).Centroid.y
                    Call TranslateShape(SelectedShape, vtemp)
                    Shape(SelectedShape).Velocity.x = 0
                    Shape(SelectedShape).Velocity.y = 0
                    Shape(SelectedShape).Omega = 0
                    mxold = x
                    myold = y
                End If
            End If
            If (_MouseButton(2)) Then
                If (mb = 0) Then
                    mb = 1
                    Call NewAutoBall(x, y, 15, 0, 1, 1, 0)
                    _Delay .1
                End If
            End If
            If (_MouseWheel > 0) Then
                Call RotShape(SelectedShape, Shape(SelectedShape).Centroid, -.02 * 8 * Atn(1))
            End If
            If (_MouseWheel < 0) Then
                Call RotShape(SelectedShape, Shape(SelectedShape).Centroid, .02 * 8 * Atn(1))
            End If
        End If
    Loop
    If ((mxold <> 999999999) And (myold <> 999999999)) Then
        Shape(SelectedShape).Velocity.x = x - mxold
        Shape(SelectedShape).Velocity.y = y - myold
    End If
    UserInput = TheReturn
End Function

Sub PairDynamics (CoarseProximityConstant As Double, FineProximityConstant As Double, Restitution As Double)

    Dim GrossJ(300) As Integer
    Dim GrossK(300) As Integer
    Dim NumJK As Integer

    ' Proximity detection
    ProximalPairsCount = 0
    Shape1 = 0
    Shape2 = 0
    For j = 1 To ShapeCount
        Shape(j).CollisionSwitch = 0
        Shape(j).DeltaO = 0
        Shape(j).DeltaV.x = 0
        Shape(j).DeltaV.y = 0
        Shape(j).PartialNormal.x = 0
        Shape(j).PartialNormal.y = 0
        For k = j + 1 To ShapeCount
            dx = Shape(j).Centroid.x - Shape(k).Centroid.x
            dy = Shape(j).Centroid.y - Shape(k).Centroid.y
            dr = Sqr(dx * dx + dy * dy)
            If (dr < (CoarseProximityConstant) * (Shape(j).Diameter + Shape(k).Diameter)) Then
                ProximalPairsCount = ProximalPairsCount + 1
                ProximalPairs(ProximalPairsCount, 1) = j
                ProximalPairs(ProximalPairsCount, 2) = k
                'Shape1 = j
                'Shape2 = k
            End If
        Next
    Next

    ContactPoints = 0

    If (ProximalPairsCount > 0) Then
        For n = 1 To ProximalPairsCount
            Shape1 = ProximalPairs(n, 1)
            Shape2 = ProximalPairs(n, 2)

            ' Collision detection
            rmin = 999999999
            ClosestIndex1 = 0
            ClosestIndex2 = 0
            NumJK = 0
            For j = 1 To Shape(Shape1).Elements
                For k = 1 To Shape(Shape2).Elements
                    dx = PointChain(Shape1, j).x - PointChain(Shape2, k).x
                    dy = PointChain(Shape1, j).y - PointChain(Shape2, k).y
                    r2 = dx * dx + dy * dy

                    If (r2 <= FineProximityConstant) Then

                        ContactPoints = ContactPoints + 1

                        ' Partial normal vector 1
                        nx1 = CalculateNormalY(Shape1, j)
                        ny1 = -CalculateNormalX(Shape1, j)
                        nn = Sqr(nx1 * nx1 + ny1 * ny1)
                        nx1 = nx1 / nn
                        ny1 = ny1 / nn
                        Shape(Shape1).PartialNormal.x = Shape(Shape1).PartialNormal.x + nx1
                        Shape(Shape1).PartialNormal.y = Shape(Shape1).PartialNormal.y + ny1

                        ' Partial normal vector 2
                        nx2 = CalculateNormalY(Shape2, k)
                        ny2 = -CalculateNormalX(Shape2, k)
                        nn = Sqr(nx2 * nx2 + ny2 * ny2)
                        nx2 = nx2 / nn
                        ny2 = ny2 / nn
                        Shape(Shape2).PartialNormal.x = Shape(Shape2).PartialNormal.x + nx2
                        Shape(Shape2).PartialNormal.y = Shape(Shape2).PartialNormal.y + ny2

                        NumJK = NumJK + 1
                        GrossJ(NumJK) = j
                        GrossK(NumJK) = k

                    End If
                    If (r2 < rmin) Then
                        rmin = r2
                        ClosestIndex1 = j
                        ClosestIndex2 = k
                    End If
                Next
            Next

            If (NumJK > 1) Then
                If ((GrossJ(1) - GrossJ(NumJK)) * (GrossJ(1) - GrossJ(NumJK)) > 50) Then
                    'ClosestIndex1 = 1
                Else
                    ClosestIndex1 = Int(IntegrateArray(GrossJ(), NumJK) / NumJK)
                End If
                If ((GrossK(1) - GrossK(NumJK)) * (GrossK(1) - GrossK(NumJK)) > 50) Then
                    'ClosestIndex2 = 1
                Else
                    ClosestIndex2 = Int(IntegrateArray(GrossK(), NumJK) / NumJK)
                End If
            End If

            If (rmin <= FineProximityConstant) Then

                CollisionCount = CollisionCount + 1
                Shape(Shape1).CollisionSwitch = 1
                Shape(Shape2).CollisionSwitch = 1

                ' Undo previous motion
                If (Shape(Shape1).Collisions = 0) Then
                    Call RotShape(Shape1, Shape(Shape1).Centroid, -1 * Shape(Shape1).Omega)
                    vtemp.x = -1 * (Shape(Shape1).Velocity.x)
                    vtemp.y = -1 * (Shape(Shape1).Velocity.y)
                    Call TranslateShape(Shape1, vtemp)
                End If
                If (Shape(Shape2).Collisions = 0) Then
                    Call RotShape(Shape2, Shape(Shape2).Centroid, -1 * Shape(Shape2).Omega)
                    vtemp.x = -1 * (Shape(Shape2).Velocity.x)
                    vtemp.y = -1 * (Shape(Shape2).Velocity.y)
                    Call TranslateShape(Shape2, vtemp)
                End If

                ' Momentum absorption
                If (Shape(Shape1).Collisions = 0) Then
                    Shape(Shape1).Velocity.x = Shape(Shape1).Velocity.x * Restitution
                    Shape(Shape1).Velocity.y = Shape(Shape1).Velocity.y * Restitution
                End If
                If (Shape(Shape2).Collisions = 0) Then
                    Shape(Shape2).Velocity.x = Shape(Shape2).Velocity.x * Restitution
                    Shape(Shape2).Velocity.y = Shape(Shape2).Velocity.y * Restitution
                End If

                ' Centroid of object 1 (cx1, cy1)
                cx1 = Shape(Shape1).Centroid.x
                cy1 = Shape(Shape1).Centroid.y

                ' Centroid of object 2 (cx2, cy2)
                cx2 = Shape(Shape2).Centroid.x
                cy2 = Shape(Shape2).Centroid.y

                ' Contact point on object 1 (px1, py1)
                px1 = PointChain(Shape1, ClosestIndex1).x
                py1 = PointChain(Shape1, ClosestIndex1).y

                ' Contact point on object 2 (px2, py2)
                px2 = PointChain(Shape2, ClosestIndex2).x
                py2 = PointChain(Shape2, ClosestIndex2).y

                ' Contact-centroid differentials 1 (dx1, dy1)
                dx1 = px1 - cx1
                dy1 = py1 - cy1

                ' Contact-centroid differentials 2 (dx2, dy2)
                dx2 = px2 - cx2
                dy2 = py2 - cy2

                ' Normal vector 1 (nx1, ny1)
                nn = Sqr(Shape(Shape1).PartialNormal.x * Shape(Shape1).PartialNormal.x + Shape(Shape1).PartialNormal.y * Shape(Shape1).PartialNormal.y)
                nx1 = Shape(Shape1).PartialNormal.x / nn
                ny1 = Shape(Shape1).PartialNormal.y / nn

                ' Normal vector 2 (nx2, ny2)
                nn = Sqr(Shape(Shape2).PartialNormal.x * Shape(Shape2).PartialNormal.x + Shape(Shape2).PartialNormal.y * Shape(Shape2).PartialNormal.y)
                nx2 = Shape(Shape2).PartialNormal.x / nn
                ny2 = Shape(Shape2).PartialNormal.y / nn

                '''
                'nx1 = CalculateNormalY(Shape1, ClosestIndex1)
                'ny1 = -CalculateNormalX(Shape1, ClosestIndex1)
                'nn = SQR(nx1 * nx1 + ny1 * ny1)
                'nx1 = nx1 / nn
                'ny1 = ny1 / nn

                'nx2 = CalculateNormalY(Shape2, ClosestIndex2)
                'ny2 = -CalculateNormalX(Shape2, ClosestIndex2)
                'nn = SQR(nx2 * nx2 + ny2 * ny2)
                'nx2 = nx2 / nn
                'ny2 = ny2 / nn
                '''

                ' Perpendicular vector 1 (prx1, pry1)
                prx1 = -1 * dy1
                pry1 = dx1
                pp = Sqr(prx1 * prx1 + pry1 * pry1)
                prx1 = prx1 / pp
                pry1 = pry1 / pp

                ' Perpendicular vector 2 (prx2, pry2)
                prx2 = -1 * dy2
                pry2 = dx2
                pp = Sqr(prx2 * prx2 + pry2 * pry2)
                prx2 = prx2 / pp
                pry2 = pry2 / pp

                ' Angular velocity vector 1 (w1, r1, vx1, vy1)
                w1 = Shape(Shape1).Omega
                r1 = Sqr(dx1 * dx1 + dy1 * dy1)
                vx1 = w1 * r1 * prx1
                vy1 = w1 * r1 * pry1

                ' Angular velocity vector 2 (w2, r2, vx2, vy2)
                w2 = Shape(Shape2).Omega
                r2 = Sqr(dx2 * dx2 + dy2 * dy2)
                vx2 = w2 * r2 * prx2
                vy2 = w2 * r2 * pry2

                ' Mass terms (m1, m2, mu)
                m1 = Shape(Shape1).Mass
                m2 = Shape(Shape2).Mass
                mu = 1 / (1 / m1 + 1 / m2)

                ' Re-Calculate moment of inertia (i1, i2)
                vtemp.x = px1
                vtemp.y = py1
                Call CalculateMOI(Shape1, vtemp)
                vtemp.x = px2
                vtemp.y = py2
                Call CalculateMOI(Shape2, vtemp)
                i1 = Shape(Shape1).MOI
                i2 = Shape(Shape2).MOI

                ' Velocity differentials (v1, v2, dvtx, dvty)
                vcx1 = Shape(Shape1).Velocity.x
                vcy1 = Shape(Shape1).Velocity.y
                vcx2 = Shape(Shape2).Velocity.x
                vcy2 = Shape(Shape2).Velocity.y
                vtx1 = vcx1 + vx1
                vty1 = vcy1 + vy1
                vtx2 = vcx2 + vx2
                vty2 = vcy2 + vy2
                v1 = Sqr(vtx1 * vtx1 + vty1 * vty1)
                v2 = Sqr(vtx2 * vtx2 + vty2 * vty2)
                dvtx = vtx2 - vtx1
                dvty = vty2 - vty1

                ' Geometry (n1dotdvt, n2dotdvt)
                n1dotdvt = nx1 * dvtx + ny1 * dvty
                n2dotdvt = nx2 * dvtx + ny2 * dvty

                ' Momentum exchange (qx1, qy1, qx2, qy2)
                qx1 = nx1 * 2 * mu * n1dotdvt
                qy1 = ny1 * 2 * mu * n1dotdvt
                qx2 = nx2 * 2 * mu * n2dotdvt
                qy2 = ny2 * 2 * mu * n2dotdvt

                ' Momentum exchange unit vector (qhat)
                qq = Sqr(qx1 * qx1 + qy1 * qy1)
                If (qx1 * qx1 > 0.01) Then
                    qhatx1 = qx1 / qq
                Else
                    qx1 = 0
                    qhatx1 = 0
                End If
                If (qy1 * qy1 > 0.01) Then
                    qhaty1 = qy1 / qq
                Else
                    qy1 = 0
                    qhaty1 = 0
                End If
                qq = Sqr(qx2 * qx2 + qy2 * qy2)
                If (qx2 * qx2 > 0.01) Then
                    qhatx2 = qx2 / qq
                Else
                    qx2 = 0
                    qhatx2 = 0
                End If
                If (qy2 * qy2 > 0.01) Then
                    qhaty2 = qy2 / qq
                Else
                    qy2 = 0
                    qhaty2 = 0
                End If

                ' Angular impulse (qdotp)
                q1dotp1 = qx1 * prx1 + qy1 * pry1
                q2dotp2 = qx2 * prx2 + qy2 * pry2

                ' Translational impulse (qdotn, ndotrhat, f)
                q1dotn1 = qhatx1 * nx1 + qhaty1 * ny1
                q2dotn2 = qhatx2 * nx2 + qhaty2 * ny2
                n1dotr1hat = (nx1 * dx1 + ny1 * dy1) / r1
                n2dotr2hat = (nx2 * dx2 + ny2 * dy2) / r2
                f1 = -q1dotn1 * n1dotr1hat
                f2 = -q2dotn2 * n2dotr2hat

                ' Special case for shape within shape.
                np = nx1 * nx2 + ny1 * ny2
                If (np > 0) Then
                    dcx = cx1 - cx2
                    dcy = cy1 - cy2
                    dc = Sqr(dcx * dcx + dcy * dcy)
                    If (dc < (r1 + r2)) Then
                        If (m1 > m2) Then ' This criteria may be bullshit in general but works now.
                            q1dotp1 = -q1dotp1
                            f1 = -f1
                        Else
                            q2dotp2 = -q2dotp2
                            f2 = -f2
                        End If
                    End If
                End If

                ' Angular impulse update (edits omega)
                Shape(Shape1).DeltaO = Shape(Shape1).DeltaO + r1 * q1dotp1 / i1
                Shape(Shape2).DeltaO = Shape(Shape2).DeltaO - r2 * q2dotp2 / i2

                ' Linear impulse update (edits velocity)
                dvx1 = f1 * qx1 / m1
                dvy1 = f1 * qy1 / m1
                dvx2 = f2 * qx2 / m2
                dvy2 = f2 * qy2 / m2
                dvx1s = dvx1 * dvx1
                dvy1s = dvy1 * dvy1
                dvx2s = dvx2 * dvx2
                dvy2s = dvy2 * dvy2
                If ((dvx1s > .001) And (dvx1s < 50)) Then
                    Shape(Shape1).DeltaV.x = Shape(Shape1).DeltaV.x + dvx1
                End If
                If ((dvy1s > .001) And (dvy1s < 50)) Then
                    Shape(Shape1).DeltaV.y = Shape(Shape1).DeltaV.y + dvy1
                End If
                If ((dvx2s > .001) And (dvx2s < 50)) Then
                    Shape(Shape2).DeltaV.x = Shape(Shape2).DeltaV.x + dvx2
                End If
                If ((dvy2s > .001) And (dvy2s < 50)) Then
                    Shape(Shape2).DeltaV.y = Shape(Shape2).DeltaV.y + dvy2
                End If

                ' External torque (edits omega)
                torque1 = m1 * (dx1 * ForceField.y - dy1 * ForceField.x)
                torque2 = m2 * (dx2 * ForceField.y - dy2 * ForceField.x)
                Shape(Shape1).DeltaO = Shape(Shape1).DeltaO - torque1 / i1
                Shape(Shape2).DeltaO = Shape(Shape2).DeltaO - torque2 / i2

                ' Separate along normal (edits position)
                If (Shape(Shape1).Collisions < 2) Then ' changed from = 0
                    vtemp.x = -nx1 * (.5 / m1) * (1 * v1 ^ 2 + 1 * w1 ^ 2)
                    vtemp.y = -ny1 * (.5 / m1) * (1 * v1 ^ 2 + 1 * w1 ^ 2)
                    Call TranslateShape(Shape1, vtemp)
                End If
                If (Shape(Shape2).Collisions < 2) Then
                    vtemp.x = -nx2 * (.5 / m2) * (1 * v2 ^ 2 + 1 * w2 ^ 2)
                    vtemp.y = -ny2 * (.5 / m2) * (1 * v2 ^ 2 + 1 * w2 ^ 2)
                    Call TranslateShape(Shape2, vtemp)
                End If

                ' Dent along normal
                'PointChain(Shape1, ClosestIndex1).x = PointChain(Shape1, ClosestIndex1).x - v1 * nx1 / 2
                'PointChain(Shape1, ClosestIndex1).y = PointChain(Shape1, ClosestIndex1).y - v1 * ny1 / 2
                'PointChain(Shape2, ClosestIndex2).x = PointChain(Shape2, ClosestIndex2).x - v2 * nx2 / 2
                'PointChain(Shape2, ClosestIndex2).y = PointChain(Shape2, ClosestIndex2).y - v2 * ny2 / 2

                ' Feedback
                If ((Shape(Shape1).Collisions = 0) And (Shape(Shape2).Collisions = 0)) Then
                    Call snd(100 * (v1 + v2) / 2, .5)
                End If

            End If
        Next
    End If
End Sub

Sub FleetDynamics (MotionDamping As Double, LowLimitVelocity As Double)

    For ShapeIndex = 1 To ShapeCount

        ' Contact update
        If (Shape(ShapeIndex).CollisionSwitch = 1) Then
            Shape(ShapeIndex).Collisions = Shape(ShapeIndex).Collisions + 1
        Else
            Shape(ShapeIndex).Collisions = 0
        End If

        If (Shape(ShapeIndex).Fixed = 0) Then

            ' Angular velocity update
            Shape(ShapeIndex).Omega = Shape(ShapeIndex).Omega + Shape(ShapeIndex).DeltaO

            ' Linear velocity update
            Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x + Shape(ShapeIndex).DeltaV.x
            Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y + Shape(ShapeIndex).DeltaV.y

            If (Shape(ShapeIndex).Collisions = 0) Then
                ' Freefall (if airborne)
                Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x + ForceField.x
                Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y + ForceField.y
            End If

            If (Shape(ShapeIndex).Collisions > 2) Then
                ' Static friction
                If ((Shape(ShapeIndex).Velocity.x * Shape(ShapeIndex).Velocity.x) < LowLimitVelocity) Then
                    Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x * .05
                End If
                If ((Shape(ShapeIndex).Velocity.y * Shape(ShapeIndex).Velocity.y) < LowLimitVelocity) Then
                    Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y * .05
                End If
                If ((Shape(ShapeIndex).Omega * Shape(ShapeIndex).Omega) < .000015 * LowLimitVelocity) Then
                    Shape(ShapeIndex).Omega = 0
                End If
            End If

            ' Rotation update
            Call RotShape(ShapeIndex, Shape(ShapeIndex).Centroid, Shape(ShapeIndex).Omega)

            ' Position update
            Call TranslateShape(ShapeIndex, Shape(ShapeIndex).Velocity)

            ' Motion Damping
            Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x * MotionDamping
            Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y * MotionDamping
            Shape(ShapeIndex).Omega = Shape(ShapeIndex).Omega * MotionDamping

        Else

            ' Lock all motion
            Shape(ShapeIndex).Velocity.x = 0
            Shape(ShapeIndex).Velocity.y = 0
            Shape(ShapeIndex).Omega = 0

        End If
    Next

End Sub

Sub Graphics
    Line (0, 0)-(_Width, _Height), _RGBA(0, 0, 0, 200), BF
    'Locate 1, 1: Print ProximalPairsCount, CollisionCount, ContactPoints
    For ShapeIndex = 1 To ShapeCount
        For i = 1 To Shape(ShapeIndex).Elements - 1
            Call cpset(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, Shape(ShapeIndex).Shade)
            Call cline(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, PointChain(ShapeIndex, i + 1).x, PointChain(ShapeIndex, i + 1).y, Shape(ShapeIndex).Shade)
            If (ShapeIndex = SelectedShape) Then
                Call ccircle(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, 1, Shape(ShapeIndex).Shade)
            End If
        Next
        Call cpset(PointChain(ShapeIndex, Shape(ShapeIndex).Elements).x, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).y, Shape(ShapeIndex).Shade)
        Call cline(PointChain(ShapeIndex, 1).x, PointChain(ShapeIndex, 1).y, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).x, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).y, Shape(ShapeIndex).Shade)
        Call cline(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, PointChain(ShapeIndex, 1).x, PointChain(ShapeIndex, 1).y, Shape(ShapeIndex).Shade)
        If (ShapeIndex = SelectedShape) Then
            Call ccircle(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, 3, Shape(ShapeIndex).Shade)
            Call cpaint(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, Shape(ShapeIndex).Shade, Shape(ShapeIndex).Shade)
        End If
    Next
    _Display
End Sub

Function IntegrateArray (arr() As Integer, lim As Integer)
    t = 0
    For j = 1 To lim
        t = t + arr(j)
    Next
    IntegrateArray = t
End Function

Function CalculateNormalX (k As Integer, i As Integer)
    Dim l As Vector
    Dim r As Vector
    li = i - 1
    ri = i + 1
    If (i = 1) Then li = Shape(k).Elements
    If (i = Shape(k).Elements) Then ri = 1
    l.x = PointChain(k, li).x
    r.x = PointChain(k, ri).x
    dx = r.x - l.x
    CalculateNormalX = dx
End Function

Function CalculateNormalY (k As Integer, i As Integer)
    Dim l As Vector
    Dim r As Vector
    li = i - 1
    ri = i + 1
    If (i = 1) Then li = Shape(k).Elements
    If (i = Shape(k).Elements) Then ri = 1
    l.y = PointChain(k, li).y
    r.y = PointChain(k, ri).y
    dy = r.y - l.y
    CalculateNormalY = dy
End Function

Sub CalculateCentroid (k As Integer)
    xx = 0
    yy = 0
    For i = 1 To Shape(k).Elements
        xx = xx + PointChain(k, i).x
        yy = yy + PointChain(k, i).y
    Next
    Shape(k).Centroid.x = xx / Shape(k).Elements
    Shape(k).Centroid.y = yy / Shape(k).Elements
End Sub

Sub CalculateDiameter (k As Integer)
    r2max = -1
    For i = 1 To Shape(k).Elements
        xx = Shape(k).Centroid.x - PointChain(k, i).x
        yy = Shape(k).Centroid.y - PointChain(k, i).y
        r2 = xx * xx + yy * yy
        If (r2 > r2max) Then
            r2max = r2
        End If
    Next
    Shape(k).Diameter = Sqr(r2max)
End Sub

Sub CalculateMass (k As Integer, factor As Double)
    aa = 0
    For i = 2 To Shape(k).Elements
        x = PointChain(k, i).x - Shape(k).Centroid.x
        y = PointChain(k, i).y - Shape(k).Centroid.y
        dx = (PointChain(k, i).x - PointChain(k, i - 1).x)
        dy = (PointChain(k, i).y - PointChain(k, i - 1).y)
        da = .5 * (x * dy - y * dx)
        aa = aa + da
    Next
    Shape(k).Mass = factor * Sqr(aa * aa)
End Sub

Sub CalculateMOI (k As Integer, ctrvec As Vector)
    xx = 0
    yy = 0
    For i = 1 To Shape(k).Elements
        a = ctrvec.x - PointChain(k, i).x
        b = ctrvec.y - PointChain(k, i).y
        xx = xx + a * a
        yy = yy + b * b
    Next
    Shape(k).MOI = Sqr((xx + yy) * (xx + yy)) * (Shape(k).Mass / Shape(k).Elements)
End Sub

Sub TranslateShape (k As Integer, c As Vector)
    For i = 1 To Shape(k).Elements
        PointChain(k, i).x = PointChain(k, i).x + c.x
        PointChain(k, i).y = PointChain(k, i).y + c.y
    Next
    Shape(k).Centroid.x = Shape(k).Centroid.x + c.x
    Shape(k).Centroid.y = Shape(k).Centroid.y + c.y
End Sub

Sub RotShape (k As Integer, c As Vector, da As Double)
    For i = 1 To Shape(k).Elements
        xx = PointChain(k, i).x - c.x
        yy = PointChain(k, i).y - c.y
        PointChain(k, i).x = c.x + xx * Cos(da) - yy * Sin(da)
        PointChain(k, i).y = c.y + yy * Cos(da) + xx * Sin(da)
    Next
End Sub

Sub NewAutoBall (x1 As Double, y1 As Double, r1 As Double, r2 As Double, pa As Double, pb As Double, fx As Integer)
    ShapeCount = ShapeCount + 1
    Shape(ShapeCount).Fixed = fx
    Shape(ShapeCount).Collisions = 0
    i = 0
    For j = 0 To (8 * Atn(1)) Step .02 * 8 * Atn(1)
        i = i + 1
        r = r1 + r2 * Cos(pa * j) ^ pb
        PointChain(ShapeCount, i).x = x1 + r * Cos(j)
        PointChain(ShapeCount, i).y = y1 + r * Sin(j)
    Next
    Shape(ShapeCount).Elements = i
    Call CalculateCentroid(ShapeCount)
    If (fx = 0) Then
        Call CalculateMass(ShapeCount, 1)
    Else
        Call CalculateMass(ShapeCount, 999999)
    End If
    Call CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
    Call CalculateDiameter(ShapeCount)
    Shape(ShapeCount).Velocity.x = 0
    Shape(ShapeCount).Velocity.y = 0
    Shape(ShapeCount).Omega = 0
    If (fx = 0) Then
        Shape(ShapeCount).Shade = _RGB(100 + Int(Rnd * 155), 100 + Int(Rnd * 155), 100 + Int(Rnd * 155))
    Else
        Shape(ShapeCount).Shade = _RGB(100, 100, 100)
    End If
    SelectedShape = ShapeCount
End Sub

Sub NewAutoBrick (x1 As Double, y1 As Double, wx As Double, wy As Double, ang As Double)
    ShapeCount = ShapeCount + 1
    Shape(ShapeCount).Fixed = 1
    Shape(ShapeCount).Collisions = 0
    i = 0
    For j = -wy / 2 To wy / 2 Step 5
        i = i + 1
        PointChain(ShapeCount, i).x = x1 + wx / 2
        PointChain(ShapeCount, i).y = y1 + j
    Next
    For j = wx / 2 To -wx / 2 Step -5
        i = i + 1
        PointChain(ShapeCount, i).x = x1 + j
        PointChain(ShapeCount, i).y = y1 + wy / 2
    Next
    For j = wy / 2 To -wy / 2 Step -5
        i = i + 1
        PointChain(ShapeCount, i).x = x1 - wx / 2
        PointChain(ShapeCount, i).y = y1 + j
    Next
    For j = -wx / 2 To wx / 2 Step 5
        i = i + 1
        PointChain(ShapeCount, i).x = x1 + j
        PointChain(ShapeCount, i).y = y1 - wy / 2
    Next
    Shape(ShapeCount).Elements = i
    Call CalculateCentroid(ShapeCount)
    Call CalculateMass(ShapeCount, 99999)
    Call CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
    Call CalculateDiameter(ShapeCount)
    Shape(ShapeCount).Velocity.x = 0
    Shape(ShapeCount).Velocity.y = 0
    Shape(ShapeCount).Omega = 0
    Shape(ShapeCount).Shade = _RGB(100, 100, 100)
    SelectedShape = ShapeCount
    Call RotShape(ShapeCount, Shape(ShapeCount).Centroid, ang)
End Sub

Sub NewBrickLine (xi As Double, yi As Double, xf As Double, yf As Double, wx As Double, wy As Double)
    d1 = Sqr((xf - xi) ^ 2 + (yf - yi) ^ 2)
    d2 = Sqr(wx ^ 2 + wy ^ 2)
    ang = Atn((yf - yi) / (xf - xi))
    f = 1.2 * d2 / d1
    For t = 0 To 1 + f Step f
        Call NewAutoBrick(xi * (1 - t) + xf * t, yi * (1 - t) + yf * t, wx, wy, ang)
    Next
End Sub

Sub NewMouseShape (rawresolution As Double, targetpoints As Integer, smoothiterations As Integer)
    ShapeCount = ShapeCount + 1
    Shape(ShapeCount).Fixed = 0
    Shape(ShapeCount).Collisions = 0
    numpoints = 0
    xold = 999 ^ 999
    yold = 999 ^ 999
    Do
        Do While _MouseInput
            x = _MouseX
            y = _MouseY
            If (x > 0) And (x < _Width) And (y > 0) And (y < _Height) Then
                If _MouseButton(1) Then
                    x = x - (_Width / 2)
                    y = -y + (_Height / 2)
                    delta = Sqr((x - xold) ^ 2 + (y - yold) ^ 2)
                    If (delta > rawresolution) And (numpoints < targetpoints - 1) Then
                        numpoints = numpoints + 1
                        PointChain(ShapeCount, numpoints).x = x
                        PointChain(ShapeCount, numpoints).y = y
                        Call cpset(x, y, _RGB(0, 255, 255))
                        xold = x
                        yold = y
                    End If
                End If
            End If
        Loop
        _Display
    Loop Until Not _MouseButton(1) And (numpoints > 1)

    Do While (numpoints < targetpoints)
        rad2max = -1
        kmax = -1
        For k = 1 To numpoints - 1
            xfac = PointChain(ShapeCount, k).x - PointChain(ShapeCount, k + 1).x
            yfac = PointChain(ShapeCount, k).y - PointChain(ShapeCount, k + 1).y
            rad2 = xfac ^ 2 + yfac ^ 2
            If rad2 > rad2max Then
                kmax = k
                rad2max = rad2
            End If
        Next
        edgecase = 0
        xfac = PointChain(ShapeCount, numpoints).x - PointChain(ShapeCount, 1).x
        yfac = PointChain(ShapeCount, numpoints).y - PointChain(ShapeCount, 1).y
        rad2 = xfac ^ 2 + yfac ^ 2
        If (rad2 > rad2max) Then
            kmax = numpoints
            rad2max = rad2
            edgecase = 1
        End If
        numpoints = numpoints + 1
        If (edgecase = 0) Then
            For j = numpoints To kmax + 1 Step -1
                PointChain(ShapeCount, j + 1).x = PointChain(ShapeCount, j).x
                PointChain(ShapeCount, j + 1).y = PointChain(ShapeCount, j).y
            Next
            PointChain(ShapeCount, kmax + 1).x = (1 / 2) * (PointChain(ShapeCount, kmax).x + PointChain(ShapeCount, kmax + 2).x)
            PointChain(ShapeCount, kmax + 1).y = (1 / 2) * (PointChain(ShapeCount, kmax).y + PointChain(ShapeCount, kmax + 2).y)
        Else
            PointChain(ShapeCount, numpoints).x = (1 / 2) * (PointChain(ShapeCount, 1).x + PointChain(ShapeCount, numpoints - 1).x)
            PointChain(ShapeCount, numpoints).y = (1 / 2) * (PointChain(ShapeCount, 1).y + PointChain(ShapeCount, numpoints - 1).y)
        End If
    Loop

    For j = 1 To smoothiterations
        For k = 2 To numpoints - 1
            TempChain(ShapeCount, k).x = (1 / 2) * (PointChain(ShapeCount, k - 1).x + PointChain(ShapeCount, k + 1).x)
            TempChain(ShapeCount, k).y = (1 / 2) * (PointChain(ShapeCount, k - 1).y + PointChain(ShapeCount, k + 1).y)
        Next
        For k = 2 To numpoints - 1
            PointChain(ShapeCount, k).x = TempChain(ShapeCount, k).x
            PointChain(ShapeCount, k).y = TempChain(ShapeCount, k).y
        Next
        TempChain(ShapeCount, 1).x = (1 / 2) * (PointChain(ShapeCount, numpoints).x + PointChain(ShapeCount, 2).x)
        TempChain(ShapeCount, 1).y = (1 / 2) * (PointChain(ShapeCount, numpoints).y + PointChain(ShapeCount, 2).y)
        PointChain(ShapeCount, 1).x = TempChain(ShapeCount, 1).x
        PointChain(ShapeCount, 1).y = TempChain(ShapeCount, 1).y
        TempChain(ShapeCount, numpoints).x = (1 / 2) * (PointChain(ShapeCount, 1).x + PointChain(ShapeCount, numpoints - 1).x)
        TempChain(ShapeCount, numpoints).y = (1 / 2) * (PointChain(ShapeCount, 1).y + PointChain(ShapeCount, numpoints - 1).y)
        PointChain(ShapeCount, numpoints).x = TempChain(ShapeCount, numpoints).x
        PointChain(ShapeCount, numpoints).y = TempChain(ShapeCount, numpoints).y
    Next

    Shape(ShapeCount).Elements = numpoints
    Call CalculateCentroid(ShapeCount)
    Call CalculateMass(ShapeCount, 1)
    Call CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
    Call CalculateDiameter(ShapeCount)
    Shape(ShapeCount).Velocity.x = 0
    Shape(ShapeCount).Velocity.y = 0
    Shape(ShapeCount).Omega = 0
    Shape(ShapeCount).Shade = _RGB(100 + Int(Rnd * 155), 100 + Int(Rnd * 155), 100 + Int(Rnd * 155))
    SelectedShape = ShapeCount
End Sub

Sub cline (x1 As Double, y1 As Double, x2 As Double, y2 As Double, col As _Unsigned Long)
    Line (_Width / 2 + x1, -y1 + _Height / 2)-(_Width / 2 + x2, -y2 + _Height / 2), col
End Sub

Sub ccircle (x1 As Double, y1 As Double, rad As Double, col As _Unsigned Long)
    Circle (_Width / 2 + x1, -y1 + _Height / 2), rad, col
End Sub

Sub cpset (x1 As Double, y1 As Double, col As _Unsigned Long)
    PSet (_Width / 2 + x1, -y1 + _Height / 2), col
End Sub

Sub cpaint (x1 As Double, y1 As Double, col1 As _Unsigned Long, col2 As _Unsigned Long)
    Paint (_Width / 2 + x1, -y1 + _Height / 2), col1, col2
End Sub

Sub cprintstring (y As Double, a As String)
    _PrintString (_Width / 2 - (Len(a) * 8) / 2, -y + _Height / 2), a
End Sub

Sub snd (frq As Double, dur As Double)
    If ((frq >= 37) And (frq <= 2000)) Then
        Sound frq, dur
    End If
End Sub

Sub SetupPoolGame
    ' Set external field
    ForceField.x = 0
    ForceField.y = 0

    ' Rectangular border
    wx = 42
    wy = 10
    Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
    Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
    wx = 40
    wy = 10
    Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
    Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)

    ' Balls (billiard setup)
    x0 = 160
    y0 = 0
    r = 15
    gg = 2 * r + 4
    gx = gg * Cos(30 * 3.14159 / 180)
    gy = gg * Sin(30 * 3.14159 / 180)
    Call NewAutoBall(x0 + 0 * gx, y0 + 0 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 1 * gx, y0 + 1 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 1 * gx, y0 - 1 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 + 2 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 + 0 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 - 2 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 + 3 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 + 1 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 - 1 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 - 3 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 4 * gx, y0 + 4 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 4 * gx, y0 + 2 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 4 * gx, y0 - 0 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 4 * gx, y0 - 2 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 4 * gx, y0 - 4 * gy, r, 0, 1, 1, 0)

    ' Cue ball
    Call NewAutoBall(-220, 0, r, 0, 1, 1, 0)
    Shape(ShapeCount).Velocity.x = 10 + 2 * Rnd
    Shape(ShapeCount).Velocity.y = 1 * (Rnd - .5)
    Shape(ShapeCount).Shade = _RGB(255, 255, 255)

    ' Parameters
    CPC = 1.15
    FPC = 8
    RST = 0.75
    VD = 0.995
    SV = 0
End Sub

Sub SetupWackyGame
    ' Set external field
    ForceField.x = 0
    ForceField.y = -.08

    ' Rectangular border
    wx = 42
    wy = 10
    Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
    Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
    wx = 40
    wy = 10
    Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
    Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)

    ' Wacky balls
    x0 = -70
    y0 = 120
    r1 = 15
    r2 = 2.5
    gg = 2.5 * (r1 + r2) + 3.5
    gx = gg * Cos(30 * 3.14159 / 180)
    gy = gg * Sin(30 * 3.14159 / 180)
    Call NewAutoBall(x0 + 0 * gx, y0 + 0 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 1 * gx, y0 + 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 1 * gx, y0 - 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 + 2 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 + 0 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 - 2 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 + 3 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 + 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 - 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 - 3 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)

    ' Slanted bricks
    wx = 60
    wy = 10
    ww = Sqr(wx * wx + wy * wy) * .85
    Call NewBrickLine(ww, 0, 100 + ww, 100, wx, wy)
    Call NewBrickLine(-ww, 0, -100 - ww, 100, wx, wy)

    ' Fidget spinner
    Call NewAutoBall(-220, 0, 20, 15, 1.5, 2, 0)
    Shape(ShapeCount).Shade = _RGB(255, 255, 255)

    ' Parameters
    CPC = 1.15
    FPC = 8
    RST = 0.70
    VD = 0.995
    SV = 0.025
End Sub

Sub SetupRings
    ' Set external field
    ForceField.x = 0
    ForceField.y = 0

    ' Rectangular border
    wx = 42
    wy = 10
    Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
    Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
    wx = 40
    wy = 10
    Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
    Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)

    For r = 25 To 175 Step 25
        Call NewAutoBall(0, 0, r, 0, 1, 1, 0)
    Next

    ' Parameters
    CPC = 1.15
    FPC = 8
    RST = 0.75
    VD = 0.995
    SV = 0.025
End Sub

Sub SetupWallsOnly
    ' Set external field
    ForceField.x = 0
    ForceField.y = 0 - .08

    ' Fidget spinner
    Call NewAutoBall(-220, 0, 20, 15, 1.5, 2, 0)
    Shape(ShapeCount).Shade = _RGB(255, 255, 255)

    ' Rectangular border
    wx = 42
    wy = 10
    Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
    Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
    wx = 40
    wy = 10
    Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
    Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)

    ' Parameters
    CPC = 1.15
    FPC = 8
    RST = 0.75
    VD = 0.995
    SV = 0.025
End Sub

Sub SetupAnglePong
    ' Set external field
    ForceField.x = 0
    ForceField.y = 0

    ' Rectangular border
    wx = 42
    wy = 10
    Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
    Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
    wx = 40
    wy = 10
    Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
    Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)

    ' Pong ball
    Call NewAutoBall(-50, 200, 20, 0, 1, 1, 0)
    Shape(ShapeCount).Velocity.x = -1
    Shape(ShapeCount).Velocity.y = -3
    Shape(ShapeCount).Shade = _RGB(255, 255, 255)

    ' Pong Paddle
    Call NewAutoBrick(-100, 10, 100, -10, -.02 * 8 * Atn(1))
    vtemp.x = 0
    vtemp.y = -200
    Call TranslateShape(ShapeCount, vtemp)
    Shape(ShapeCount).Shade = _RGB(200, 200, 200)

    ' Wacky balls
    x0 = -70
    y0 = 120
    r1 = 15
    r2 = 5.5
    gg = 2.5 * (r1 + r2) + 3.5
    gx = gg * Cos(30 * 3.14159 / 180)
    gy = gg * Sin(30 * 3.14159 / 180)
    Call NewAutoBall(x0 + 0 * gx, y0 + 0 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 1 * gx, y0 + 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 1 * gx, y0 - 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 + 2 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 + 0 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 - 2 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 + 3 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 + 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 - 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 - 3 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)

    ' Parameters
    CPC = 1.15
    FPC = 8
    RST = 1 '0.75
    VD = 1 '0.995
    SV = 0.025
End Sub

[bplus]

@james2464
very fine hockey autoplay!
I cannot prove it , but it seems sometimes the ball goes trough the goalkeeper.

@Bplus
strange the effect of end of line stucking the bouncing!
Running your code I have noticed that stucking of ball on a penisula is a switching between 2 lines but there is no moves
moreover the 2 status of bouncing ball have the same blu vector....

That reminds me, I solved the peninsula problem and another one that cropped up after that. 
See here: https://qb64phoenix.com/forum/showthread...99#pid8899

[james2464]

@james2464
very fine hockey autoplay!
I cannot prove it , but it seems sometimes the ball goes trough the goalkeeper.

Thanks!  Yeah the goalies are terrible.  Half the shots go right through them.