Box and Pixel Collisions pkg - Printable Version

Code: (Select All)
OPTION _EXPLICIT

_TITLE "Spiders refactored Collision Experiment" 'b+ 2023-01-28    !!! Speaker volume around 20 maybe! !!!

' Experiment is to only change direction of spider that bumps into another (first) not both spiders

' I want to see I can avoid pile ups that way instead of changing directions 30% of time.



' Yes! I luv the spinning spiders and 100% reactions to collisions by 1 spider at least



' !!!!!!!!!!!!!!!!!!!          Escape to Quit         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!



RANDOMIZE TIMER

DIM SHARED xmax AS INTEGER, ymax AS INTEGER

xmax = _DESKTOPWIDTH

ymax = _DESKTOPHEIGHT

CONST nSpinners = 30

TYPE Vec2

    x AS SINGLE

    y AS SINGLE

END TYPE

TYPE SpinnerType

    p AS Vec2

    d AS Vec2

    'a AS SINGLE

    sz AS SINGLE

    c AS _UNSIGNED LONG

END TYPE

DIM SHARED s(1 TO nSpinners) AS SpinnerType



TYPE boxType ' for PixelCollison&

    AS SINGLE dx, dy

    'AS Vec2 d

    AS LONG img, x, y, w, h

    c AS _UNSIGNED LONG

END TYPE



'DIM power1

DIM AS LONG i, j, iImg, jImg, lc, i2, sc, intx, inty

DIM AS boxType sIo, sJo



sc = _SCREENIMAGE

SCREEN _NEWIMAGE(xmax, ymax, 32)

_FULLSCREEN

FOR i = 1 TO nSpinners

    newSpinner i

NEXT

i2 = 1

WHILE INKEY$ <> CHR$(27)

    _PUTIMAGE , sc, 0

    lc = lc + 1

    IF lc MOD 100 = 99 THEN

        lc = 0

        IF i2 < nSpinners THEN i2 = i2 + 1

    END IF

    FOR i = 1 TO i2



        'ready for collision check



        ' max sz = .75 which needs 140 x 140 image square  +++++++++++++++++++++++++

        iImg = _NEWIMAGE(140, 140, 32)

        _DEST iImg

        drawSpinner iImg, 70, 70, s(i).sz, _ATAN2(s(i).d.y, s(i).d.x), s(i).c

        _DEST 0

        sIo.x = s(i).p.x - 70

        sIo.y = s(i).p.y - 70

        sIo.w = 140

        sIo.h = 140

        sIo.img = iImg ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++



        's(i).a = _ATAN2(s(i).d.y, s(i).d.x)

        'power1 = _HYPOT(s(i).d.x, s(i).d.y) '(s(i).dx ^ 2 + s(i).dy ^ 2) ^ .5

        'imoved = 0

        FOR j = i + 1 TO i2



            ' max sz = .75 which needs 140 x 140 image square +++++++++++++++++++++

            jImg = _NEWIMAGE(140, 140, 32)

            _DEST jImg

            drawSpinner jImg, 70, 70, s(j).sz, _ATAN2(s(j).d.y, s(j).d.x), s(j).c

            _DEST 0

            sJo.x = s(j).p.x - 70

            sJo.y = s(j).p.y - 70

            sJo.w = 140

            sJo.h = 140

            sJo.img = jImg



            IF PixelCollision&(sIo, sJo, intx, inty) THEN '+++++++++++++++++++++++++++++++++++++++

                SOUND RND * 5000 + 1000, .1 * RND

                's(i).a = s(i).a + _PI(.33) ' turn 30 degrees

                's(i).d.x = power1 * COS(s(i).a) 'update dx, dy

                's(i).d.y = power1 * SIN(s(i).a)

                DIM sep AS Vec2

                sep = s(i).p: R2_Add sep, s(j).p, -1 'separation vector between spiders

                R2_Norm s(i).d, sep, R2_Mag(s(j).d) + 1 'set displacement to separation vector

                R2_Add s(i).p, s(i).d, s(j).sz * 2 'add 3x displacement "jump" to position

                IF s(j).sz > s(i).sz THEN R2_Norm s(j).d, sep, R2_Mag(s(j).d)

                EXIT FOR

            END IF

            _FREEIMAGE jImg

        NEXT

        R2_Add s(i).p, s(i).d, 1

        IF s(i).p.x < -100 OR s(i).p.x > xmax + 100 OR s(i).p.y < -100 OR s(i).p.y > ymax + 100 THEN newSpinner i

        _PUTIMAGE (s(i).p.x - 70, s(i).p.y - 70), iImg, 0

        _FREEIMAGE iImg

    NEXT

    _DISPLAY

    _LIMIT 15

