Angle Collisions

[OldMoses]

Here's my attempt. It will occasionally blow out of the bounds, or deflect at a funny angle. Mostly, it seems to occur at the wall corners. If it blows out and heads for infinity, you can just hit enter to reset the ball to center. Hit escape when you've had enough of it.

I'm thinking a dot product test might rescue blowouts, but it would probably just stick in an infinite loop if the underlying bug isn't corrected.

EDIT: changing the background underlay to hardware image knocked almost 2/3 off of CPU usage.

Code: (Select All)

'Janky wall bouncy ball
TYPE V2 '                                                       Vector type 2D contains
    x AS SINGLE '                                               x component
    y AS SINGLE '                                               y component
END TYPE

TYPE wall '                                                     Wall type contains
    v AS V2 '                                                   direction vector
    n AS V2 '                                                   normalized {orthogonal} vector
    s AS V2 '                                                   start point
    e AS V2 '                                                   end point
    m AS V2 '                                                   midpoint
    l AS INTEGER '                                              length
END TYPE

TYPE ball '                                                     Ball type contains
    p AS V2 '                                                   position
    d AS V2 '                                                   displacement (speed)
    n AS V2 '                                                   normalized displacement vector
    r AS INTEGER '                                              radius
END TYPE

DIM SHARED AS wall w(40)

DIM AS ball b(0)
DIM AS V2 tempv, reflec
DIM SHARED scrw%, scrh%
scrw% = _DESKTOPWIDTH: scrh% = _DESKTOPHEIGHT - 80 '            Create screen
SCREEN _NEWIMAGE(scrw%, scrh%, 32)
DO UNTIL _SCREENEXISTS: LOOP
_SCREENMOVE 0, 0

RANDOMIZE TIMER
Make_wall '                                                     create wall space
FOR x% = 1 TO 40 '                                              draw walls
    LINE (w(x%).s.x, w(x%).s.y)-(w(x%).e.x, w(x%).e.y)
NEXT x%

'initialize ball size, position and velocity
b(0).p.x = _SHR(scrw%, 1): b(0).p.y = _SHR(scrh%, 1): b(0).r = 20
b(0).d.x = INT(RND * 20) - 10: b(0).d.y = INT(RND * 20) - 10 '  random initial direction

back& = _COPYIMAGE(0, 33) '                                     save background

DO '                                                            main loop
    CLS
    _PUTIMAGE , back& '                                         redraw background
    CIRCLE (b(0).p.x, b(0).p.y), b(0).r '                       draw ball
    R2_Add b(0).p, b(0).d, 1 '                                  move ball
    'm! = _HYPOT(b(0).d.x, b(0).d.y) '                           get displacement magnitude
    'R2_Norm b(0).d, b(0).d, m! * .999 '                         apply rolling friction loss

    FOR wc% = 1 TO 40 '                                         check all walls for wall strike
        'first check for a reasonable proximity and skip if not true
        IF _HYPOT(w(wc%).m.x - b(0).p.x, w(wc%).m.y - b(0).p.y) > b(0).r + (w(wc%).l / 2) THEN _CONTINUE
        'We're close so check further
        IF NewlineSegCirc(w(wc%), b(0)) = 0 THEN _CONTINUE '    skip if not intersecting

        'We're intersecting w(wc%) so we back off until we don't, counting the back ups
        R2_Norm b(0).n, b(0).d, 1 '                             get displacement unit vector
        bk% = 0
        DO
            R2_Add b(0).p, b(0).n, -1 '                         backup by unit vectors, updating ball position
            bk% = bk% + 1 '                                     counting number of backups
        LOOP UNTIL NewlineSegCirc(w(wc%), b(0)) = 0 '           until we no longer intersect

        R2_Norm tempv, w(wc%).n, R2_Dot(b(0).d, w(wc%).n) * 2 ' compute reflection angle bisecter
        reflec = tempv: R2_Add reflec, b(0).d, -1 '             subtract ball displacement from bisecter to get reflect vector
        R2_Norm reflec, reflec, -1 '                            invert reflect to point away from wall
        R2_Norm reflec, reflec, bk% '                           recover backed up unit vectors
        R2_Add b(0).p, reflec, 1 '                              and add them to ball position

        m! = _HYPOT(b(0).d.x, b(0).d.y) '                       preserve displacement magnitude
        R2_Norm b(0).d, reflec, m! '                            set ball displacement to new angle
        'R2_Norm b(0).d, b(0).d, m! * .9 '                       lose energy in wall bounce
    NEXT wc%

    IF _KEYDOWN(13) THEN '                                      Press <Enter> to reset ball
        b(0).p.x = _SHR(scrw%, 1): b(0).p.y = _SHR(scrh%, 1)
        b(0).d.x = INT(RND * 20) - 10: b(0).d.y = INT(RND * 20) - 10
    END IF

    _LIMIT 30
    _DISPLAY
LOOP UNTIL _KEYDOWN(27) '                                       Press <Esc> to quit
_FREEIMAGE back&
END

'VECTOR MATH PROCEDURES
'²²²²²²²²Return result of dot product of two vectors²²²²²²²²²²²²
FUNCTION R2_Dot (v AS V2, v2 AS V2)
    R2_Dot = v.x * v2.x + v.y * v2.y
END FUNCTION 'R3_Dot

'²²²²²²²²Add a scalar multiple of se to re²²²²²²²²²²²²²²²²²²²²²²
SUB R2_Add (re AS V2, se AS V2, m AS INTEGER)
    re.x = re.x + se.x * m
    re.y = re.y + se.y * m
END SUB 'R3_Add

'²²²²²²²²Normalize v and regrow to scalar, return in re²²²²²²²²²
SUB R2_Norm (re AS V2, v AS V2, scalar AS SINGLE)
    x! = v.x: y! = v.y '                                        preserve vector v from changes (if desired)
    m! = _HYPOT(x!, y!) '                                       compute magnitude of v
    IF m! = 0 THEN '                                            trap division by zero
        re.x = 0: re.y = 0 '                                    by returning a zero vector
    ELSE '                                                      if magnitude not zero
        re.x = (x! / m!) * scalar '                             shrink to unit vector and rescale x component
        re.y = (y! / m!) * scalar '                               "     "       "       "       " y component
    END IF
