Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
a way to do fast pixel-perfect collision?
#1
I'm psyched about this method. People have probably done something similar in other languages, but in QB64 I have been hearing that detecting collisions at the pixel level had to be done by looping through all the pixels in the image and comparing pixel by pixel, but you can do it by comparing chunks of memory & without having to loop through every time.

A while ago we had discussed efficient ways to compare 2 images which used Steve's compareMem function, and I had this crazy idea that that might be leveraged for fast pixel-perfect collision detection, and after some mucking about, came up with this proof of concept. 

The code is kinda sloppy and could be simplified and made more efficient, but the basic method seems to be working. 

I haven't done any performance testing against other methods - it uses Steve's CompareImages / compareMem along with _PUTIMAGE and _CLEARCOLOR to do it, so whatever overhead those have (which might be reduced by using 4-bit color for the image copies used to do the compare). 

Give it a try and let me know what you think - the attached ZIP includes all the test images that the code references.

[Image: Fast-Pixel-Perfect-Collision27-screenshot.png]

Code: (Select All)
_Title "FastPixelPerfectCollision"

' This might be a way to detect pixel-perfect collisions fast.
' For each image:
' - make a copy with all pixels black
' - make a copy with all pixels white
' - make a negative copy with all pixels green
' - make a blank image the size of the screen (collision layers)
' During your main loop
' - When image A moves
'   * Redraw white copy onto collision layer with blank background
'   * Check for collisions with the other images B, C, etc.
'     - Initialize temp image imgCompare2a the size of image A
'     - Copy image A's black copy to imgCompare2a
'     - Copy portion of image B's collision layer at image A's
'      (x1,y1)-(x2,y2) to imgCompare2a
'     - Copy image A's negative copy to imgCompare2a
'     - Do a _CLEARCOLOR green on imgCompare2a
'     - Copy imgCompare2a to imgCompare2b with _PUTIMAGE
'       imgCompare2b now has image A's black copy overlaid with
'       whatever pixels of image B intersect (in white)
'     - Memory compare imgCompare2b to image A's black copy using
'       memcmp% system function

' This demo lets you move a few different images around the screen
' and displays which images collide with which other images.
' On the right we show image 1's imgCompare2b for all the other images,
' so you can see what its black copy is being compared to.
' Try moving image #1 on top of the other images and see what happens.

' Note: this is a preliminary version that uses 2 collision layers
'       and an additional imgCompare1, instead of one each as
'       described above. These extra images can be eliminated and
'       we can simplify by using the .black copy directly to compare
'       against, as described above.

' This can maybe be made more efficient by using limited palettes for
' the black/white/green copies and the collision layer images
' (e.g., 8-bit or 4-bit color) which would use less memory than 32-bit
' and thus speed up the compare operations.

Const xsize = 640
Const ysize = 480
Const xmin = 1
Const xmax = 480
Const ymin = 212
Const ymax = 480
Const fps = 60
Const changeMin = 10
Const changeMax = 60
Const KeyCode_Escape = 2
Const KeyCode_Spacebar = 58
Const KeyCode_Up = 329
Const KeyCode_Down = 337
Const KeyCode_Left = 332
Const KeyCode_Right = 334
Const KeyCode_0 = 12
Const KeyCode_1 = 3
Const KeyCode_2 = 4
Const KeyCode_3 = 5
Const KeyCode_4 = 6
Const KeyCode_5 = 7
Const KeyCode_6 = 8
Const KeyCode_7 = 9
Const KeyCode_8 = 10
Const KeyCode_9 = 11

Type ImageType
    name As String
    file As String
    image As Long
    black As Long
    white As Long
    erase As Long
    compareBlack As Long
    compareWhite As Long
    x1 As Long
    y1 As Long
    x2 As Long
    y2 As Long
    moveCount As Integer
    numSteps As Integer
    xmin As Long
    xmax As Long
    ymin As Long
    ymax As Long
    message As String
    'color As _Unsigned Long
    testX As Long
    testY As Long
End Type ' ImageType

Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