WEND



SUB newSpinner (i AS INTEGER) 'set Spinners dimensions start angles, color?

    DIM r

    s(i).sz = RND * .25 + .5

    IF RND < .5 THEN r = -1 ELSE r = 1

    s(i).d.x = (s(i).sz * RND * 8) * r * 2 + 2: s(i).d.y = (s(i).sz * RND * 8) * r * 2 + 2

    r = INT(RND * 4)

    SELECT CASE r

        CASE 0: s(i).p.x = RND * (xmax - 120) + 60: s(i).p.y = 0: IF s(i).d.y < 0 THEN s(i).d.y = -s(i).d.y

        CASE 1: s(i).p.x = RND * (xmax - 120) + 60: s(i).p.y = ymax: IF s(i).d.y > 0 THEN s(i).d.y = -s(i).d.y

        CASE 2: s(i).p.x = 0: s(i).p.y = RND * (ymax - 120) + 60: IF s(i).d.x < 0 THEN s(i).d.x = -s(i).d.x

        CASE 3: s(i).p.x = xmax: s(i).p.y = RND * (ymax - 120) + 60: IF s(i).d.x > 0 THEN s(i).d.x = -s(i).d.x

    END SELECT

    r = RND * 100 + 40

    s(i).c = _RGB32(r, .5 * RND * r, RND * .25 * r)

END SUB



SUB drawSpinner (idest&, x AS INTEGER, y AS INTEGER, scale AS SINGLE, heading AS SINGLE, c AS _UNSIGNED LONG)

    DIM x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd, red, blue, green

    STATIC switch AS INTEGER

    switch = switch + 2

    switch = switch MOD 16 + 1

    red = _RED32(c): green = _GREEN32(c): blue = _BLUE32(c)

    r = 10 * scale

    x1 = x + r * COS(heading): y1 = y + r * SIN(heading)

    r = 2 * r 'lg lengths

    FOR lg = 1 TO 8

        IF lg < 5 THEN

            a = heading + .9 * lg * _PI(1 / 5) + (lg = switch) * _PI(1 / 10)

        ELSE

            a = heading - .9 * (lg - 4) * _PI(1 / 5) - (lg = switch) * _PI(1 / 10)

        END IF

        x2 = x1 + r * COS(a): y2 = y1 + r * SIN(a)

        drawLink idest&, x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(red + 20, green + 10, blue + 5)

        IF lg = 1 OR lg = 2 OR lg = 7 OR lg = 8 THEN d = -1 ELSE d = 1

        a1 = a + d * _PI(1 / 12)

        x3 = x2 + r * 1.5 * COS(a1): y3 = y2 + r * 1.5 * SIN(a1)

        drawLink idest&, x2, y2, 2 * scale, x3, y3, scale, _RGB32(red + 35, green + 17, blue + 8)

        rd = INT(RND * 8) + 1

        a2 = a1 + d * _PI(1 / 8) * rd / 8

        x4 = x3 + r * 1.5 * COS(a2): y4 = y3 + r * 1.5 * SIN(a2)

        drawLink idest&, x3, y3, scale, x4, y4, scale, _RGB32(red + 50, green + 25, blue + 12)

    NEXT

    r = r * .5

    fcirc x1, y1, r, _RGB32(red - 20, green - 10, blue - 5)

    x2 = x1 + (r + 1) * COS(heading - _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading - _PI(1 / 12))

    fcirc x2, y2, r * .2, &HFF000000

    x2 = x1 + (r + 1) * COS(heading + _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading + _PI(1 / 12))

    fcirc x2, y2, r * .2, &HFF000000

    r = r * 2

    x1 = x + r * .9 * COS(heading + _PI): y1 = y + r * .9 * SIN(heading + _PI)

    TiltedEllipseFill idest&, x1, y1, r, .7 * r, heading + _PI, _RGB32(red, green, blue)