END SUB 'R2_Norm

'OTHER SUBROUTINES
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB Make_wall
    DIM AS V2 tmp1, tmp2, tmpc
    lsp% = ((scrw% - 200) + (scrh% - 200)) / 20 '
    trip1% = INT((scrw% - 200) / lsp%) '                        # of horizontal wall sections
    trip2% = 20 - trip1% '                                      # of vertical wall sections
    bs% = 100: dr% = 1 '                                        baseline and direction multiplier
    horz% = -1
    FOR x% = 1 TO 40
        rand% = INT(RND * 80) - 40
        IF x% = 1 THEN '                                        set start point
            w(x%).s.x = bs%
            w(x%).s.y = bs% + rand%
        ELSE
            w(x%).s = w(x% - 1).e
        END IF
        IF x% = 40 THEN '                                       set end point
            w(x%).e = w(1).s
        ELSE
            IF horz% THEN
                w(x%).e.x = w(x%).s.x + lsp% * dr%
                w(x%).e.y = bs% + rand%
            ELSE
                w(x%).e.x = bs% + rand%
                w(x%).e.y = w(x%).s.y + lsp% * dr%
            END IF
        END IF
        w(x%).v = w(x%).e: R2_Add w(x%).v, w(x%).s, -1 '        set wall vector
        tmp1.x = w(x%).v.y: tmp1.y = -w(x%).v.x '               set wall normal     -orthogonal 1
        tmp2.x = -w(x%).v.y: tmp2.y = w(x%).v.x '                                   -orthogonal 2
        tmpc.x = scrw% / 2 - w(x%).e.x: tmpc.y = scrh% / 2 - w(x%).e.y '            -vector pointing at screen center
        IF R2_Dot(tmpc, tmp1) > 0 THEN w(x%).n = tmp1 ELSE w(x%).n = tmp2 '         -choose inward pointing orthogonal
        R2_Norm w(x%).n, w(x%).n, 1 '                                               -and convert it to a unit vector
        w(x%).l = _HYPOT(w(x%).e.x - w(x%).s.x, w(x%).e.y - w(x%).s.y) 'set wall length
        w(x%).m = w(x%).v '                                     set midpoint of wall -midpoint = wall vector
        R2_Norm w(x%).m, w(x%).m, w(x%).l / 2 '                                      -divide by 2
        R2_Add w(x%).m, w(x%).s, 1 '                                                 -add midpoint to start point
        ct% = ct% + 1
        IF horz% AND ct% = trip1% THEN
            horz% = NOT horz%
            ct% = 0: bs% = w(x%).e.x
        END IF
        IF NOT horz% AND ct% = trip2% THEN
            horz% = NOT horz%
            ct% = 0: bs% = w(x%).e.y: dr% = -1
        END IF
    NEXT x%
END SUB 'Make_wall

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION NewlineSegCirc (w AS wall, b AS ball)
    'shorthand version of Bplus' lineSegIntersectCircle
    'utilizing vector math SUBs already implemented
    DIM AS V2 d, p
    DIM AS INTEGER rtn, i
    R2_Norm d, w.v, 1 '                                         d is unit vector of wall
    FOR i = 0 TO w.l '
        p = w.s: R2_Add p, d, i '                               add i multiples to wall start position to get p
        'if p within ball radius then intersect true and leave loop
        IF _HYPOT(p.x - b.p.x, p.y - b.p.y) <= b.r THEN rtn = NOT rtn: EXIT FOR
    NEXT
    NewlineSegCirc = rtn
END FUNCTION 'NewlineSegCirc

[james2464]

This is incredible!  The strategy for making the wall is really interesting.  Lots of stuff I can learn from here.  Thank you.

[OldMoses]

This is incredible!  The strategy for making the wall is really interesting.  Lots of stuff I can learn from here.  Thank you.

Thanks,

Yeah the wall building was a bit of a brain teaser. Since I was after a non-trig function, full vector math approach, I had to build in a lot of information for each wall section. The one thing I didn't need was any angle data, just start and end positions, and the rest is derived from those. Even length wasn't strictly necessary, but it maybe saved on a Pythagorean computation or two.

It sometimes folds in on itself in the upper left corner. I was thinking that dropping the "+ rand%" from 'w(x%).s.y = bs% + rand%' might help stop that. Then the upper left starting corner will always be at (100, 100)

The real sleeper was the R2_Norm sub. I was surprised how much of the brute work it did. It even stepped into Bplus' lineSegIntersectCircle function and shortened up the code considerably, given that the infrastructure was already in place. Having that infrastructure in place kept the wall bouncing code fairly short too.

I'm hoping that some of the learning process in doing this will help me on my billiards program, when I can motivate myself to take it back up.

[james2464]

Well I've had trouble with the random outer border, so I decided to try a fixed pattern for now.   Added frame splitting, so going past the line is kept to a minimum. This seems to make the ball stick every so often, so I need to adjust this.

Code: (Select All)

'vector reflection and line detection demo
'james2464

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
Dim Shared cpa, cpb, a, b, a2, b2, sbx, sby

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


Dim Shared c(10) As Long
c(0) = _RGB(30, 30, 30)
c(1) = _RGB(255, 255, 255)
c(2) = _RGB(255, 255, 0)
c(3) = _RGB(255, 0, 0)
c(4) = _RGB(0, 255, 0)
c(5) = _RGB(0, 255, 255)
c(6) = _RGB(255, 0, 255)


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
End Type
Dim Shared w(50) As fixedwall




Dim Shared walltotal, ballrad

ballrad = 12 'ball radius
walltotal = 10

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


w(1).x1 = 400: w(1).x2 = 456.1285: w(1).y1 = 50: w(1).y2 = 222.7458
w(2).x1 = 456.1285: w(2).x2 = 637.7641: w(2).y1 = 222.7458: w(2).y2 = 222.7458
w(3).x1 = 637.7641: w(3).x2 = 490.8178: w(3).y1 = 222.7458: w(3).y2 = 329.5085
w(4).x1 = 490.8178: w(4).x2 = 546.9463: w(4).y1 = 329.5085: w(4).y2 = 502.2542
w(5).x1 = 546.9463: w(5).x2 = 400: w(5).y1 = 502.2542: w(5).y2 = 395.4915
w(6).x1 = 400: w(6).x2 = 253.0537: w(6).y1 = 395.4915: w(6).y2 = 502.2542
w(7).x1 = 253.0537: w(7).x2 = 309.1822: w(7).y1 = 502.2542: w(7).y2 = 329.5085
w(8).x1 = 309.1822: w(8).x2 = 162.2359: w(8).y1 = 329.5085: w(8).y2 = 222.7458
w(9).x1 = 162.2359: w(9).x2 = 343.8715: w(9).y1 = 222.7458: w(9).y2 = 222.7458
w(10).x1 = 343.8715: w(10).x2 = 400: w(10).y1 = 222.7458: w(10).y2 = 50