Dim arrImg(1 To 10) As ImageType
Dim f1, f2 As Integer
Dim sError As String
Dim x, y As Long
Dim bDone As Integer
Dim MyScreen As Long
Dim iCurrent As Integer
Dim RowNum As Integer
Dim CompareWidth As Long
Dim CompareHeight As Long
Dim imgCompare1 As Long
Dim imgCompare2a As Long
Dim imgCompare2b As Long
Dim iCols As Long
Dim iRows As Long
Dim testX As Long
Dim testY As Long

' Initialize images objects
sError = ""
arrImg(1).name = "shape_1_32x32.png"
arrImg(2).name = "shape_2_32x32.png"
arrImg(3).name = "shape_3_32x32.png"
arrImg(4).name = "shape_4_32x32.png"
arrImg(5).name = "shape_5_32x32.png"
arrImg(6).name = "shape_6_32x32.png"
arrImg(7).name = "shape_7_16x32.png"
arrImg(8).name = "shape_8_05x05.png"
arrImg(9).name = "shape_9_01x01.png"
arrImg(10).name = "shape_a_64x64.png"
'arrImg(11).name = "shape_b_200x200.png"
'arrImg(12).name = "shape_c_512x512.png"
'arrImg(13).name = "shape_d_256x256.png"

testX = 608
testY = 5
For f1 = LBound(arrImg) To UBound(arrImg)
    arrImg(f1).file = m_ProgramPath$ + arrImg(f1).name
    If _FileExists(arrImg(f1).file) Then
        arrImg(f1).image = _LoadImage(arrImg(f1).file, 32)
        arrImg(f1).black = CreateMask&(arrImg(f1).image, _RGBA32(0, 0, 0, 255), _FALSE)
        arrImg(f1).white = CreateMask&(arrImg(f1).image, _RGBA32(255, 255, 255, 255), _FALSE)
        arrImg(f1).erase = CreateMask&(arrImg(f1).image, _RGBA32(0, 160, 0, 255), _TRUE)

        arrImg(f1).compareBlack = _NewImage(xsize, ysize, 32)
        arrImg(f1).compareWhite = _NewImage(xsize, ysize, 32)

        arrImg(f1).xmin = xmin
        arrImg(f1).xmax = xmax - _Width(arrImg(f1).image)
        arrImg(f1).ymin = ymin
        arrImg(f1).ymax = ymax - _Height(arrImg(f1).image)
        arrImg(f1).numSteps = 0
        arrImg(f1).moveCount = 0
        arrImg(f1).message = ""
        arrImg(f1).testX = testX
        arrImg(f1).testY = testY: testY = testY + 40
       
        ' Randomly place and move images
        Randomize Timer

        Do
            ' Select random location + directions
            x = RandomNumber%(arrImg(f1).xmin, arrImg(f1).xmax)
            y = RandomNumber%(arrImg(f1).ymin, arrImg(f1).ymax)
           
            ' Check overlap for all but first object
            bDone = _TRUE
            If f1 > LBound(arrImg) Then
                ' If location overlaps with another object, try again
                For f2 = LBound(arrImg) To (f1 - 1)
                    if  ( _
                              ( _
                                 (x >= arrImg(f2).x1) _
                                 and _
                                 (x <= (arrImg(f2).x1 + _Width(arrImg(f1).image) - 1 ) ) _
                              ) _
                              and _
                              ( _
                                 (y >= arrImg(f2).y1) _
                                 and _
                                 (y <= (arrImg(f2).y1 + _Height(arrImg(f1).image) - 1 ) ) _
                           ) _
                        ) then

                        bDone = _FALSE
                        Exit For
                    End If

                Next f2
            End If

            If bDone = _TRUE Then
                ' Save values
                arrImg(f1).x1 = x
                arrImg(f1).y1 = y

                ' Save end points
                arrImg(f1).x2 = (x + _Width(arrImg(f1).image)) - 1
                arrImg(f1).y2 = (y + _Height(arrImg(f1).image)) - 1
               
                Exit Do
            End If
        Loop

    Else
        sError = "File " + Chr$(34) + arrImg(f1).name + Chr$(34) + " not found."
        Exit For
    End If
Next f1