END SUB



SUB drawLink (idest&, x1, y1, r1, x2, y2, r2, c AS _UNSIGNED LONG)

    DIM a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6

    a = _ATAN2(y2 - y1, x2 - x1)

    a1 = a + _PI(1 / 2)

    a2 = a - _PI(1 / 2)

    x3 = x1 + r1 * COS(a1): y3 = y1 + r1 * SIN(a1)

    x4 = x1 + r1 * COS(a2): y4 = y1 + r1 * SIN(a2)

    x5 = x2 + r2 * COS(a1): y5 = y2 + r2 * SIN(a1)

    x6 = x2 + r2 * COS(a2): y6 = y2 + r2 * SIN(a2)

    fquad idest&, x3, y3, x4, y4, x5, y5, x6, y6, c

    fcirc x1, y1, r1, c

    fcirc x2, y2, r2, c

END SUB



'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4

SUB fquad (idest&, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, x3 AS INTEGER, y3 AS INTEGER, x4 AS INTEGER, y4 AS INTEGER, c AS _UNSIGNED LONG)

    ftri idest&, x1, y1, x2, y2, x4, y4, c

    ftri idest&, x3, y3, x4, y4, x1, y1, c

END SUB



SUB ftri (idest&, x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)

    DIM a&

    a& = _NEWIMAGE(1, 1, 32)

    _DEST a&

    PSET (0, 0), K

    _DEST idest&

    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)

    _FREEIMAGE a& '<<< this is important!

END SUB



SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)

    DIM Radius AS INTEGER, RadiusError AS INTEGER

    DIM X AS INTEGER, Y AS INTEGER

    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0

    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB

    LINE (CX - X, CY)-(CX + X, CY), C, BF

    WHILE X > Y

        RadiusError = RadiusError + Y * 2 + 1

        IF RadiusError >= 0 THEN

            IF X <> Y + 1 THEN

                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF

                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF

            END IF

            X = X - 1

            RadiusError = RadiusError - X * 2

        END IF

        Y = Y + 1

        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF

        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF

    WEND

END SUB



SUB TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c AS _UNSIGNED LONG)

    DIM TEmax AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER, k AS SINGLE, lasti AS SINGLE, lastj AS SINGLE

    DIM prc AS _UNSIGNED LONG, tef AS LONG

    prc = _RGB32(255, 255, 255, 255)

    IF a > b THEN TEmax = a + 1 ELSE TEmax = b + 1

    mx2 = TEmax + TEmax

    tef = _NEWIMAGE(mx2, mx2)

    _DEST tef

    _SOURCE tef 'point wont read without this!

    FOR k = 0 TO 6.2832 + .05 STEP .1

        i = TEmax + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)

        j = TEmax + a * COS(k) * SIN(ang) - b * SIN(k) * COS(ang)

        IF k <> 0 THEN

            LINE (lasti, lastj)-(i, j), prc

        ELSE

            PSET (i, j), prc

        END IF

        lasti = i: lastj = j

    NEXT

    DIM xleft(mx2) AS INTEGER, xright(mx2) AS INTEGER, x AS INTEGER, y AS INTEGER

    FOR y = 0 TO mx2

        x = 0

        WHILE POINT(x, y) <> prc AND x < mx2

            x = x + 1

        WEND

        xleft(y) = x

        WHILE POINT(x, y) = prc AND x < mx2

            x = x + 1

        WEND

        WHILE POINT(x, y) <> prc AND x < mx2

            x = x + 1

        WEND

        IF x = mx2 THEN xright(y) = xleft(y) ELSE xright(y) = x

    NEXT

    _DEST destHandle&

    FOR y = 0 TO mx2

        IF xleft(y) <> mx2 THEN LINE (xleft(y) + x0 - TEmax, y + y0 - TEmax)-(xright(y) + x0 - TEmax, y + y0 - TEmax), c, BF

    NEXT

    _FREEIMAGE tef

