Pixel Perfect Collision

[bplus]

This is a demo of my new and improved app demo-ing pixel collisions with spiders of course! 

Thanks to @SMcNeill for update lesson on newer keywords _Andalso and also _Orelse. Turns out I did need both Box Collision routines.

Thanks also to @madscijr for renewing my interest in this little gem!

Code: (Select All)

Option _Explicit
_Title "Spider Pixel Collisions Point with Concentric Circles" 'b+ 2025-10-01 rewrite
' 2023-02-08 Another experiment in handling Spider collisions,
' At collision, explosion!
' Tweaked number of spiders, speeds, colors and sizes and sound if collide

'2025-10-01 get rid of explosions and full screen
' Goal: pinpoint exact locations of pixel collisions with concentric circles radiating out from point.
' Need to save images to array and not redraw because the legs move on each redraw!

' replace and And with _Andalso and Or with _OrElse  Thanks Steve

Randomize Timer
Dim Shared xmax As Integer, ymax As Integer
xmax = 800
ymax = 600

Const nSpinners = 10

Type SpinnerType
    As Single x, y, dx, dy, sz
    c As _Unsigned Long
End Type
Dim Shared s(1 To nSpinners) As SpinnerType

Type boxType ' for PixelCollison&
    As Long img, x, y, w, h
    c As _Unsigned Long
End Type

Dim As Long i, j, lc, i2, intx, inty, r, collision
Dim As boxType sImageBox(1 To nSpinners)

Screen _NewImage(xmax, ymax, 32)
_ScreenMove 250, 60

For i = 1 To nSpinners
    newSpinner i
Next
i2 = 2 'start with i2 spiders work up to nSpinners
While InKey$ <> Chr$(27)
    Color , &HFFBBBBBB: Cls ' clean slate
    lc = lc + 1
    If lc Mod 50 = 49 Then 'gradually add more spiders up to nSpinnerws
        lc = 0
        If i2 < nSpinners Then i2 = i2 + 1
    End If

    For i = 1 To i2 ' draw them all first after moving them
        s(i).x = s(i).x + s(i).dx '+ rndCW(0, 3.5)
        s(i).y = s(i).y + s(i).dy '+ rndCW(0, 3.5)
        If s(i).x < 0 _Orelse s(i).x > xmax _Orelse s(i).y < 0 _Orelse s(i).y > ymax Then newSpinner i

        ' max sz = .75 which needs 140 x 140 image square  +++++++++++++++++++++++++
        If sImageBox(i).img Then _FreeImage sImageBox(i).img
        sImageBox(i).img = _NewImage(140, 140, 32)
        _Dest sImageBox(i).img
        drawSpinner sImageBox(i).img, 70, 70, s(i).sz, _Atan2(s(i).dy, s(i).dx), s(i).c
        _Dest 0
        sImageBox(i).x = s(i).x - 70
        sImageBox(i).y = s(i).y - 70
        sImageBox(i).w = 140
        sImageBox(i).h = 140 ' this meets requirements for collision obj1
        _PutImage (sImageBox(i).x, sImageBox(i).y), sImageBox(i).img, 0
    Next
    collision = 0 ' clear collision flag that will stall program to see where collision is
    For i = 1 To i2
        For j = i + 1 To i2
            If PixelCollision&(sImageBox(i), sImageBox(j), intx, inty) Then
                If intx > 0 _Andalso intx < xmax _Andalso inty > 0 _Andalso inty < ymax Then
                    Sound Rnd * 7000 + 400, .005
                    collision = 1
                    For r = 0 To 10 Step 3
                        Circle (intx, inty), r, &HFFFFFFFF
                    Next
                    _Display
                End If
            End If
        Next
    Next
    If collision Then _Delay .15 ' flag to see where
    _Display
    _Limit 30
Wend

