01-21-2023, 04:26 PM
(01-21-2023, 04:06 PM)SMcNeill Wrote: 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&, x&
_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.
Man that appears to be much better, I will check it out with a couple other images too.
Man you guys are fast, I was just gone a few minutes!
b = b + ...