END SUB



'Function PixelCollide (Obj1 As TypeSPRITE, Obj2 As TypeSPRITE, Intersect As TypePOINT)

'    '--------------------------------------------------------------------------------------------------------

'    '- Checks for pixel perfect collision between two rectangular areas. -

'    '- Returns -1 if in collision                                        -

'    '- Returns  0 if no collision                                        -

'    '-                                                                   -

'    '- obj1 - rectangle 1 coordinates                                    -

'    '- obj2 - rectangle 2 coordinates                                    -

'    '---------------------------------------------------------------------

'    Dim x%, y%

'    Dim x1%, y1% ' upper left x,y coordinate of rectangular collision area

'    Dim x2%, y2% ' lower right x,y coordinate of rectangular collision area

'    Dim Test1& '   overlap image 1 to test for collision

'    Dim Test2& '   overlap image 2 to test for collision

'    Dim Hit% '     -1 (TRUE) if a collision occurs, 0 (FALSE) otherwise

'    Dim Osource& ' original source image handle

'    Dim p1~& '     alpha value of pixel on image 1

'    Dim p2~& '     alpha value of pixel on image 2



'    Obj1.x2 = Obj1.x1 + _Width(Obj1.image) - 1 '  calculate lower right x,y coordinates of both objects

'    Obj1.y2 = Obj1.y1 + _Height(Obj1.image) - 1

'    Obj2.x2 = Obj2.x1 + _Width(Obj2.image) - 1

'    Obj2.y2 = Obj2.y1 + _Height(Obj2.image) - 1

'    Hit% = 0 '                                    assume no collision



'    '+-------------------------------------+

'    '| perform rectangular collision check |

'    '+-------------------------------------+



'    If Obj1.x2 >= Obj2.x1 Then '                  rect 1 lower right X >= rect 2 upper left  X ?

'        If Obj1.x1 <= Obj2.x2 Then '              rect 1 upper left  X <= rect 2 lower right X ?

'            If Obj1.y2 >= Obj2.y1 Then '          rect 1 lower right Y >= rect 2 upper left  Y ?

'                If Obj1.y1 <= Obj2.y2 Then '      rect 1 upper left  Y <= rect 2 lower right Y ?



'                    '+-----------------------------------------------------------------------+

'                    '| rectangular collision detected, perform pixel perfect collision check |

'                    '+-----------------------------------------------------------------------+



'                    If Obj2.x1 <= Obj1.x1 Then x1% = Obj1.x1 Else x1% = Obj2.x1 '        calculate overlapping coordinates

'                    If Obj2.y1 <= Obj1.y1 Then y1% = Obj1.y1 Else y1% = Obj2.y1

'                    If Obj2.x2 <= Obj1.x2 Then x2% = Obj2.x2 Else x2% = Obj1.x2

'                    If Obj2.y2 <= Obj1.y2 Then y2% = Obj2.y2 Else y2% = Obj1.y2

'                    Test1& = _NewImage(x2% - x1% + 1, y2% - y1% + 1, 32) '               make overlap image of object 1