' Collision detection demo!
If Len(sError) = 0 Then
    ' init screen
    MyScreen = _NewImage(xsize, ysize, 32)
    Screen MyScreen
   
    ' determine available columns + rows for text
    iCols = _Width(MyScreen) \ _FontWidth
    iRows = _Height(0) \ _FontHeight

    ' move images around
    iCurrent = LBound(arrImg)

    Do: _Limit fps
        '_Dest MyScreen: Cls , _RGB32(0, 0, 0)
        _Dest MyScreen: Cls , _RGB32(128, 128, 128)

        ' Show instructions
        Color _RGB32(0, 255, 255), _RGBA32(0, 0, 0, 0) ' cyan
        'Locate RowNum, 1: Print "iCurrent=" + _ToStr$(iCurrent);
        'RowNum = RowNum + 1:
        RowNum = 1: Locate RowNum, 1: Print "1,2,3,4,5,6,7,8,9,0 = Select    Arrow keys = Move    Esc = Quit";

        ' Display object info
        RowNum = RowNum + 2: Locate RowNum, 1
        Color _RGB32(255, 255, 255), _RGB32(0, 0, 255) ' white on blue
        Print " #  name                   width  height  x     y     xmax  ymax Touching   ";
        For f1 = LBound(arrImg) To UBound(arrImg)

            RowNum = RowNum + 1: Locate RowNum, 1

            If IsEven%(f1) Then
                Color _RGB32(0, 0, 0), _RGB32(164, 164, 164)
            Else
                Color _RGB32(0, 0, 0), _RGB32(192, 192, 192)
            End If

            Print _IIf(iCurrent = f1, ">", " ");
            Print PadRight$(Hex$(f1), 2) + " ";
           
            Print PadRight$(arrImg(f1).name, 20) + "   ";

            Print PadRight$(_ToStr$(_Width(arrImg(f1).image)), 4) + "   ";
            Print PadRight$(_ToStr$(_Height(arrImg(f1).image)), 4) + "    ";

            Print PadRight$(_ToStr$(arrImg(f1).x1), 4) + "  ";
            Print PadRight$(_ToStr$(arrImg(f1).y1), 4) + "  ";
            Print PadRight$(_ToStr$(arrImg(f1).xmax), 4) + "  ";
            Print PadRight$(_ToStr$(arrImg(f1).ymax), 4) + "  ";
            Print PadRight$(arrImg(f1).message, 10);
        Next f1

        ' Draw objects + check for collisions
        For f1 = LBound(arrImg) To UBound(arrImg)
            ' Draw it!
            _Dest MyScreen
            _PutImage (arrImg(f1).x1, arrImg(f1).y1), arrImg(f1).image

            ' Draw black mask used for collision detection
            _Dest arrImg(f1).compareBlack: Cls , _RGBA32(0, 0, 0, 0)
            _PutImage (arrImg(f1).x1, arrImg(f1).y1), arrImg(f1).black, arrImg(f1).compareBlack

            '' Draw white mask used for collision detection
            '_Dest arrImg(f1).compareWhite : Cls , _RGBA32(0, 0, 0, 0)
            '_PutImage (arrImg(f1).x1, arrImg(f1).y1), arrImg(f1).white, arrImg(f1).compareWhite

            ' Check for collisions
            arrImg(f1).message = ""
            For f2 = LBound(arrImg) To UBound(arrImg)
                If f2 <> f1 Then
                   
                    ' Draw white mask used for collision detection
                    _Dest arrImg(f2).compareWhite: Cls , _RGBA32(0, 0, 0, 0)
                    _PutImage (arrImg(f2).x1, arrImg(f2).y1), arrImg(f2).white, arrImg(f2).compareWhite
                   
                    ' Copy image #1's area to imgCompare1
                    FreeImage imgCompare1
                    imgCompare1 = _NewImage(_Width(arrImg(f1).image), _Height(arrImg(f1).image), 32)
                    _Dest imgCompare1: Cls , _RGBA32(0, 0, 0, 0)
                   
                    '_PUTIMAGE (dx1         , dy1)          , sourceHandle&          , destHandle&, (sx1, sy1)-(sx2, sy2) 'portion of source to the top-left corner of the destination page
                    _PutImage (0, 0), arrImg(f1).compareBlack, imgCompare1, (arrImg(f1).x1, arrImg(f1).y1)-(arrImg(f1).x2, arrImg(f1).y2)

                    ' Copy image #1's area AND image #2's area to imgCompare2a
                    FreeImage imgCompare2a
                    imgCompare2a = _NewImage(_Width(arrImg(f1).image), _Height(arrImg(f1).image), 32)
                    _Dest imgCompare2a: Cls , _RGBA32(0, 0, 0, 0)

                    ' Use _PUTIMAGE to copy the portion of image
                    '_PUTIMAGE (dx1         , dy1)          , sourceHandle&          , destHandle&, (sx1, sy1)-(sx2, sy2) 'portion of source to the top-left corner of the destination page
                    '_PutImage  (0           , 0  )          , arrImg(f1).compareBlack, imgCompare2, (arrImg(f1).x1, arrImg(f1).y1)-(arrImg(f1).x2, arrImg(f1).y2)
                    _PutImage (0, 0), arrImg(f1).black, imgCompare2a
                    _PutImage (0, 0), arrImg(f2).compareWhite, imgCompare2a, (arrImg(f1).x1, arrImg(f1).y1)-(arrImg(f1).x2, arrImg(f1).y2)
                    _PutImage (0, 0), arrImg(f1).erase, imgCompare2a

                    '_CLEARCOLOR {color&|_NONE}[, Dest_Handle&]
                    _ClearColor _RGBA32(0, 160, 0, 255), imgCompare2a
                    FreeImage imgCompare2b
                    imgCompare2b = _NewImage(_Width(imgCompare2a), _Height(imgCompare2a), 32)
                    _Dest imgCompare2b: Cls , _RGBA32(0, 0, 0, 0)
                    _PutImage (0, 0), imgCompare2a, imgCompare2b
                   
                   
                    ' ****************************************************************************************************************************************************************
                    If f1 = LBound(arrImg) Then
                        _PutImage (arrImg(f2).testX, arrImg(f2).testY), imgCompare2b, MyScreen
                    End If
                   
                   
                    '                    If f1 = LBound(arrImg) And f2 = (LBound(arrImg) + 1) Then
                    '                        '_PutImage (4, 4), arrImg(f1).compareBlack, MyScreen
                    '                        ''_PutImage (2, 2), arrImg(f1).compareWhite, MyScreen
                    '
                    '                        '_PutImage (4, 4), arrImg(f2).compareWhite, MyScreen
                    '                        ''_PutImage (2, 2), arrImg(f2).compareBlack, MyScreen
                    '
                    '                        'DEBUG SHOW imgCompare1 and imgCompare2 on screen at (y=5, x=560) and (y=80, x=550)
                    '                        '_PUTIMAGE (dx1, dy1), sourceHandle&, destHandle& 'full source to top-left corner destination position
                    '                        '_PutImage (100, 200), imgCompare1, MyScreen
                    '                        '_PutImage (100, 400), imgCompare2, MyScreen
                    '
                    '                        '_PutImage (608, 5), arrImg(f1).black, MyScreen
                    '                        '_PutImage (608, 69), arrImg(f2).white, MyScreen
                    '                        '_PutImage (608, 133), imgCompare1, MyScreen
                    '                        '_PutImage (608, 197), imgCompare2b, MyScreen
                    '
                    '                        If CompareImages(imgCompare1, imgCompare2b) = _TRUE Then
                    '                            If f1 = LBound(arrImg) Then
                    '                                _Dest MyScreen
                    '                                Locate iRows-10, iCols - 28
                    '                                Color _RGBA32(255, 255, 255, 0), _RGBA32(0, 64, 64, 0)
                    '                                Print "CompareImages returns _TRUE";
                    '                            End If
                    '                        Else
                    '                            If f1 = LBound(arrImg) Then
                    '                                _Dest MyScreen
                    '                                Locate iRows-10, iCols - 28
                    '                                Color _RGBA32(255, 255, 255, 0), _RGBA32(0, 64, 64, 0)
                    '                                Print "CompareImages returns _FALSE";
                    '                            End If
                    '                        End If
                    '                    End If
                    ' ****************************************************************************************************************************************************************




                    ' Now compare imgCompare1 and imgCompare2
                    ' If they are not equal, we detect a collision
                    If CompareImages(imgCompare1, imgCompare2b) = _FALSE Then
                        arrImg(f1).message = arrImg(f1).message + Hex$(f2)
                    Else
                        arrImg(f1).message = arrImg(f1).message + " "
                    End If
                Else
                    arrImg(f1).message = arrImg(f1).message + " "
                End If
            Next f2
        Next f1

        ' Process input
        While _DeviceInput(1): Wend ' clear and update the keyboard buffer
        If _Button(KeyCode_Escape) Then
            Exit Do
        ElseIf _Button(KeyCode_1) Then
            iCurrent = 1
        ElseIf _Button(KeyCode_2) Then
            iCurrent = 2
        ElseIf _Button(KeyCode_3) Then
            iCurrent = 3
        ElseIf _Button(KeyCode_4) Then
            iCurrent = 4
        ElseIf _Button(KeyCode_5) Then
            iCurrent = 5
        ElseIf _Button(KeyCode_6) Then
            iCurrent = 6
        ElseIf _Button(KeyCode_7) Then
            iCurrent = 7
        ElseIf _Button(KeyCode_8) Then
            iCurrent = 8
        ElseIf _Button(KeyCode_9) Then
            iCurrent = 9
        ElseIf _Button(KeyCode_0) Then
            iCurrent = 10
        End If
       
        If _Button(KeyCode_Up) Then
            arrImg(iCurrent).y1 = arrImg(iCurrent).y1 - 1
            If arrImg(iCurrent).y1 < arrImg(iCurrent).ymin Then
                arrImg(iCurrent).y1 = arrImg(iCurrent).ymin
            End If
            arrImg(iCurrent).y2 = (arrImg(iCurrent).y1 + _Height(arrImg(iCurrent).image)) - 1 ' update end point
        ElseIf _Button(KeyCode_Down) Then
            arrImg(iCurrent).y1 = arrImg(iCurrent).y1 + 1
            If arrImg(iCurrent).y1 > arrImg(iCurrent).ymax Then
                arrImg(iCurrent).y1 = arrImg(iCurrent).ymax
            End If
            arrImg(iCurrent).y2 = (arrImg(iCurrent).y1 + _Height(arrImg(iCurrent).image)) - 1 ' update end point
        End If
       
        If _Button(KeyCode_Right) Then
            arrImg(iCurrent).x1 = arrImg(iCurrent).x1 + 1
            If arrImg(iCurrent).x1 > arrImg(iCurrent).xmax Then
                arrImg(iCurrent).x1 = arrImg(iCurrent).xmax
            End If
            arrImg(iCurrent).x2 = (arrImg(iCurrent).x1 + _Width(arrImg(iCurrent).image)) - 1 ' update end point
        ElseIf _Button(KeyCode_Left) Then
            arrImg(iCurrent).x1 = arrImg(iCurrent).x1 - 1
            If arrImg(iCurrent).x1 < arrImg(iCurrent).xmin Then
                arrImg(iCurrent).x1 = arrImg(iCurrent).xmin
            End If
            arrImg(iCurrent).x2 = (arrImg(iCurrent).x1 + _Width(arrImg(iCurrent).image)) - 1 ' update end point
        End If

        ' Refresh screen
        _Display
    Loop Until _KeyHit = 27
    _AutoDisplay

    ' cleanup
    For f1 = LBound(arrImg) To UBound(arrImg)
        FreeImage arrImg(f1).image
        FreeImage arrImg(f1).black
        FreeImage arrImg(f1).white
        FreeImage arrImg(f1).compareBlack
        FreeImage arrImg(f1).compareWhite
        FreeImage arrImg(f1).erase
    Next f1
    FreeImage imgCompare1
    FreeImage imgCompare2a
    FreeImage imgCompare2b
   