wallsetup


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


xv = 6. 'starting ball x velocity
yv = 2. 'starting ball y velocity
sbx = 400 'starting x position
sby = 300 'starting y position

flag = 0

Do

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


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

    '_MouseHide


    sbx = sbx + xv
    sby = sby + yv
    If sbx > (scx - ballrad) Then
        xv = xv * -1
        t = sbx - (scx - ballrad)
        sbx = sbx - t
    End If
    If sby > (scy - ballrad) Then
        yv = yv * -1
        t = sby - (scy - ballrad)
        sby = sby - t
    End If
    If sbx < ballrad Then
        xv = xv * -1
        t = ballrad - sbx
        sbx = sbx + t
    End If
    If sby < ballrad Then
        yv = yv * -1
        t = ballrad - sby
        sby = sby + t
    End If




    '=====================================================
    rt = rectanglecheck 'early wall detection
    'Line (w(rt).x1, w(rt).y1)-(w(rt).x2, w(rt).y2), c(3) 'early detection (red)
    If rectanglecheck > 0 Then
        rt = nearestwall
        Line (w(rt).x1, w(rt).y1)-(w(rt).x2, w(rt).y2), c(4) 'nearest wall (green)
        framesplit
        reflect
    End If


    '=====================================================
    Circle (sbx, sby), (ballrad - 1), c(2) 'screen location of ball


    _Display
    If mouseclick2 = 1 Then flag = 1

Loop Until flag = 1

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

Function rectanglecheck
    rectanglecheck = 0
    ttt = 1
    While ttt <= walltotal
        If sbx >= w(ttt).bx1 Then
            If sbx <= w(ttt).bx2 Then
                If sby >= w(ttt).by1 Then
                    If sby <= w(ttt).by2 Then
                        rectanglecheck = ttt
                    End If
                End If
            End If
        End If
        ttt = ttt + 1
    Wend
End Function

Function nearestwall
    nearestwall = 0
    For ct = 1 To walltotal 'get each wall centerpoint distance from ball
        tdx = Abs(sbx - w(ct).xx)
        tdy = Abs(sby - w(ct).yy)
        w(ct).sc = _Hypot(tdx, tdy)
    Next ct
    'sort to find nearest wall
    lowscore = 500
    lowscorewall = 0
    For ct = 1 To walltotal
        If w(ct).sc < lowscore Then
            old = lowscore
            oldwall = lowscorewall
            lowscore = w(ct).sc
            lowscorewall = ct
        End If
    Next ct
    'faceoff between 2 closest walls
    'predict which will be closer after another frame of movement
    fsbx = sbx + xv
    fsby = sby + yv
    tdx = Abs(fsbx - w(oldwall).xx)
    tdy = Abs(fsby - w(oldwall).yy)
    fscoreold = _Hypot(tdx, tdy)
    tdx = Abs(fsbx - w(lowscorewall).xx)
    tdy = Abs(fsby - w(lowscorewall).yy)
    fscorelow = _Hypot(tdx, tdy)
    If fscoreold < fscorelow Then
        nearestwall = oldwall
    Else
        nearestwall = lowscorewall
    End If
End Function



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


    If Abs(ndp) <= ballrad Then ' ball moved past the line
        overtheline = ballrad - Abs(ndp)
        spd = _Hypot(xv, yv)
        nxv = xv / spd: nyv = yv / spd
        oldsbx = sbx: oldsby = sby
        sbx = sbx - (overtheline * nxv) * .8
        sby = sby - (overtheline * nyv) * .8
    End If
    'check for endpoints distance
End Sub



Sub reflect
    x = sbx - w(rt).xx: y = 0 - sby + w(rt).yy 'location relative to wall
    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
    'Line (w(rt).xx, w(rt).yy)-(w(rt).xx + ndpx, w(rt).yy - ndpy), c(5)

    'calculate point R
    th1 = _Atan2(-y, x) 'radian value of ball (point I)
    th2 = _Atan2(-ndpy, ndpx) 'radian value of line N
    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
    a = w(rt).ny * w(rt).wlen
    b = w(rt).nx * w(rt).wlen
    a2 = a * -1: b2 = b * -1


    c(9) = c(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 '                                           *****  collision with side of the line  *****
            c(9) = c(3) 'if beside the wall, just check length of line N
            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

            'Circle (cpb, cpa), 5, c(4) 'circle the collision point
            '_Display
            '_Delay .01
            sidecollisionvector
        End If
    Else
        If i2w <= ballrad Then '                                              *****  collision with endpoint of the line  *****
            c(9) = c(3)

            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

            'Circle (cpb, cpa), 5, c(4) 'circle the collision point
            '_Display
            '_Delay .01
        End If
    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)
    xv = newxv * spd: yv = newyv * spd * -1
End Sub

Sub endpointcollision1
    tx = x - b: ty = y - a2: th = _Hypot(tx, ty)
    tx2 = tx / th: ty2 = ty / th
    txv = Abs(xv): tyv = Abs(yv): spd = _Hypot(txv, tyv)
    xv = tx2 * spd: yv = ty2 * spd * -1
End Sub


Sub endpointcollision2
    tx = x - b2: ty = y - a: th = _Hypot(tx, ty)
    tx2 = tx / th: ty2 = ty / th
    txv = Abs(xv): tyv = Abs(yv): spd = _Hypot(txv, tyv)
    xv = tx2 * spd: yv = ty2 * spd * -1
End Sub



Sub wallsetup
    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

        Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(1)
        '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
End Sub

[OldMoses]

Well done, that one ran nice and smooth for as long as I watched it. I'll have to study the end strike algorithm and see if it would go into mine.



