Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
I need input on a possible bug in v3.5.0
#17
starRed and starBlue collision demo:

Code: (Select All)
SCREEN _NEWIMAGE(1280, 720, 32)
DIM AS _UNSIGNED LONG target
DIM SHARED Backdrop AS LONG: Backdrop = _COPYIMAGE(0)
blueStar = _LOADIMAGE("Z:\starBlue.png", 32)
redStar = _LOADIMAGE("z:\starRed.png", 32)

bs = MBI(blueStar)
rs = MBI(redStar)



DO
    ClearScreens
    k = _KEYHIT
    SELECT CASE k
        CASE 18432: yPos = yPos - 1
        CASE 20480: yPos = yPos + 1
        CASE 19200: xPos = xPos - 1
        CASE 19712: xPos = xPos + 1
        CASE 32: xPos = 0: yPos = 0 'reset
        CASE 27: SYSTEM
    END SELECT
    PlaceImage 100, 100, bs, bs
    PlaceImage xPos, yPos, rs, rs
    IF checkCollision(x&, y&) THEN PRINT "COLLISON AT: "; x&, y&
    _LIMIT 60
    _DISPLAY
LOOP



SUB ClearScreens
    D = _DEST: CLS , 0: _DEST Backdrop: CLS , 0: _DEST D
END SUB


SUB PlaceImage (x AS LONG, y AS LONG, image AS LONG, imagebackdrop AS LONG)
    _PUTIMAGE (x, y), image, _DISPLAY
    _PUTIMAGE (x, y), imagebackdrop, Backdrop
END SUB

FUNCTION checkCollision (x AS LONG, y AS LONG) 'check for our target color
    STATIC m AS _MEM
    m = _MEMIMAGE(Backdrop)
    DIM AS _OFFSET o, l
    DIM AS _UNSIGNED LONG p
    o = m.OFFSET: l = m.OFFSET + m.SIZE
    FOR y = 0 TO _HEIGHT - 1
        FOR x = 0 TO _WIDTH - 1
            _MEMGET m, o, p
            IF p = &HC07F003F THEN
                checkCollision = -1
                EXIT FUNCTION
            END IF
            o = o + 4
        NEXT
    NEXT
END FUNCTION


FUNCTION MBI (image AS LONG) 'make backdrop image
    DIM temp AS LONG: temp = _COPYIMAGE(image)
    DIM m AS _MEM: m = _MEMIMAGE(temp)
    DIM AS _OFFSET o, l
    DIM AS _UNSIGNED LONG p
    o = m.OFFSET: l = m.OFFSET + m.SIZE
    DO UNTIL o >= l
        _MEMGET m, o, p
        SELECT CASE p
            CASE &HFFFF0000: _MEMPUT m, o, &H80FF0000 AS _UNSIGNED LONG
            CASE &HFF0000FF: _MEMPUT m, o, &H800000FF AS _UNSIGNED LONG
            CASE ELSE: _MEMPUT m, o, &H00000000 AS _UNSIGNED LONG
        END SELECT
        o = o + 4
    LOOP
    MBI = temp
END FUNCTION


I tweaked your stars to get rid of the black backgrounds.  See how the above works for you.  Wink
Reply


Messages In This Thread
RE: I need input on a possible bug in v3.5.0 - by SMcNeill - 01-21-2023, 04:06 PM



Users browsing this thread: 6 Guest(s)