'                    Test2& = _NewImage(x2% - x1% + 1, y2% - y1% + 1, 32) '               make overlap image of object 2

'                    _PutImage (-(x1% - Obj1.x1), -(y1% - Obj1.y1)), Obj1.image, Test1& ' place overlap area of object 1

'                    _PutImage (-(x1% - Obj2.x1), -(y1% - Obj2.y1)), Obj2.image, Test2& ' place overlap area of object 2

'                    x% = 0 '                                                             reset overlap area coordinate counters

'                    y% = 0

'                    Osource& = _Source '                                                 remember calling source

'                    Do '                                                                 begin pixel collide loop

'                        _Source Test1& '                                                 read from image 1

'                        p1~& = _Alpha32(Point(x%, y%)) '                                 get alpha level of pixel

'                        _Source Test2& '                                                 read from image 2

'                        p2~& = _Alpha32(Point(x%, y%)) '                                 get alpha level of pixel

'                        If (p1~& <> 0) And (p2~& <> 0) Then '                            are both pixels transparent?

'                            Hit% = -1 '                                                  no, there must be a collision

'                            Intersect.x = x1% + x% '                                     return collision coordinates

'                            Intersect.y = y1% + y% '

'                        End If

'                        x% = x% + 1 '                                                    increment column counter

'                        If x% > _Width(Test1&) - 1 Then '                                beyond last column?

'                            x% = 0 '                                                     yes, reset x

'                            y% = y% + 1 '                                                increment row counter

'                        End If

'                    Loop Until y% > _Height(Test1&) - 1 Or Hit% '                        leave when last row or collision detected

'                    _Source Osource& '                                                   restore calling source

'                    _FreeImage Test1& '                                                  remove temporary image from RAM

'                    _FreeImage Test2&

'                End If

'            End If

'        End If

'    End If

'    PixelCollide = Hit% '                                                                return result of collision check



'End Function



FUNCTION BoxCollision% (b1x, b1y, b1w, b1h, b2x, b2y, b2w, b2h)

    ' x, y represent the box left most x and top most y

    ' w, h represent the box width and height which is the usual way sprites / tiles / images are described

    ' such that boxbottom = by + bh

    '        and boxright = bx + bw



    IF (b1y + b1h < b2y) OR (b1y > b2y + b2h) OR (b1x > b2x + b2w) OR (b1x + b1w < b2x) THEN

        BoxCollision% = 0

    ELSE

        BoxCollision% = -1

    END IF

END FUNCTION



' this needs max, min functions as well as BoxCollision%

SUB Intersect2Boxes (b1x, b1y, b1w, b1h, b2x, b2y, b2w, b2h, bix AS LONG, biy AS LONG, biw AS LONG, bih AS LONG)

    IF b2x >= b1x AND b2x <= b1x + b1w AND b2y >= b1y AND b2y <= b1y + b1h THEN 'top left corner in 2nd box

        bix = b2x: biy = b2y

        IF b2x + b2w <= b1x + b1w THEN biw = b2w ELSE biw = b1x + b1w - b2x

        IF b2y + b2h <= b1y + b1h THEN bih = b2h ELSE bih = b1y + b1h - b2y

    ELSEIF b2x >= b1x AND b2x <= b1x + b1w AND b2y + b2h >= b1y AND b2y + b2h <= b1y + b1h THEN 'bottom left corner of 2nd box in first

        bix = b2x

        IF b2x + b2w <= b1x + b1w THEN biw = b2w ELSE biw = b1x + b1w - b2x

        IF b2y <= b1y THEN biy = b1y: bih = b2y + b2h - b1y ELSE biy = b2y: bih = b2h

    ELSEIF b2x + b2w >= b1x AND b2x + b2w <= b1x + b1w AND b2y >= b1y AND b2y <= b1y + b1h THEN 'right top corner 2nd box in first

        IF b2x >= b1x THEN bix = b2x: biw = b2w ELSE bix = b1x: biw = b2x + b2w - b1x

        biy = b2y

        IF b2y + b2h <= b1y + b1h THEN bih = b2h ELSE bih = b1y + b1h - b2y

    ELSEIF b2x + b2w >= b1x AND b2x + b2w <= b1x + b1w AND b2y + b2h >= b1y AND b2y + b2h <= b1y + b1h THEN 'left bottom corners in first box

        IF b2x >= b1x THEN bix = b2x: biw = b2w ELSE bix = b1x: biw = b2x + b2w - b1x

        IF b2y >= b1y THEN biy = b2y: bih = b2h ELSE biy = b1y: bih = b2y + b2h - b1y

    ELSEIF BoxCollision%(b1x, b1y, b1w, b1h, b2x, b2y, b2w, b2h) THEN

        bix = max(b1x, b2x): biy = max(b1y, b2y)

        biw = min(b1x + b1w, b2x + b2w) - bix: bih = min(b1y + b1h, b2y + b2h) - biy

    ELSE 'no intersect

        bix = -1: biy = -1: biw = 0: bih = 0

    END IF