I added a screen limiter so my ball doesn't go interstellar. If it gets out now, it rebounds off the screen edges. That way it can't maraud about the neighborhood eating innocent children. It would then bounce off the outside of the walls. One thing it demonstrates to me is that the dot product function doesn't care which way the wall orthogonals point, it still bounces correctly on either side. That left me free to cut about five lines of code out of the wall making sub. Of course, I more than put that back in the screen limiter...  

I also got the idea to dot the wall orthogonal with the balls displacement. If they are acute angles (i.e. going the same direction as of an intersection true) then it must indicate that the ball is outside heading in. In which case, it's allowed to continue on its way, skipping the reflection vector step.

I'll have to watch for a while and see if it works. UPDATE: Yes! that worked. A ball that gets out will pass through the walls from the outside and go right back in.

Code: (Select All)

'Janky wall bouncy ball
TYPE V2 '                                                       Vector type 2D contains
    x AS SINGLE '                                               x component
    y AS SINGLE '                                               y component
END TYPE

TYPE wall '                                                     Wall type contains
    v AS V2 '                                                   direction vector
    n AS V2 '                                                   normalized {orthogonal} vector
    s AS V2 '                                                   start point
    e AS V2 '                                                   end point
    m AS V2 '                                                   midpoint
    l AS INTEGER '                                              length
END TYPE

TYPE ball '                                                     Ball type contains
    p AS V2 '                                                   position
    d AS V2 '                                                   displacement (speed)
    n AS V2 '                                                   normalized displacement vector
    r AS INTEGER '                                              radius
END TYPE

DIM SHARED AS wall w(40)

DIM AS ball b(0)
DIM AS V2 tempv, reflec
DIM SHARED scrw%, scrh%
scrw% = _DESKTOPWIDTH: scrh% = _DESKTOPHEIGHT - 80 '            Create screen
SCREEN _NEWIMAGE(scrw%, scrh%, 32)
DO UNTIL _SCREENEXISTS: LOOP
_SCREENMOVE 0, 0

RANDOMIZE TIMER
Make_wall '                                                     create wall space
FOR x% = 1 TO 40 '                                              draw walls
    LINE (w(x%).s.x, w(x%).s.y)-(w(x%).e.x, w(x%).e.y)
    R2_Norm w(x%).n, w(x%).n, 20 '                              create and display orthogonals, 20 length
    LINE (w(x%).m.x, w(x%).m.y)-(w(x%).m.x + w(x%).n.x, w(x%).m.y + w(x%).n.y), &H9FFF0000
    R2_Norm w(x%).n, w(x%).n, 1 '                               reset to unit size
NEXT x%

'initialize ball size, position and velocity
b(0).p.x = _SHR(scrw%, 1): b(0).p.y = _SHR(scrh%, 1): b(0).r = 20
b(0).d.x = INT(RND * 20) - 10: b(0).d.y = INT(RND * 20) - 10 '  random initial direction

back& = _COPYIMAGE(0, 33) '                                     save background

DO '                                                            main loop
    CLS
    _PUTIMAGE , back& '                                         redraw background
    CIRCLE (b(0).p.x, b(0).p.y), b(0).r '                       draw ball
    R2_Add b(0).p, b(0).d, 1 '                                  move ball
    'm! = _HYPOT(b(0).d.x, b(0).d.y) '                           get displacement magnitude
    'R2_Norm b(0).d, b(0).d, m! * .999 '                         apply rolling friction loss

    FOR wc% = 1 TO 40 '                                         check all walls for wall strike
        'first check for a reasonable proximity and skip if not true
        IF _HYPOT(w(wc%).m.x - b(0).p.x, w(wc%).m.y - b(0).p.y) > b(0).r + (w(wc%).l / 2) THEN _CONTINUE
        'We're close so check further
        IF NewlineSegCirc(w(wc%), b(0)) = 0 THEN _CONTINUE '    skip if not intersecting
        IF R2_Dot(w(wc%).n, b(0).d) > 0 THEN _CONTINUE '        if it's out, let it back in
        'We're intersecting w(wc%) so we back off until we don't, counting the back ups
        R2_Norm b(0).n, b(0).d, 1 '                             get displacement unit vector
        bk% = 0
        DO
            R2_Add b(0).p, b(0).n, -1 '                         backup by unit vectors, updating ball position
            bk% = bk% + 1 '                                     counting number of backups
        LOOP UNTIL NewlineSegCirc(w(wc%), b(0)) = 0 '           until we no longer intersect

        R2_Norm tempv, w(wc%).n, R2_Dot(b(0).d, w(wc%).n) * 2 ' compute reflection angle bisecter
        reflec = tempv: R2_Add reflec, b(0).d, -1 '             subtract ball displacement from bisecter to get reflect vector
        R2_Norm reflec, reflec, -1 '                            invert reflect to point away from wall
        R2_Norm reflec, reflec, bk% '                           recover backed up unit vectors
        R2_Add b(0).p, reflec, 1 '                              and add them to ball position

        m! = _HYPOT(b(0).d.x, b(0).d.y) '                       preserve displacement magnitude
        R2_Norm b(0).d, reflec, m! '                            set ball displacement to new angle
        'R2_Norm b(0).d, b(0).d, m! * .9 '                       lose energy in wall bounce
    NEXT wc%
    'if ball escapes the border prevent it from leaving the screen
    IF b(0).p.x > scrw% OR b(0).p.x < 0 THEN
        b(0).d.x = -b(0).d.x
    END IF
    IF b(0).p.y > scrh% OR b(0).p.y < 0 THEN
        b(0).d.y = -b(0).d.y
    END IF

    IF _KEYDOWN(13) THEN '                                      Press <Enter> to reset ball
        b(0).p.x = _SHR(scrw%, 1): b(0).p.y = _SHR(scrh%, 1)
        b(0).d.x = INT(RND * 20) - 10: b(0).d.y = INT(RND * 20) - 10
    END IF

    _LIMIT 30
    _DISPLAY
LOOP UNTIL _KEYDOWN(27) '                                       Press <Esc> to quit
_FREEIMAGE back&
END

'VECTOR MATH PROCEDURES
'²²²²²²²²Return result of dot product of two vectors²²²²²²²²²²²²
FUNCTION R2_Dot (v AS V2, v2 AS V2)
    R2_Dot = v.x * v2.x + v.y * v2.y
