01-20-2023, 06:45 PM
(This post was last modified: 01-20-2023, 06:46 PM by TerryRitchie.)
I have a tutorial user that has reported my pixel perfect collision routines are not working in v3.5.0 but work fine in v3.4.1 but I can't replicate this.
The code below I've tested in the following and it works fine:
- Windows 7 SP2 and QB64PE v3.4.1 and v3.5.0
- The latest version of Linux Mint and QB64PE v3.5.0
For those of you with different versions of Windows, Linux, and MacOS would you kindly run the code below and let me know what you find out? The ZIP file attached contains the code and the two image files needed to run it.
The code below I've tested in the following and it works fine:
- Windows 7 SP2 and QB64PE v3.4.1 and v3.5.0
- The latest version of Linux Mint and QB64PE v3.5.0
For those of you with different versions of Windows, Linux, and MacOS would you kindly run the code below and let me know what you find out? The ZIP file attached contains the code and the two image files needed to run it.
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