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.