End If

If Len(sError) > 0 Then
    Print sError
End If

Locate iRows - 1, 20
Color _RGB32(255, 255, 255), _RGB32(255, 0, 0) ' white on red
Print "PRESS ANY KEY TO EXIT";: Sleep

System

' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max inclusive.

' Note: random-number generator should be initialized with Randomize Timer

Function RandomNumber% (Min%, Max%)
    Dim NumSpread%
    NumSpread% = (Max% - Min%) + 1
    RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%

' /////////////////////////////////////////////////////////////////////////////

' imgMaskBlack& = CreateMask&(MyImage&, _RGBA32(0, 0, 0, 255)
' imgMaskWhite& = CreateMask&(MyImage&, _RGBA32(255, 255, 255, 255)

Function CreateMask& (image1 As Long, fg As _Unsigned Long, bReverse As Integer)
    Dim imgMask&
    Dim p1 As _Unsigned Long
    Dim y, x As Integer

    FreeImage imgMask&
    InitImage imgMask&, _Width(image1), _Height(image1), _RGBA32(0, 0, 0, 0)

    _Source image1
    _Dest imgMask&
    For y = 0 To _Height(image1) - 1
        For x = 0 To _Width(image1) - 1
            p1 = Point(x, y)
            If bReverse Then
                If _Alpha32(p1) = 0 Then
                    PSet (x, y), fg
                End If
            Else
                If _Alpha32(p1) > 0 Then
                    PSet (x, y), fg
                End If
            End If
        Next x
    Next y
    CreateMask& = imgMask&
