I need input on a possible bug in v3.5.0

[TerryRitchie]

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 FUNCTION

[bplus]

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

[bplus]

+! 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:

   

[SMcNeill]

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 SUB

This 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.

[SMcNeill]

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. 

[bplus]

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.

[SMcNeill]

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! 

[SMcNeill]

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 SUB

An 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.

   

[SMcNeill]

(A pic of our pretty Sprinkle Star!)

[bplus]

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)