Sub newSpinner (i As Integer) 'set Spinners dimensions start angles, color?
    Dim r
    s(i).sz = Rnd * .35 + .4
    If Rnd < .5 Then r = -1 Else r = 1
    s(i).dx = (s(i).sz * Rnd * 8 + 1) * r * 2: s(i).dy = (s(i).sz * Rnd * 8 + 1) * r * 2
    r = Int(Rnd * 4)
    Select Case r
        Case 0: s(i).x = Rnd * (xmax - 120) + 60: s(i).y = 0: If s(i).dy < 0 Then s(i).dy = -s(i).dy
        Case 1: s(i).x = Rnd * (xmax - 120) + 60: s(i).y = ymax: If s(i).dy > 0 Then s(i).dy = -s(i).dy
        Case 2: s(i).x = 0: s(i).y = Rnd * (ymax - 120) + 60: If s(i).dx < 0 Then s(i).dx = -s(i).dx
        Case 3: s(i).x = xmax: s(i).y = Rnd * (ymax - 120) + 60: If s(i).dx > 0 Then s(i).dx = -s(i).dx
    End Select
    r = Rnd * 80 + 80
    s(i).c = _RGB32(r, .5 * r, .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 As Integer TEmax, mx2, i, j
    Dim As Single k, lasti, lastj
    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 _Andalso x < mx2
            x = x + 1
        Wend
        xleft(y) = x
        While Point(x, y) = prc _Andalso x < mx2
            x = x + 1
        Wend
        While Point(x, y) <> prc _Andalso 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
        End If
    Next
    _FreeImage tef
End Sub

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) _Orelse (b1y > b2y + b2h) _Orelse (b1x > b2x + b2w) _Orelse (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 _Andalso b2x <= b1x + b1w _Andalso b2y >= b1y_
     _Andalso 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 _Andalso b2x <= b1x + b1w _Andalso b2y + b2h >= b1y _
    _Andalso 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 _Andalso b2x + b2w <= b1x + b1w _Andalso b2y >= b1y _
     _Andalso 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 _Andalso b2x + b2w <= b1x + b1w _Andalso b2y + b2h >= b1y_
     _Andalso 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) _Andalso (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
                x = x + 1
            End If
        Loop
    End If
End Function

EDIT: 2025-10-02 In the PixelCollision& Function I discovered an error while reworking the code to light up all the intersecting pixels in the next reply. I was trying to be faster by skipping the double For loop to scan through the 2D area and I noticed I was increasing y twice when x ran to the end on right side. So the EDIT removes the 2nd increase of y.

It was this loop here:

Code: (Select All)

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) _Andalso (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
                x = x + 1
            End If
        Loop

EDIT #2 I lilke NakedApe's mod that speeds up the spidey action!

[bplus]

OK here I light up ALL the collision points!

Code: (Select All)

Option _Explicit
_Title "Spider Collision Image" 'b+ 2025-10-01 rewrite
' 2023-02-08 Another experiment in handling Spider collisions,
' At collision, explosion!
' Tweaked number of spiders, speeds, colors and sizes and sound if collide

'2025-10-01 get rid of explosions and full screen
' Goal: pinpoint exact locations of pixel collisions with concentric circles radiating out from point.
' Need to save images to array and not redraw because the legs move on each redraw!

' replace and And with _Andalso and Or with _OrElse  Thanks Steve

Randomize Timer
Dim Shared xmax As Integer, ymax As Integer
xmax = 800
ymax = 600

Const nSpinners = 10

Type SpinnerType
    As Single x, y, dx, dy, sz
    c As _Unsigned Long
End Type
Dim Shared s(1 To nSpinners) As SpinnerType

Type boxType ' for PixelCollison&
    As Long img, x, y, w, h
    c As _Unsigned Long
End Type

Dim As Long i, j, lc, i2, intx, inty, r, collision
Dim As boxType sImageBox(1 To nSpinners)

Screen _NewImage(xmax, ymax, 32)
_ScreenMove 250, 60

For i = 1 To nSpinners
    newSpinner i
Next
i2 = 2 'start with i2 spiders work up to nSpinners
While InKey$ <> Chr$(27)
    Color , &HFFBBBBBB: Cls ' clean slate
    lc = lc + 1
    If lc Mod 50 = 49 Then 'gradually add more spiders up to nSpinnerws
        lc = 0
        If i2 < nSpinners Then i2 = i2 + 1
    End If

    For i = 1 To i2 ' draw them all first after moving them
        s(i).x = s(i).x + s(i).dx '+ rndCW(0, 3.5)
        s(i).y = s(i).y + s(i).dy '+ rndCW(0, 3.5)
        If s(i).x < 0 _Orelse s(i).x > xmax _Orelse s(i).y < 0 _Orelse s(i).y > ymax Then newSpinner i

        ' max sz = .75 which needs 140 x 140 image square  +++++++++++++++++++++++++
        If sImageBox(i).img Then _FreeImage sImageBox(i).img
        sImageBox(i).img = _NewImage(140, 140, 32)
        _Dest sImageBox(i).img
        drawSpinner sImageBox(i).img, 70, 70, s(i).sz, _Atan2(s(i).dy, s(i).dx), s(i).c
        _Dest 0
        sImageBox(i).x = s(i).x - 70
        sImageBox(i).y = s(i).y - 70
        sImageBox(i).w = 140
        sImageBox(i).h = 140 ' this meets requirements for collision obj1
        _PutImage (sImageBox(i).x, sImageBox(i).y), sImageBox(i).img, 0
    Next
    collision = 0 ' clear collision flag that will stall program to see where collision is
    For i = 1 To i2
        For j = i + 1 To i2
            If PixelCollision&(sImageBox(i), sImageBox(j), intx, inty) Then
                If intx > 0 _Andalso intx < xmax _Andalso inty > 0 _Andalso inty < ymax Then
                    Sound Rnd * 7000 + 400, .005
                    collision = 1
                End If
            End If
        Next
    Next
    If collision Then _Delay .15 ' flag to see where
    _Display
    _Limit 30
Wend

Sub newSpinner (i As Integer) 'set Spinners dimensions start angles, color?
    Dim r
    s(i).sz = Rnd * .35 + .4
    If Rnd < .5 Then r = -1 Else r = 1
    s(i).dx = (s(i).sz * Rnd * 8 + 1) * r * 2: s(i).dy = (s(i).sz * Rnd * 8 + 1) * r * 2
    r = Int(Rnd * 4)
    Select Case r
        Case 0: s(i).x = Rnd * (xmax - 120) + 60: s(i).y = 0: If s(i).dy < 0 Then s(i).dy = -s(i).dy
        Case 1: s(i).x = Rnd * (xmax - 120) + 60: s(i).y = ymax: If s(i).dy > 0 Then s(i).dy = -s(i).dy
        Case 2: s(i).x = 0: s(i).y = Rnd * (ymax - 120) + 60: If s(i).dx < 0 Then s(i).dx = -s(i).dx
        Case 3: s(i).x = xmax: s(i).y = Rnd * (ymax - 120) + 60: If s(i).dx > 0 Then s(i).dx = -s(i).dx
    End Select
    r = Rnd * 80 + 80
    s(i).c = _RGB32(r, .5 * r, .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 As Integer TEmax, mx2, i, j
    Dim As Single k, lasti, lastj
    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 _Andalso x < mx2
            x = x + 1
        Wend
        xleft(y) = x
        While Point(x, y) = prc _Andalso x < mx2
            x = x + 1
        Wend
        While Point(x, y) <> prc _Andalso 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
        End If
    Next
    _FreeImage tef
End Sub

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) _Orelse (b1y > b2y + b2h) _Orelse (b1x > b2x + b2w) _Orelse (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 _Andalso b2x <= b1x + b1w _Andalso b2y >= b1y_
     _Andalso 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 _Andalso b2x <= b1x + b1w _Andalso b2y + b2h >= b1y _
    _Andalso 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 _Andalso b2x + b2w <= b1x + b1w _Andalso b2y >= b1y _
     _Andalso 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 _Andalso b2x + b2w <= b1x + b1w _Andalso b2y + b2h >= b1y_
     _Andalso 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) _Andalso (p2 <> 0) Then
                PixelCollision& = -1: intx = x: inty = y ': Exit Function
                Circle (x, y), 0, &HFFFFFF88
                Circle (x, y), 1, &HFFFFFF00
                'Circle (x, y), 2, &HFFFFFF00
            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: _Display: Exit Function
                End If
            Else
                x = x + 1
            End If
        Loop
    End If
End Function

EDIT: I like NakedApe's suggested mod that speeds up the spidey action. Thankyou NakedApe

[NakedApe]

Very cool, bplus! I changed your _delay to just .15 to see more spidey action. Great work.

[bplus]

Thank you @NakedApe I agree! +1 I am changing the above code for that increase in action. Once debugged you want to see the spiders fly!

I found an Error and EDITed the first post of this thread as noted in the first post now.

[bplus]

Spider Walk

Spider Talk

Code: (Select All)

Option _Explicit
_Title "Spider Collision Talk" 'b+ 2025-10-02 rewrite again
' 2023-02-08 Another experiment in handling Spider collisions,
' At collision, explosion!
' Tweaked number of spiders, speeds, colors and sizes and sound if collide

'2025-10-01 get rid of explosions and full screen
' Goal: pinpoint exact locations of pixel collisions with concentric circles radiating out from point.
' Need to save images to array and not redraw because the legs move on each redraw!

' replace and And with _Andalso and Or with _OrElse  Thanks Steve

Randomize Timer
Dim Shared xmax As Integer, ymax As Integer
xmax = 1200
ymax = 700

Const nSpinners = 100

Type SpinnerType
    As Single x, y, dx, dy, sz
    c As _Unsigned Long
End Type
Dim Shared s(1 To nSpinners) As SpinnerType

Type boxType ' for PixelCollison&
    As Long img, x, y, w, h
    c As _Unsigned Long
End Type

Dim As Long i, j, lc, i2, intx, inty, r, collision
Dim As boxType sImageBox(1 To nSpinners)

Screen _NewImage(xmax, ymax, 32)
'_ScreenMove 60, 20
_Delay .5
_FullScreen

For i = 1 To nSpinners
    newSpinner i
Next
i2 = 2 'start with i2 spiders work up to nSpinners
While InKey$ <> Chr$(27)
    Line (0, 0)-(xmax, ymax), &HBB448844, BF
    lc = lc + 1
    If lc Mod 50 = 49 Then 'gradually add more spiders up to nSpinnerws
        lc = 0
        If i2 < nSpinners Then i2 = i2 + 1
    End If

    For i = 1 To i2 ' draw them all first after moving them
        s(i).x = s(i).x + s(i).dx '+ rndCW(0, 3.5)
        s(i).y = s(i).y + s(i).dy '+ rndCW(0, 3.5)
        If s(i).x < 0 _Orelse s(i).x > xmax _Orelse s(i).y < 0 _Orelse s(i).y > ymax Then newSpinner i

        ' max sz = .75 which needs 140 x 140 image square  +++++++++++++++++++++++++
        If sImageBox(i).img Then _FreeImage sImageBox(i).img
        sImageBox(i).img = _NewImage(140, 140, 32)
        _Dest sImageBox(i).img
        drawSpinner sImageBox(i).img, 70, 70, s(i).sz, _Atan2(s(i).dy, s(i).dx), s(i).c
        _Dest 0
        sImageBox(i).x = s(i).x - 70
        sImageBox(i).y = s(i).y - 70
        sImageBox(i).w = 140
        sImageBox(i).h = 140 ' this meets requirements for collision obj1
        _PutImage (sImageBox(i).x, sImageBox(i).y), sImageBox(i).img, 0
    Next
    collision = 0 ' clear collision flag that will stall program to see where collision is
    For i = 1 To i2
        For j = i + 1 To i2
            If PixelCollision&(sImageBox(i), sImageBox(j), intx, inty) Then
                If intx > 0 _Andalso intx < xmax _Andalso inty > 0 _Andalso inty < ymax Then
                    Sound (s(i).sz + s(j).sz) * 5000 * Rnd + 800, .04
                    collision = 1
                End If
            End If
        Next
    Next
    _Display
    _Limit 30
Wend

Sub newSpinner (i As Integer) 'set Spinners dimensions start angles, color?
    Dim r
    s(i).sz = Rnd * .3 + .45
    If Rnd < .5 Then r = -1 Else r = 1
    s(i).dx = (s(i).sz * Rnd * 5 + 1) * r * 2: s(i).dy = (s(i).sz * Rnd * 5 + 1) * r * 2
    r = Int(Rnd * 4)
    Select Case r
        Case 0: s(i).x = Rnd * (xmax - 120) + 60: s(i).y = 0: If s(i).dy < 0 Then s(i).dy = -s(i).dy
        Case 1: s(i).x = Rnd * (xmax - 120) + 60: s(i).y = ymax: If s(i).dy > 0 Then s(i).dy = -s(i).dy
        Case 2: s(i).x = 0: s(i).y = Rnd * (ymax - 120) + 60: If s(i).dx < 0 Then s(i).dx = -s(i).dx
        Case 3: s(i).x = xmax: s(i).y = Rnd * (ymax - 120) + 60: If s(i).dx > 0 Then s(i).dx = -s(i).dx
    End Select
    r = Rnd * 80 + 60
    s(i).c = _RGB32(r, .5 * r, .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 As Integer TEmax, mx2, i, j
    Dim As Single k, lasti, lastj
    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 _Andalso x < mx2
            x = x + 1
        Wend
        xleft(y) = x
        While Point(x, y) = prc _Andalso x < mx2
            x = x + 1
        Wend
        While Point(x, y) <> prc _Andalso 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
        End If
    Next
    _FreeImage tef
End Sub

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) _Orelse (b1y > b2y + b2h) _Orelse (b1x > b2x + b2w) _Orelse (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 _Andalso b2x <= b1x + b1w _Andalso b2y >= b1y_
     _Andalso 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 _Andalso b2x <= b1x + b1w _Andalso b2y + b2h >= b1y _
    _Andalso 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 _Andalso b2x + b2w <= b1x + b1w _Andalso b2y >= b1y _
     _Andalso 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 _Andalso b2x + b2w <= b1x + b1w _Andalso b2y + b2h >= b1y_
     _Andalso 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) _Andalso (p2 <> 0) Then
                PixelCollision& = -1: intx = x: inty = y ': Exit Function
                Circle (x, y), 0, &HFFFFFFFF
                Circle (x, y), 1, &HFF4488FF
                Circle (x, y), 2, &H44112244
            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: _Display: Exit Function
                End If
            Else
                x = x + 1
            End If
        Loop
    End If
End Function

[NakedApe]

Wicked! +1 But why do I feel like there are bugs crawling on me? 

[bplus]

Thank you naked, Why?

They are anticipating all the isometric candy corn you will be harvesting on Halloween!