End Function ' CreateMask&

' /////////////////////////////////////////////////////////////////////////////

Sub InitImage (ThisImage&, iWidth&, iHeight&, bgColor~&)
    FreeImage ThisImage&
    ThisImage& = _NewImage(iWidth&, iHeight&, 32)
    _Dest ThisImage&: Cls , bgColor~&
End Sub ' InitImage

' /////////////////////////////////////////////////////////////////////////////

Sub FreeImage (ThisImage&)
    If ThisImage& < -1 Or ThisImage& > 0 Then _FreeImage ThisImage&
End Sub ' FreeImage

' /////////////////////////////////////////////////////////////////////////////

Function ImagesCollide% (file1$, file2$)
    Dim bResult As Integer
    Dim i1, i2 As Long

    bResult = _FALSE

    If _FileExists(file1$) And _FileExists(file2$) Then
        i1 = _LoadImage(file1$, 32)
        i2 = _LoadImage(file2$, 32)
    End If

    ImagesCollide% = bResult
End Function ' ImagesCollide%

' /////////////////////////////////////////////////////////////////////////////
' Pixel by pixel test to see if 2 images collide

Function ImagesCollide1% (handle1 As Long, handle2 As Long)
    Dim bResult%: bResult% = _FALSE
    Dim p1, p2 As _Unsigned Long
    Dim y, x As Integer
    For y = 0 To _Height(handle1) - 1
        For x = 0 To _Width(handle1) - 1
            _Source handle1: p1 = Point(x, y)
            _Source handle2: p2 = Point(x, y)
            If _Alpha32(p1) > 0 Then
                If _Alpha32(p2) > 0 Then
                    bResult% = _TRUE
                    Exit For
                End If
            End If
        Next x
        If bResult% = _TRUE Then Exit For
    Next y
    ImagesCollide1% = bResult%
