Box and Pixel Collisions pkg

[bplus]

Thanks, I am working on a way to get the larger spider to chase the smaller one after a collision, but there seems to be a tendency for the two to get stuck and oscillate back and forth in one place. A bit of a head scratcher...

Yeah, I've been scratching my head with that since first Pixel Collision app. Remember originally I reacted to only 3 out of 10 collisions to cease such stuckedness.

[OldMoses]

With some slight modifications I got them to chase. Sometimes it's the big spider that chickens out, which I take to be a function of which one is being checked for collision first in the loop.

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!

[bplus]

Who knew spiders would be fun to watch! I do see lines of 4 following each other and when they run into another gang they all get antsy!.