I need input on a possible bug in v3.5.0

Code: (Select All)
'** Pixel Perfect Collision Demo #5



Type TypeSPRITE '             sprite definition

    image As Long '       sprite image

    mask As Long '        sprite mask image

    x1 As Integer '       upper left X

    y1 As Integer '       upper left Y

    x2 As Integer '       lower right X

    y2 As Integer '       lower right Y

End Type



Type TypePOINT

    x As Integer

    y As Integer

End Type





Dim RedOval As TypeSPRITE '   red oval images

Dim GreenOval As TypeSPRITE ' green oval images



Dim Intersect As TypePOINT



RedOval.image = _LoadImage("redoval.png", 32) '     load red oval image image

GreenOval.image = _LoadImage("greenoval.png", 32) ' load green oval image

MakeMask RedOval '                                                    create mask for red oval image

MakeMask GreenOval '                                                  create mask for green oval image

Screen _NewImage(640, 480, 32) '                                      enter graphics screen

_MouseHide '                                                          hide the mouse pointer

GreenOval.x1 = 294 '                                                  green oval upper left X

GreenOval.y1 = 165 '                                                  green oval upper left Y

Do '                                                                  begin main program loop

    _Limit 30 '                                                       30 frames per second

    Cls '                                                             clear screen

    While _MouseInput: Wend '                                         get latest mouse information

    _PutImage (GreenOval.x1, GreenOval.y1), GreenOval.image '         display green oval

    _PutImage (RedOval.x1, RedOval.y1), RedOval.image '               display red oval

    RedOval.x1 = _MouseX '                                            record mouse X location

    RedOval.y1 = _MouseY '                                            record mouse Y location

    If PixelCollide(GreenOval, RedOval, Intersect) Then '                        pixel collision?

        Locate 2, 36 '                                                yes, position text cursor

        Print "COLLISION!" '                                          report collision happening

        Circle (Intersect.x, Intersect.y), 4, _RGB32(255, 255, 0)

        Paint (Intersect.x, Intersect.y), _RGB32(255, 255, 0), _RGB32(255, 255, 0)

    End If

    _Display '                                                        update screen with changes

Loop Until _KeyDown(27) '                                             leave when ESC key pressed

System '                                                              return to operating system



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

Sub MakeMask (Obj As TypeSPRITE)

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

    '- Creates a negative mask of image for pixel collision detection. -

    '-                                                                 -

    '- Obj - object containing an image and mask image holder          -

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



    Dim x%, y% '   image column and row counters

    Dim cc~& '     clear transparent color

    Dim Osource& ' original source image

    Dim Odest& '   original destination image



    Obj.mask = _NewImage(_Width(Obj.image), _Height(Obj.image), 32) ' create mask image

    Osource& = _Source '                               save source image

    Odest& = _Dest '                                   save destination image

    _Source Obj.image '                                make object image the source

    _Dest Obj.mask '                                   make object mask image the destination

    cc~& = _RGB32(255, 0, 255) '                       set the color to be used as transparent

    For y% = 0 To _Height(Obj.image) - 1 '             cycle through image rows

        For x% = 0 To _Width(Obj.image) - 1 '          cycle through image columns

            If Point(x%, y%) = cc~& Then '             is image pixel the transparent color?

                PSet (x%, y%), _RGB32(0, 0, 0, 255) '  yes, set corresponding mask image to solid black

            Else '                                     no, pixel is part of actual image

                PSet (x%, y%), cc~& '                  set corresponding mask image to transparent color

            End If

        Next x%

    Next y%

    _Dest Odest& '                                     restore original destination image

    _Source Osource& '                                 restore original source image

    _SetAlpha 0, cc~&, Obj.image '                     set image transparent color

    _SetAlpha 0, cc~&, Obj.mask '                      set mask transparent color



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 x1%, y1% ' upper left x,y coordinate of rectangular collision area

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

    Dim Test& '    overlap image to test for collision

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

    Dim Osource& ' original source image handle

    Dim p~& '      pixel color being tested in overlap image



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

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

    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

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

                    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

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

                    _PutImage (-(x1% - Obj1.x1), -(y1% - Obj1.y1)), Obj1.image, Test& ' place image 1

                    _PutImage (-(x1% - Obj2.x1), -(y1% - Obj2.y1)), Obj2.mask, Test& '  place image mask 2



                    '** enable the line below to see a visual represenation of mask on image

                    '_PUTIMAGE (x1%, y1%), Test&



                    x2% = x1%

                    y2% = y1%



                    y1% = 0 '                                    reset row counter

                    Osource& = _Source '                         record current source image

                    _Source Test& '                              make test image the source

                    Do '                                         begin row (y) loop

                        x1% = 0 '                                reset column counter

                        Do '                                     begin column (x) loop

                            p~& = Point(x1%, y1%) '              get color at current coordinate



                            '** if color from object 1 then a collision has occurred



                            If p~& <> _RGB32(0, 0, 0, 255) And p~& <> _RGB32(0, 0, 0, 0) Then

                                Hit% = -1

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

                                Intersect.y = y1% + y2%

                            End If

                            x1% = x1% + 1 '                      increment to next column

                        Loop Until x1% = _Width(Test&) Or Hit% ' leave when column checked or collision

                        y1% = y1% + 1 '                          increment to next row

                    Loop Until y1% = _Height(Test&) Or Hit% '    leave when all rows checked or collision

                    _Source Osource& '                           restore original destination

                    _FreeImage Test& '                           test image no longer needed (free RAM)

                End If

            End If

        End If

    End If

    PixelCollide = Hit% '                                        return result of collision check



End Function