END FUNCTION 'R3_Dot

'²²²²²²²²Add a scalar multiple of se to re²²²²²²²²²²²²²²²²²²²²²²
SUB R2_Add (re AS V2, se AS V2, m AS INTEGER)
    re.x = re.x + se.x * m
    re.y = re.y + se.y * m
END SUB 'R3_Add

'²²²²²²²²Normalize v and regrow to scalar, return in re²²²²²²²²²
SUB R2_Norm (re AS V2, v AS V2, scalar AS SINGLE)
    x! = v.x: y! = v.y '                                        preserve vector v from changes (if desired)
    m! = _HYPOT(x!, y!) '                                       compute magnitude of v
    IF m! = 0 THEN '                                            trap division by zero
        re.x = 0: re.y = 0 '                                    by returning a zero vector
    ELSE '                                                      if magnitude not zero
        re.x = (x! / m!) * scalar '                             shrink to unit vector and rescale x component
        re.y = (y! / m!) * scalar '                               "     "       "       "       " y component
    END IF
END SUB 'R2_Norm

'OTHER SUBROUTINES
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB Make_wall
    lsp% = ((scrw% - 200) + (scrh% - 200)) / 20 '
    trip1% = INT((scrw% - 200) / lsp%) '                        # of horizontal wall sections
    trip2% = 20 - trip1% '                                      # of vertical wall sections
    bs% = 100: dr% = 1 '                                        baseline and direction multiplier
    horz% = -1
    FOR x% = 1 TO 40
        rand% = INT(RND * 80) - 40
        IF x% = 1 THEN '                                        set start point
            w(x%).s.x = bs%
            w(x%).s.y = bs% '+ rand%
        ELSE
            w(x%).s = w(x% - 1).e
        END IF
        IF x% = 40 THEN '                                       set end point
            w(x%).e = w(1).s
        ELSE
            IF horz% THEN
                w(x%).e.x = w(x%).s.x + lsp% * dr%
                w(x%).e.y = bs% + rand%
            ELSE
                w(x%).e.x = bs% + rand%
                w(x%).e.y = w(x%).s.y + lsp% * dr%
            END IF
        END IF
        w(x%).v = w(x%).e: R2_Add w(x%).v, w(x%).s, -1 '        set wall vector
        w(x%).n.x = -w(x%).v.y: w(x%).n.y = w(x%).v.x '         compute inward orthogonal
        R2_Norm w(x%).n, w(x%).n, 1 '                           and convert it to a unit vector
        w(x%).l = _HYPOT(w(x%).e.x - w(x%).s.x, w(x%).e.y - w(x%).s.y) 'set wall length
        w(x%).m = w(x%).v '                                     set midpoint of wall -midpoint = wall vector
        R2_Norm w(x%).m, w(x%).m, w(x%).l / 2 '                                      -divide by 2
        R2_Add w(x%).m, w(x%).s, 1 '                                                 -add midpoint to start point
        ct% = ct% + 1
        IF horz% AND ct% = trip1% THEN
            horz% = NOT horz%
            ct% = 0: bs% = w(x%).e.x
        END IF
        IF NOT horz% AND ct% = trip2% THEN
            horz% = NOT horz%
            ct% = 0: bs% = w(x%).e.y: dr% = -1
        END IF
    NEXT x%
END SUB 'Make_wall

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION NewlineSegCirc (w AS wall, b AS ball)
    'shorthand version of Bplus' lineSegIntersectCircle
    'utilizing vector math SUBs already implemented
    DIM AS V2 d, p
    DIM AS INTEGER rtn, i
    R2_Norm d, w.v, 1 '                                         d is unit vector of wall
    FOR i = 0 TO w.l '
        p = w.s: R2_Add p, d, i '                               add i multiples to wall start position to get p
        'if p within ball radius then intersect true and leave loop
        IF _HYPOT(p.x - b.p.x, p.y - b.p.y) <= b.r THEN rtn = NOT rtn: EXIT FOR
    NEXT
    NewlineSegCirc = rtn
END FUNCTION 'NewlineSegCirc

[james2464]

UPDATE: Yes! that worked. A ball that gets out will pass through the walls from the outside and go right back in.

That's interesting, and it could be really useful at some point.   Being able to trap an object that passes a barrier or line.

[OldMoses]

A few refinements later...

I haven't seen it jump out of bounds nearly as much and have tried to implement an algorithm to handle bounces off of points. It seems to work most of the time.

I also added a mouse driven paddle. Tilting the paddle is done with the mouse wheel. Yes, the paddle acts really hinky, and I'm considering an air hockey-like round impactor instead.

Code: (Select All)

'Janky wall bouncy ball
TYPE V2 '                                                       Vector type 2D contains
    x AS SINGLE '                                               x component
    y AS SINGLE '                                               y component
END TYPE

TYPE wall '                                                     Wall type contains
    v AS V2 '                                                   direction vector
    n AS V2 '                                                   normalized {orthogonal} vector
    s AS V2 '                                                   start point
    e AS V2 '                                                   end point
    m AS V2 '                                                   midpoint
    l AS INTEGER '                                              length
END TYPE

TYPE ball '                                                     Ball type contains
    p AS V2 '                                                   position
    d AS V2 '                                                   displacement (speed)
    n AS V2 '                                                   normalized displacement vector
    r AS INTEGER '                                              radius
END TYPE

DIM SHARED AS wall w(40)

DIM AS ball b(0)
DIM AS V2 bisect, reflec, halfv, npnt
DIM SHARED scrw%, scrh%
DIM wloss!, rfric!
wloss! = 1 '                                                    change to <1 if speed loss in wall bounce
rfric! = 1 '                                                    change to <1 if speed loss in rolling friction
scrw% = _DESKTOPWIDTH: scrh% = _DESKTOPHEIGHT - 80 '            Create screen
SCREEN _NEWIMAGE(scrw%, scrh%, 32)
DO UNTIL _SCREENEXISTS: LOOP
_SCREENMOVE 0, 0

