Angle Collisions

[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