END SUB



FUNCTION max (a, b)

    IF a > b THEN max = a ELSE max = b

END FUNCTION



FUNCTION min (a, b)

    IF a < b THEN min = a ELSE min = b

END FUNCTION



' this sub needs Intersect2Boxes which uses  max, min, and BoxCollision Functions

FUNCTION PixelCollision& (img1 AS boxType, img2 AS boxType, intx AS LONG, inty AS LONG)

    ' boxType here needs at least an x, y, w, h and img

    DIM AS LONG x, y, ix, iy, iw, ih

    DIM AS _UNSIGNED LONG p1, p2

    intx = -1: inty = -1 ' no collision set

    Intersect2Boxes img1.x, img1.y, img1.w, img1.h, img2.x, img2.y, img2.w, img2.h, ix, iy, iw, ih

    IF ix <> -1 THEN ' the boxes intersect

        y = iy: x = ix

        DO

            _SOURCE img1.img

            p1 = POINT(x - img1.x, y - img1.y) ' point minus img x, y location = location in image I hope

            _SOURCE img2.img

            p2 = POINT(x - img2.x, y - img2.y)

            IF (p1 <> 0) AND (p2 <> 0) THEN

                PixelCollision& = -1: intx = x: inty = y: EXIT FUNCTION

            END IF

            IF (x + 1) > (ix + iw - 1) THEN ' get rid of 2 slow For Loops

                x = ix: y = y + 1

                IF y >= (iy + ih - 1) THEN

                    _SOURCE 0: EXIT FUNCTION

                ELSE

                    y = y + 1

                END IF

            ELSE

                x = x + 1

            END IF

        LOOP

    END IF

END FUNCTION



SUB R2_Add (re AS Vec2, se AS Vec2, m AS INTEGER)

    re.x = re.x + se.x * m

    re.y = re.y + se.y * m

END SUB 'R3_Add



SUB R2_Norm (re AS Vec2, v AS Vec2, scalar AS SINGLE)

    DIM m!

    DIM t AS Vec2 'if not using R2_Mag substitute: delete this line

    t = v '                                      x! = v.x: y! = v.y

    m! = R2_Mag!(t) '                            m! = _HYPOT(x!, y!)

    IF m! = 0 THEN

        re.x = 0: re.y = 0

    ELSE

        re.x = (t.x / m!) * scalar 'if not using R2_Mag substitute: x! for t.x

        re.y = (t.y / m!) * scalar '                                y! for t.y

    END IF

END SUB 'R2_Norm



FUNCTION R2_Mag! (v AS Vec2)

    '--------------------------------------------------------------------------

    '-Obtain the scalar magnitude of 2D vector (v)                            -

    '--------------------------------------------------------------------------

    R2_Mag! = _HYPOT(v.x, v.y)

END FUNCTION 'R2_Mag!