RANDOMIZE TIMER
Make_wall '                                                     create wall space
FOR x% = 1 TO 40 '                                              draw walls
    LINE (w(x%).s.x, w(x%).s.y)-(w(x%).e.x, w(x%).e.y)
    R2_Norm w(x%).n, w(x%).n, 20 '                              create and display orthogonals, 20 length
    LINE (w(x%).m.x, w(x%).m.y)-(w(x%).m.x + w(x%).n.x, w(x%).m.y + w(x%).n.y), &H9FFF0000
    R2_Norm w(x%).n, w(x%).n, 1 '                               reset to unit size
NEXT x%

'initialize ball size, position and velocity
b(0).p.x = _SHR(scrw%, 1): b(0).p.y = _SHR(scrh%, 1): b(0).r = 20
b(0).d.x = INT(RND * 20) - 10: b(0).d.y = INT(RND * 20) - 10 '  random initial direction
'b(0).d.x = INT(RND * 40) - 20: b(0).d.y = INT(RND * 40) - 20 '  random initial direction
'b(0).d.x = 19: b(0).d.y = 19 '  full speed

back& = _COPYIMAGE(0, 33) '                                     save background

'Paddle wall initialization
w(0).s.x = scrw% / 2 - 50: w(0).s.y = scrh% / 2 '               start point
w(0).e.x = scrw% / 2 + 50: w(0).e.y = scrh% / 2 '               end point
P2V w(0).v, w(0).s, w(0).e '                                    set paddle vector
Ortho_Norm w(0).n, w(0).v '                                     compute paddle unit orthogonal
w(0).l = Mag(w(0).v)
w(0).m = w(0).v '                                               set midpoint of wall -midpoint = wall vector
R2_Norm w(0).m, w(0).m, w(0).l / 2 '                            divide by 2
R2_Add w(0).m, w(0).s, 1 '                                      add midpoint to start point
_MOUSEHIDE
DO '                                                            main loop
    CLS
    _PUTIMAGE , back& '                                         redraw background
    WHILE _MOUSEINPUT
        'mousewheel ops
        R2_Norm w(0).v, w(0).v, 10 '                            reduce vector granularity (speeds mousewheel changes)
        IF ABS(w(0).v.x) <= ABS(w(0).v.y) THEN
            w(0).v.x = w(0).v.x + SGN(_MOUSEWHEEL)
        ELSE
            w(0).v.y = w(0).v.y + SGN(_MOUSEWHEEL)
        END IF
        R2_Norm w(0).v, w(0).v, 50
        Ortho_Norm w(0).n, w(0).v
        w(0).s = w(0).m: R2_Add w(0).s, w(0).v, -1
        w(0).e = w(0).m: R2_Add w(0).e, w(0).v, 1
        R2_Norm w(0).v, w(0).v, 100
    WEND
    w(0).m.x = _MOUSEX: w(0).m.y = _MOUSEY
    R2_Norm halfv, w(0).v, 50
    w(0).s = w(0).m: R2_Add w(0).s, halfv, -1
    w(0).e = w(0).m: R2_Add w(0).e, halfv, 1
    'IF _MOUSEBUTTON(1) THEN
    '    b(0).p.x = _MOUSEX: b(0).p.y = _MOUSEY
    'END IF
    LINE (w(0).s.x, w(0).s.y)-(w(0).e.x, w(0).e.y) '            draw paddle
    CIRCLE (b(0).p.x, b(0).p.y), b(0).r '                       draw ball
    R2_Add b(0).p, b(0).d, 1 '                                  move ball
    R2_Norm b(0).d, b(0).d, Mag(b(0).d) * rfric! '              apply rolling friction loss (if desired)

    FOR wc% = 0 TO 40 '                                         check all walls for wall strike
        'first check for a reasonable proximity and skip if not true
        IF _HYPOT(w(wc%).m.x - b(0).p.x, w(wc%).m.y - b(0).p.y) > b(0).r + (w(wc%).l / 2) THEN _CONTINUE
        'We're close so check further
        IF NewlineSegCirc(w(wc%), b(0)) = 0 THEN _CONTINUE '    skip if not intersecting
        IF wc% > 0 THEN '                                       if not the paddle
            IF R2_Dot(w(wc%).n, b(0).d) > 0 THEN _CONTINUE '    if it's out, let it back in
        END IF
        'We're close to wc%, but are we closer to wc% + 1?  this might go in the above IF THEN

        SELECT CASE wc% '                                       get adjacent wall indexes
            CASE 1: pre% = 40: sbs% = 2
            CASE 40: pre% = 39: sbs% = 1
            CASE ELSE: pre% = wc% - 1: sbs% = wc% + 1
        END SELECT
        'check hypot of start and end points
        IF _HYPOT(w(wc%).s.x - b(0).p.x, w(wc%).s.y - b(0).p.y) < b(0).r THEN alt% = pre% 'closer to previous wall
        IF _HYPOT(w(wc%).e.x - b(0).p.x, w(wc%).e.y - b(0).p.y) < b(0).r THEN alt% = sbs% 'closer to subsequent wall
        'We're intersecting w(wc%) so we back off until we don't, counting the back ups
        'we check both wc% and alt% walls. Which one goes low on backup first?
        R2_Norm b(0).n, b(0).d, 1 '                             get displacement unit vector
        bk% = 0
        DO
            R2_Add b(0).p, b(0).n, -1 '                         backup by unit vectors, updating ball position
            IF alt% <> 0 AND wc% <> 0 THEN '                    if alternate wall set and not checking paddle
                mainlow% = NewlineSegCirc(w(wc%), b(0)) '       main wall intersect
                altlow% = NewlineSegCirc(w(alt%), b(0)) '       alternate wall intersect
                IF mainlow% = 0 AND altlow% = 0 THEN '          if both walls go low simultaneously
                    'alter the bisecter between wc% & alt%, two step process
                    Vec_Mirror bisect, w(wc%).n, w(alt%).n '    first bisect wc% and alt% orthogonals
                    R2_Norm bisect, bisect, 1 '                 normalize it for next step
                    Vec_Mirror bisect, bisect, b(0).d '         then bisect result with ball displacement vector
                    in% = -1
                ELSEIF mainlow% = 0 AND altlow% <> 0 THEN '     if main wall goes low first
                    Vec_Mirror bisect, w(wc%).n, b(0).d '       use wc% bisecter
                    in% = -1
                ELSEIF mainlow% <> 0 AND altlow% = 0 THEN '     if alternate wall goes low first
                    Vec_Mirror bisect, w(alt%).n, b(0).d '      use alt% bisecter
                    in% = -1
                END IF
            ELSE
                mainlow% = NewlineSegCirc(w(wc%), b(0))
                IF mainlow% = 0 THEN in% = -1
                Vec_Mirror bisect, w(wc%).n, b(0).d
            END IF
            bk% = bk% + 1 '                                     counting number of backups
        LOOP UNTIL in% '                                        until we no longer intersect one or the other
        in% = 0: alt% = 0
        reflec = bisect: R2_Add reflec, b(0).d, -1 '            subtract ball displacement from bisecter to get reflect vector
        R2_Norm reflec, reflec, -bk% '                          invert & recover backed up unit vectors
        R2_Add b(0).p, reflec, 1 '                              and add them to ball position

        m! = Mag(b(0).d) '                                      preserve displacement magnitude
        R2_Norm b(0).d, reflec, m! '                            set ball displacement to new angle
        'R2_Norm b(0).d, b(0).d, m! * wloss! '                  lose energy in wall bounce (if desired)
        EXIT FOR '                                              if we got here no more checks are needed
    NEXT wc%
    'if ball escapes the border prevent it from leaving the screen
    IF b(0).p.x > scrw% OR b(0).p.x < 0 THEN
        b(0).d.x = -b(0).d.x
    END IF
    IF b(0).p.y > scrh% OR b(0).p.y < 0 THEN
        b(0).d.y = -b(0).d.y
    END IF

    IF _KEYDOWN(13) THEN '                                      Press <Enter> to reset ball
        b(0).p.x = _SHR(scrw%, 1): b(0).p.y = _SHR(scrh%, 1)
        b(0).d.x = INT(RND * 20) - 10: b(0).d.y = INT(RND * 20) - 10
    END IF

    _LIMIT 60
    _DISPLAY
LOOP UNTIL _KEYDOWN(27) '                                       Press <Esc> to quit
_FREEIMAGE back&
END

'VECTOR MATH PROCEDURES
'²²²²²²²²Convert points st & nd to a vector²²²²²²²²²²²²²²²²²²²²
SUB P2V (v AS V2, st AS V2, nd AS V2)
    v.x = nd.x - st.x
    v.y = nd.y - st.y
END SUB 'P2V

'²²²²²²²²Mirror a vector in around a unit bisecter²²²²²²²²²²²²²²
SUB Vec_Mirror (re AS V2, m AS V2, in AS V2)
    R2_Norm re, m, R2_Dot(in, m) * 2
END SUB 'Vec_Mirror

'²²²²²²²²Return result of dot product of two vectors²²²²²²²²²²²²
FUNCTION R2_Dot (v AS V2, v2 AS V2)
    R2_Dot = v.x * v2.x + v.y * v2.y
END FUNCTION 'R3_Dot

'²²²²²²²²Add a scalar multiple of se to re²²²²²²²²²²²²²²²²²²²²²²
SUB R2_Add (re AS V2, se AS V2, m AS INTEGER)
    re.x = re.x + se.x * m
    re.y = re.y + se.y * m
END SUB 'R3_Add

'²²²²²²²²Compute magnitude of vector v²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION Mag (v AS V2)
    Mag = _HYPOT(v.x, v.y)
END FUNCTION 'Mag

'²²²²²²²²Normalize v and regrow to scalar, return in re²²²²²²²²²
SUB R2_Norm (re AS V2, v AS V2, scalar AS SINGLE)
    x! = v.x: y! = v.y '                                        preserve vector v from changes (if desired)
    m! = _HYPOT(x!, y!) '                                       compute magnitude of v
    IF m! = 0 THEN '                                            trap division by zero
        re.x = 0: re.y = 0 '                                    by returning a zero vector
    ELSE '                                                      if magnitude not zero
        re.x = (x! / m!) * scalar '                             shrink to unit vector and rescale x component
        re.y = (y! / m!) * scalar '                               "     "       "       "       " y component
    END IF
END SUB 'R2_Norm

'²²²²²²²²Return the unit orthogonal of a vector²²²²²²²²²²²²²²²²²
SUB Ortho_Norm (orth AS V2, vec AS V2)
    orth.x = -vec.y: orth.y = vec.x '                           compute orthogonal
    R2_Norm orth, orth, 1 '                                     and convert it to a unit vector
END SUB 'Ortho_Norm

'OTHER SUBROUTINES
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB Make_wall
    lsp% = ((scrw% - 200) + (scrh% - 200)) / 20 '
    trip1% = INT((scrw% - 200) / lsp%) '                        # of horizontal wall sections
    trip2% = 20 - trip1% '                                      # of vertical wall sections
    bs% = 100: dr% = 1 '                                        baseline and direction multiplier
    horz% = -1
    FOR x% = 1 TO 40
        rand% = INT(RND * 80) - 40
        IF x% = 1 THEN '                                        set start point
            w(x%).s.x = bs%
            w(x%).s.y = bs%
        ELSE
            w(x%).s = w(x% - 1).e
        END IF
        IF x% = 40 THEN '                                       set end point
            w(x%).e = w(1).s
        ELSE
            IF horz% THEN
                w(x%).e.x = w(x%).s.x + lsp% * dr%
                w(x%).e.y = bs% + rand%
            ELSE
                w(x%).e.x = bs% + rand%
                w(x%).e.y = w(x%).s.y + lsp% * dr%
            END IF
        END IF
        P2V w(x%).v, w(x%).s, w(x%).e '                         set wall vector
        Ortho_Norm w(x%).n, w(x%).v
        w(x%).l = Mag(w(x%).v) '                                set wall length
        w(x%).m = w(x%).v '                                     set midpoint of wall -midpoint = wall vector
        R2_Norm w(x%).m, w(x%).m, w(x%).l / 2 '                                      -divide by 2
        R2_Add w(x%).m, w(x%).s, 1 '                                                 -add midpoint to start point
        ct% = ct% + 1
        IF horz% AND ct% = trip1% THEN
            horz% = NOT horz%
            ct% = 0: bs% = w(x%).e.x
        END IF
        IF NOT horz% AND ct% = trip2% THEN
            horz% = NOT horz%
            ct% = 0: bs% = w(x%).e.y: dr% = -1
        END IF
    NEXT x%