End Function ' ImagesCollide1%

' /////////////////////////////////////////////////////////////////////////////

Function CompareImages (handle1 As Long, handle2 As Long)
    Dim bEqual As Integer
    Dim m1 As _MEM
    Dim m2 As _MEM

    bEqual = _FALSE

    m1 = _MemImage(handle1)
    m2 = _MemImage(handle2)

    If m1.SIZE = m2.SIZE Then
        If m1.ELEMENTSIZE = m2.ELEMENTSIZE Then
            If memcmp(m1.OFFSET, m2.OFFSET, m1.SIZE) = 0 Then
                bEqual = _TRUE
            End If
        End If
    End If

    If _MemExists(m1) Then _MemFree m1
    If _MemExists(m2) Then _MemFree m2

    CompareImages = bEqual
End Function ' CompareImages

' /////////////////////////////////////////////////////////////////////////////

Declare CustomType Library
    Function memcmp% (ByVal s1%&, ByVal s2%&, ByVal n As _Offset)
End Declare

' /////////////////////////////////////////////////////////////////////////////
' FROM: bplus
' https://qb64phoenix.com/forum/showthread.php?tid=1151&pid=10242#pid10242
' Well my idea didn't take so long for one compare, just blink and there's your answer:
' Not nearly as quick as memory methods though.
' b = b + ...

