+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: Chatting and Socializing (https://staging.qb64phoenix.com/forumdisplay.php?fid=11)
+--- Forum: General Discussion (https://staging.qb64phoenix.com/forumdisplay.php?fid=2)
+--- Thread: I need input on a possible bug in v3.5.0 (/showthread.php?tid=1411)
RE: I need input on a possible bug in v3.5.0 - TerryRitchie - 01-21-2023
While making the changes it dawned on me that a mask image is not needed at all! A simple check for two alpha values of 0 works as well. Use the same red oval and green oval images.
Code: (Select All)
'** Pixel Perfect Collision Demo #5
TYPE TypeSPRITE ' sprite definition
image AS LONG ' sprite 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,y point definition
x AS INTEGER ' x coordinate
y AS INTEGER ' y coordinate
END TYPE
DIM RedOval AS TypeSPRITE ' red oval image
DIM GreenOval AS TypeSPRITE ' green oval image
DIM Intersect AS TypePOINT ' point of collision
RedOval.image = _LOADIMAGE("redoval.png", 32) ' load red oval image image
GreenOval.image = _LOADIMAGE("greenoval.png", 32) ' load green oval image
'+---------------------------------------------------------------------------------------------+
'| Set image transparent color. This does not need to be done for PNG files with transparency. |
'+---------------------------------------------------------------------------------------------+
_SETALPHA 0, _RGB32(255, 0, 255), RedOval.image ' set image transparent color
_SETALPHA 0, _RGB32(255, 0, 255), GreenOval.image ' set image transparent color
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
'------------------------------------------------------------------------------------------------------------
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 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 FUNCTIONRE: I need input on a possible bug in v3.5.0 - bplus - 01-21-2023
Wow what an interesting discussion! All these inputs...
@TempodiBasic is there code that you have that finds the smallest box surrounding an object? PS hmm... I might have done something like that now that I think back.
@Steve I was using that star Image as example object with convex and concave outline too regular actually to test irregular object collisions. 8 points would be enough to check for that object in particular, so right!
@jack thanks for link I have it "Speed Dialed" to study for later.
and Terry's getting new ideas too! ;-)) looks considerably less complicated
RE: I need input on a possible bug in v3.5.0 - bplus - 01-21-2023
+! Terry I like what you've done to simplify collision code and works fast enough it seems.
I cleaned up my star images, they did have junk on border causing the false positive that TempodiBasic and Steve tried to tell me about.
I've generalized setting transparent code to Point(1,1) of object image to assume that is background, transparent or not.
And I've centered the image moving around onto the mouse.
Now it should work for any 2 images as long as background is at point(1, 1)
Both cleaned up stars and ellipses work now:
RE: I need input on a possible bug in v3.5.0 - SMcNeill - 01-21-2023
And here's a completely different way to check for pixel perfect collision with our two stars:
Code: (Select All)
TYPE PointType
AS INTEGER x, y
END TYPE
SCREEN _NEWIMAGE(1280, 720, 32)
DIM AS _UNSIGNED LONG target
DIM SHARED Backdrop AS LONG: Backdrop = _COPYIMAGE(0)
REDIM CA(0) AS PointType
blueStar = _LOADIMAGE("Z:\starBlue.png", 32)
redStar = _LOADIMAGE("z:\starRed.png", 32)
CleanImage blueStar
CleanImage redStar
MakeCollisionArray redStar, CA()
t# = TIMER + 1
DO
CLS , 0
IF TIMER > t# THEN
out$ = STR$(count)
count = 0
t# = TIMER + 1
END IF
count = count + 1
LOCATE 2, 1: PRINT out$; "FPS"
IF _KEYDOWN(18432) THEN yPos = yPos - 1
IF _KEYDOWN(20480) THEN yPos = yPos + 1
IF _KEYDOWN(19200) THEN xPos = xPos - 1
IF _KEYDOWN(19712) THEN xPos = xPos + 1
IF _KEYDOWN(32) THEN xPos = 0: yPos = 0 'reset
IF _KEYDOWN(27) THEN SYSTEM
_PUTIMAGE (xPos, yPos), redStar
_PUTIMAGE (100, 100), blueStar
CheckCollision xPos, yPos, CA()
_DISPLAY
LOOP
SUB CheckCollision (xOffset AS INTEGER, yOffset AS INTEGER, CA() AS PointType)
FOR i = 1 TO UBOUND(CA)
x% = xOffset + CA(i).x
y% = yOffset + CA(i).y
IF POINT(x%, y%) <> &HFFFF0000&& THEN
LOCATE 1, 1: PRINT "Collision at:"; x%, y%
EXIT SUB
END IF
NEXT
END SUB
SUB MakeCollisionArray (image AS LONG, CA() AS PointType) 'CA = Collision Array
REDIM CA(_WIDTH(image) * _HEIGHT(image)) AS PointType
DIM AS LONG D, S: D = _DEST: S = _SOURCE
DIM AS LONG count: count = -1
_SOURCE image
FOR y = 0 TO _HEIGHT - 1
FOR x = 0 TO _WIDTH - 1
IF POINT(x, y) = &HFFFF0000&& THEN
IF y > 0 THEN
IF POINT(x, y - 1) = 0 THEN
count = count + 1
CA(count).x = x
CA(count).y = y
_CONTINUE
END IF
END IF
IF y < _HEIGHT - 1 THEN
IF POINT(x, y + 1) = 0 THEN
count = count + 1
CA(count).x = x
CA(count).y = y
_CONTINUE
END IF
END IF
IF x > 0 THEN
IF POINT(x - 1, y) = 0 THEN
count = count + 1
CA(count).x = x
CA(count).y = y
_CONTINUE
END IF
END IF
IF x < _WIDTH - 1 THEN
IF POINT(x + 1, y) = 0 THEN
count = count + 1
CA(count).x = x
CA(count).y = y
_CONTINUE
END IF
END IF
END IF
NEXT
NEXT
REDIM _PRESERVE CA(count) AS PointType
_DEST D: _SOURCE S
END SUB
SUB CleanImage (image AS LONG) 'make backdrop image
DIM m AS _MEM: m = _MEMIMAGE(image)
DIM AS _OFFSET o, l
DIM AS _UNSIGNED LONG p
o = m.OFFSET: l = m.OFFSET + m.SIZE
$CHECKING:OFF
DO UNTIL o >= l
_MEMGET m, o, p
SELECT CASE p
CASE &HFFFF0000, &HFF0000FF
CASE ELSE: _MEMPUT m, o, &H00000000 AS _UNSIGNED LONG
END SELECT
o = o + 4
LOOP
$CHECKING:ON
END SUBThis basically forms an array of the coordinates which are needed to create the outline for our red star, and then it compares to see if they're still red or not. Simple enough, right?
And, would you guys believe that this little red star has 383 points in its outline?! Even so, without trying to do anything fancy to optimize things (this is all software images and POINT calculations, with no hardware or mem at use at all), this still runs at over 500 FPS on my PC and has no issues with the collision detection at all, that I can find.
RE: I need input on a possible bug in v3.5.0 - SMcNeill - 01-21-2023
And, if this was some type of space shooter, and one needed to *really* optimize collision checking for speed, here's the tricks I'd use:
1) only check the protruding points. They're going to collide before anything else does. With these stars, that'd just be the 8 end points on the peaks, and honestly, you could probably get away with just the 4 tips at each of the cardinal directions.
2) only check the protruding points in the direction we're traveling.
For example, if we're moving southwards (or down on the screen), there's not much need to check the topmost point to see if you crashed into something. (Caveat: If other things are moving across the screen as well, you might want to check those other protruding points for collisions.) If you can get by with just checking the point protruding in the direction you're traveling, then make use of that and you can reduce your collision checks down to a bare minimal, keeping FPS up as high as possible.
RE: I need input on a possible bug in v3.5.0 - bplus - 01-21-2023
OK that's it, I am going to make very irregular very multicolored Asteroids rocks like badly bent barbells.
I'm worried that Steve is designing code for specific object shapes :-)) Maybe Terry too but I don't think he is locked in on color, maybe though.
RE: I need input on a possible bug in v3.5.0 - SMcNeill - 01-21-2023
(01-21-2023, 09:19 PM)bplus Wrote: OK that's it, I am going to make very irregular very multicolored Asteroids rocks like badly bent barbells.
I'm worried that Steve is designing code for specific object shapes :-)) Maybe Terry too but I don't think he is locked in on color, maybe though.
Any object shape should work with the above. After all, we're making an array out of the outline of its shape and checking all those points one-by-one for our collision. And it should work with any of your multicolored rocks, just as long as they're not the same exact color as the redStar; as what we're checking to see, is if any of that red outline border of our star has changed color. If there's a rock out there the *exact* same shade as our redStar, then that's just bad programming at work -- change it by at least a single pixel's value for goodness sake!
RE: I need input on a possible bug in v3.5.0 - SMcNeill - 01-21-2023
Code: (Select All)
TYPE PointType
AS INTEGER x, y
END TYPE
SCREEN _NEWIMAGE(1280, 720, 32)
DIM AS _UNSIGNED LONG target
DIM SHARED Backdrop AS LONG: Backdrop = _COPYIMAGE(0)
REDIM CA(0) AS PointType
blueStar = _LOADIMAGE("starBlue.png", 32)
redStar = _LOADIMAGE("whut.png", 32)
RainbowImage blueStar
CleanImage redStar
MakeCollisionArray redStar, CA()
t# = TIMER + 1
DO
CLS , 0
IF TIMER > t# THEN
out$ = STR$(count)
count = 0
t# = TIMER + 1
END IF
count = count + 1
LOCATE 2, 1: PRINT out$; "FPS"
IF _KEYDOWN(18432) THEN yPos = yPos - 1
IF _KEYDOWN(20480) THEN yPos = yPos + 1
IF _KEYDOWN(19200) THEN xPos = xPos - 1
IF _KEYDOWN(19712) THEN xPos = xPos + 1
IF _KEYDOWN(32) THEN xPos = 0: yPos = 0 'reset
IF _KEYDOWN(27) THEN SYSTEM
_PUTIMAGE (xPos, yPos), redStar
_PUTIMAGE (100, 100), blueStar
CheckCollision xPos, yPos, CA()
_LIMIT 30
_DISPLAY
LOOP
SUB CheckCollision (xOffset AS INTEGER, yOffset AS INTEGER, CA() AS PointType)
FOR i = 1 TO UBOUND(CA)
x% = xOffset + CA(i).x
y% = yOffset + CA(i).y
IF POINT(x%, y%) <> &HFFFF0000&& THEN
LOCATE 1, 1: PRINT "Collision at:"; x%, y%
EXIT SUB
END IF
NEXT
END SUB
SUB MakeCollisionArray (image AS LONG, CA() AS PointType) 'CA = Collision Array
REDIM CA(_WIDTH(image) * _HEIGHT(image)) AS PointType
DIM AS LONG D, S: D = _DEST: S = _SOURCE
DIM AS LONG count: count = -1
_SOURCE image
FOR y = 0 TO _HEIGHT - 1
FOR x = 0 TO _WIDTH - 1
IF POINT(x, y) = &HFFFF0000&& THEN
IF y > 0 THEN
IF POINT(x, y - 1) = 0 THEN
count = count + 1
CA(count).x = x
CA(count).y = y
_CONTINUE
END IF
END IF
IF y < _HEIGHT - 1 THEN
IF POINT(x, y + 1) = 0 THEN
count = count + 1
CA(count).x = x
CA(count).y = y
_CONTINUE
END IF
END IF
IF x > 0 THEN
IF POINT(x - 1, y) = 0 THEN
count = count + 1
CA(count).x = x
CA(count).y = y
_CONTINUE
END IF
END IF
IF x < _WIDTH - 1 THEN
IF POINT(x + 1, y) = 0 THEN
count = count + 1
CA(count).x = x
CA(count).y = y
_CONTINUE
END IF
END IF
END IF
NEXT
NEXT
REDIM _PRESERVE CA(count) AS PointType
_DEST D: _SOURCE S
END SUB
SUB CleanImage (image AS LONG) 'make backdrop image
DIM m AS _MEM: m = _MEMIMAGE(image)
DIM AS _OFFSET o, l
DIM AS _UNSIGNED LONG p
o = m.OFFSET: l = m.OFFSET + m.SIZE
$CHECKING:OFF
DO UNTIL o >= l
_MEMGET m, o, p
SELECT CASE p
CASE &HFFED1C24: _MEMPUT m, o, &HFFFF0000 AS _UNSIGNED LONG
CASE ELSE:
_MEMPUT m, o, &H00000000 AS _UNSIGNED LONG
END SELECT
o = o + 4
LOOP
$CHECKING:ON
END SUB
SUB RainbowImage (image AS LONG) 'make backdrop image
DIM m AS _MEM: m = _MEMIMAGE(image)
DIM AS _OFFSET o, l
DIM AS _UNSIGNED LONG p
o = m.OFFSET: l = m.OFFSET + m.SIZE
$CHECKING:OFF
DO UNTIL o >= l
_MEMGET m, o, p
SELECT CASE p
CASE &HFF0000FF
h~& = &HFF000000 + RND * &HFFFFFF
_MEMPUT m, o, h~&
CASE ELSE:
_MEMPUT m, o, &H00000000 AS _UNSIGNED LONG
END SELECT
o = o + 4
LOOP
$CHECKING:ON
END SUBAn example for you, with your blueStar painted rainbow sprinkled (IT'S PRETTY!), and the redStar exploded into pure chaos! (Grab the image below and save it as "whut.png" and you'll be all set for testing.
RE: I need input on a possible bug in v3.5.0 - SMcNeill - 01-21-2023
![[Image: image.png]](https://i.ibb.co/5WYCJMp/image.png)
(A pic of our pretty Sprinkle Star!)
RE: I need input on a possible bug in v3.5.0 - bplus - 01-21-2023
Terry's worked too without any mods I just added 2 more images:
Code: (Select All)
RedOval.image = _LoadImage("Rock1.png", 32)
GreenOval.image = _LoadImage("rock2.png", 32)