END SUB 'Make_wall

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION NewlineSegCirc (w AS wall, b AS ball)
    'shorthand version of Bplus' lineSegIntersectCircle
    'utilizing vector math SUBs already implemented
    DIM AS V2 d, p
    DIM AS INTEGER rtn, i
    R2_Norm d, w.v, 1 '                                         d is unit vector of wall
    FOR i = 0 TO w.l '
        p = w.s: R2_Add p, d, i '                               add i multiples to wall start position to get p
        'if p within ball radius then intersect true and leave loop
        IF _HYPOT(p.x - b.p.x, p.y - b.p.y) <= b.r THEN rtn = NOT rtn: EXIT FOR
    NEXT
    NewlineSegCirc = rtn
END FUNCTION 'NewlineSegCirc

[james2464]

This is awesome! Actually a working "Caveball" now. I like the air hockey with jagged borders idea.

[james2464]

I've been working at this and now I'm having too much fun.    Random walls and some controls now.   I think I understand this enough to apply this in a game.   There is still another common game vector challenge I haven't tried yet, which is line/line intersection detection.   I'm curious about how fast objects (like bullets) are kept from going through walls, and of course reflect as well.   I'm guessing it's with line intersections but we'll see.

Code: (Select All)

'vector random angle collision demo
'james2464

'CONTROLS:
'Arrow keys:  Left and right:  change size of ball
'            Up and Down:    change speed
'Space Bar :  Random Restart
'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 = 20 'ball radius
walltotal = 11

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




wallsetup


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


'start
xv01 = 0
yv01 = 5.
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 > (scx - ballrad) Then
        xv = xv * -1
        t = sbx - (scx - ballrad)
        sbx = sbx - t
    End If
    If sby > (scy - ballrad) Then
        yv = yv * -1
        t = sby - (scy - ballrad)
        sby = sby - t
    End If
    If sbx < ballrad Then
        xv = xv * -1
        t = ballrad - sbx
        sbx = sbx + t
    End If
    If sby < ballrad Then
        yv = yv * -1
        t = ballrad - sby
        sby = sby + t
    End If




    '=====================================================
    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(2) 'screen location of ball
    'Paint (sbx, sby), c(17), c(2)
    '_Delay .5 'use to step through animation to see each frame separately

    If _KeyDown(18432) Then '                                IF up arrow key was pressed
        yv = yv * 1.1
        xv = xv * 1.1
    End If
    If _KeyDown(20480) Then '                                IF down arrow key was pressed
        yv = yv * .9
        xv = xv * .9
    End If

    If _KeyDown(19200) Then '                                IF left arrow key was pressed
        ballrad = ballrad * .9
        If ballrad < 2 Then ballrad = 2

    End If

    If _KeyDown(19712) Then '                                IF right arrow key was pressed
        ballrad = ballrad * 1.1
        If ballrad > 40 Then ballrad = 40
    End If

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

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

        Cls
        _Delay .5
        wallsetup


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

        ballrad = Int(Rnd * 20) + 5
        xv = xv01 'starting ball x velocity
        yv = yv01 'starting ball y velocity
        sbx = sbx01 'starting x position
        sby = sby01 'starting y position
    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 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

    w(1).x1 = 400: w(1).x2 = w(1).x1 + Rnd * 100 + 50: w(1).y1 = 200: w(1).y2 = 250
    w(2).x1 = w(1).x2: w(2).x2 = w(2).x1 + Rnd * 100: w(2).y1 = 250: w(2).y2 = 350
    w(3).x1 = w(2).x2: w(3).x2 = w(3).x1 + Rnd * 100: w(3).y1 = 350: w(3).y2 = 450
    w(4).x1 = w(3).x2: w(4).x2 = w(4).x1 - Rnd * 100 - 50: w(4).y1 = 450: w(4).y2 = 470
    w(5).x1 = w(4).x2: w(5).x2 = w(5).x1 - Rnd * 100 - 100: w(5).y1 = 470: w(5).y2 = 450
    w(6).x1 = w(5).x2: w(6).x2 = w(6).x1 - Rnd * 100 - 100: w(6).y1 = 450: w(6).y2 = 350
    w(7).x1 = w(6).x2: w(7).x2 = w(7).x1 - Rnd * 100 - 50: w(7).y1 = 350: w(7).y2 = 250
    w(8).x1 = w(7).x2: w(8).x2 = w(1).x1: w(8).y1 = 250: w(8).y2 = 200

    'inner walls
    w(9).x1 = 400: w(9).x2 = w(9).x1 + Rnd * 50 + 10: w(9).y1 = 320: w(9).y2 = 350
    w(10).x1 = 400: w(10).x2 = w(10).x1 - Rnd * 50 - 10: w(10).y1 = 320: w(10).y2 = 350
    w(11).x1 = w(10).x2: w(11).x2 = w(9).x2: w(11).y1 = w(10).y2: w(11).y2 = w(9).y2


    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

        Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(1)
        '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
End Sub

Sub colour1
    c(0) = _RGB(0, 100, 0)
    c(1) = _RGB(255, 255, 255)
    c(2) = _RGB(255, 255, 0)
    c(3) = _RGB(255, 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, 255)
    c(8) = _RGB(150, 150, 250)
    c(9) = _RGB(250, 150, 150)
    c(10) = _RGB(150, 250, 150)
    c(11) = _RGB(255, 255, 255)
    c(12) = _RGB(255, 255, 0)
    c(13) = _RGB(255, 0, 0)
    c(14) = _RGB(0, 255, 0)
    c(15) = _RGB(0, 255, 255)
    c(16) = _RGB(255, 0, 255)
    c(17) = _RGB(30, 30, 255)
    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]

"I'm curious about how fast objects (like bullets) are kept from going through walls, and of course reflect as well. I'm guessing it's with line intersections but we'll see."

Aren't bullets just like a little circle (more elliptical but circle close enough eg cannon balls and musket balls... circles are best shape for flying, not so much landing though).

If you really did have to do Line (segment) intersect Line (segment) don't mistake for line intersect line which we learned to solve in Algebra. That method assumes infinity long lines. I first used that with your problem of jagged edges and the ball ended up way more limited where it could go inside the container. See early on in this thread.