Function CompareImagesBPlus1& (handle1 As Long, handle2 As Long)
    Dim As _Unsigned Long p1
    For y = 0 To _Height(handle1) - 1
        For x = 0 To _Width(handle1) - 1
            _Source handle1
            p1 = Point(x, y)
            _Source handle2
            If Point(x, y) <> p1 Then Exit Function
        Next
    Next
    CompareImagesBPlus1& = -1
End Function ' CompareImagesBPlus1&

Function CompareImagesBPlus% (handle1 As Long, handle2 As Long)
    Dim bResult%: bResult% = _TRUE
    Dim p1 As _Unsigned Long
    Dim y, x As Integer
    Dim bFinished%: bFinished% = _FALSE
    For y = 0 To _Height(handle1) - 1
        For x = 0 To _Width(handle1) - 1
            _Source handle1
            p1 = Point(x, y)
            _Source handle2
            If Point(x, y) <> p1 Then
                bResult% = _FALSE
                bFinished% = _FALSE
                Exit For
            End If
        Next x
        If bFinished% = _TRUE Then Exit For
    Next y
    CompareImagesBPlus% = bResult%
End Function ' CompareImagesBPlus%

' /////////////////////////////////////////////////////////////////////////////

Function PadLeft$ (MyString As String, iLength As Integer)
    Dim sValue As String
    sValue = String$(iLength, " ") + MyString
    sValue = Right$(sValue, iLength)
    PadLeft$ = sValue
End Function ' PadLeft$

' /////////////////////////////////////////////////////////////////////////////

Function PadRight$ (MyString As String, iLength As Integer)
    Dim sValue As String
    sValue = MyString + String$(iLength, " ")
    sValue = Left$(sValue, iLength)
    PadRight$ = sValue
End Function ' PadRight$

' /////////////////////////////////////////////////////////////////////////////
' Returns TRUE if number n is even
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
' see also: IsOdd%

Function IsEven% (n)
    If n Mod 2 = 0 Then
        IsEven% = _TRUE
    Else
        IsEven% = _FALSE
    End If
End Function ' IsEven%

' /////////////////////////////////////////////////////////////////////////////
' Returns TRUE if number n is odd
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
' see also: IsEven%

Function IsOdd% (n)
    If n Mod 2 = 1 Then
        IsOdd% = _TRUE
    Else
        IsOdd% = _FALSE
    End If
End Function ' IsOdd%


Attached Files
.zip   FastPixelPerfectCollision27.zip (Size: 10.48 KB / Downloads: 53)
Reply
#2
https://qb64phoenix.com/forum/showthread...7#pid35797   <-- See this little demo for a quick way to do color blending collisions.  It's a grand total of about 70 lines of code, so it should be simple enough to follow.  Nothing fancy to see here folks; just a simple process which works.  LOL!
Reply
#3
Thanks, I love your fast and easy approach! 
How about detecting objects of the same color? 
Without looping over pixels? 

The color blending does give me an idea for how to simplify having to maintain all those copies.
Reply
#4
Just because they're the same color on the display screen doesn't mean they have to be the same color on the screen you're using to detect collisions.  Just use two screens; one to display the image in it's pure form, the second to check for collisions based off an assigned BLOB of set color.  You don't need a red, white, and blue flag to see if a bullet hits it....  One the second screen make it a standard purple blob and the bullet green and then look for the color mash that purple+green would create for you.

As bplus mentioned, you don't even have to check every pixel on the screen in a case like this.  Just check the pixels where the bullets travel and see if any of them match the green + purple blend.  It's a simple process and one which most people generally don't have any problems understanding or implementing.  Wink
Reply
#5
I like the simplicity, and don't not believe you, but need to see it myself to really get it. I will try your demo when back at the 'puter. Thanks!
Reply
#6
(09-07-2025, 05:39 PM)madscijr Wrote: I like the simplicity, and don't not believe you, but need to see it myself to really get it. I will try your demo when back at the 'puter. Thanks!

https://qb64phoenix.com/forum/showthread...0#pid35810

All this cross-posting in various topics is leaving me brain damaged!  LOL!  Big Grin
Reply


Forum Jump:


Users browsing this thread: