Posts: 41
Threads: 8
Joined: Jul 2025
Reputation:
7
09-14-2025, 10:45 PM
(This post was last modified: 09-18-2025, 08:52 PM by Herve.)
Hi,
Pixel-perfect collision detection demo; it was fun to create. There's definitely room for performance improvements.
Code: (Select All)
' This program demonstrates the application of a collision detection algorithm in 3 steps:
'
' Step 1. Inspecting areas to identify where at least 2 shapes are in.
' Step 2. For each area, checking the distance between the present shapes to determine
' if they could potentially be in contact.
' Step 3. Testing for overlap in each area where the shapes are potentially in contact
' using semi-transparent shape masks.
type point_type
x as double
y as double
end type
type shape_type
index as integer ' shape id
radius as integer ' half size of the shape
firstPointIndex as integer ' first pointer to the points array for vertices
lastPointIndex as integer ' lasr pointer for vertices
x as double ' shape position
y as double
rgbaColor as long ' base color
speed as double ' movement speed
direction as double ' direction speed
rotation as double ' angular speed (radians)
orientation as double ' angular orientation (radians)
drawString as string ' draw description
area as integer ' area where the center of the shape is located
areaX as integer '
areaY as integer '
imageHandle as long ' stock shape drawing
maskHandle as long ' stock mask drawing
maskComputed as integer ' mask indicator (-1 = computed / 0 = not computed)
collid as integer ' collision indicator (-1 = collision detected)
end type
const SHAPES_COUNT = 128 ' number of shapes
const MIN_SHAPE_RADIUS = 5 ' minimum radius of the circle containing a shape
const MAX_SHAPE_RADIUS = 30 ' maximum radius of the circle containing a shape
const MIN_SHAPE_VERTICES = 5 ' minimum number of vertices of a shape
const MAX_SHAPE_VERTICES = 15 ' maximum number of vertices of a shape
const MIN_SHAPE_SPEED = 0.5 ' minimum speed of a shape
const MAX_SHAPE_SPEED = 1.1 ' maximum speed of a shape
const PIXELS_PRECISION = 2 ' collision pixels precision
type area_type
shapeLocator as string * SHAPES_COUNT ' Character array to memorize shapes in area
column as integer ' area colum
row as integer ' area row
x as integer ' top-left position of the area on the screen
y as integer
center as point_type ' center position of the area onthe screen
end type
const DRAW_MODE = 1 ' 0 = use DRAW instruction / 1 = use LINE instruction
const STEP_MODE_KEY = "S" ' toggle stepmode
step_mode_activated% = 0 ' -1 = step by step / 0 = don't
const SHOW_DETECTION_KEY = "D" ' toggle drawing proximity detection areas
show_detection_activated% = 0 ' -1 = show proximity detections areas / 0 = don't
const SHOW_GRID_KEY = "G" ' toggle drawing grid to show area delimitations
show_grid_activated% = 0 ' -1 = show grid of areas / 0 = dont't
const SHOW_COLLISIONS_KEY = "C" ' toogle drawing areas with potential collisions
show_collisions_activated% = 0 ' -1 = show areas where collisions are potentials / 0 = dont't
const EXPECTED_FPS = 60 ' Expected Frames Per Second
const VIEWPORT_WIDTH = 440 ' viewport width
const VIEWPORT_HEIGHT = 440 ' viewport height
dim shared TAU as single ' 2 * PI
TAU = 8 * atn(1)
redim shapes(-1) as shape_type ' array containing the shapes description
redim points(0) as point_type ' array containing coordinates of the vertices of the shapes
' definition of the page dimension in which the shapes are drawn
const X_DECAY = _ceil(2.5 * MAX_SHAPE_RADIUS) ' offset between canvas and viewport
const Y_DECAY = _ceil(2.5 * MAX_SHAPE_RADIUS)
const CANVAS_WIDTH = VIEWPORT_WIDTH + 2 * X_DECAY ' canvas size
const CANVAS_HEIGHT = VIEWPORT_HEIGHT + 2 * Y_DECAY
' areas definitions
const AREAS_WIDTH = _ceil(CANVAS_WIDTH / MAX_SHAPE_RADIUS) ' number of areas in a row
const AREAS_HEIGHT = _ceil(CANVAS_HEIGHT / MAX_SHAPE_RADIUS) ' number of areas in a colum
const AREAS_COUNT = AREAS_WIDTH * AREAS_HEIGHT ' total number of areas (size of areas array)
const WIDTH_OF_AREA = 2 * MAX_SHAPE_RADIUS ' size of an area
const HEIGHT_OF_AREA = 2 * MAX_SHAPE_RADIUS
' areas array initialisation
redim areas(0 to AREAS_COUNT) as area_type
for i%=lbound(areas) to ubound(areas)
areas(i%).column = i% mod AREAS_WIDTH
areas(i%).row = i% \ AREAS_WIDTH + 1
areas(i%).x = areas(i%).column * MAX_SHAPE_RADIUS
areas(i%).y = areas(i%).row * MAX_SHAPE_RADIUS
areas(i%).center.x = areas(i%).x + MAX_SHAPE_RADIUS
areas(i%).center.y = areas(i%).y + MAX_SHAPE_RADIUS
next i%
' set random draw
randomize timer
' home screen
screen 0
cls
color _rgb(63,160,0)
locate 4,1
? " ========================"
? " Collision Detection Demo"
? " ========================"
?
? " What this program does:"
? " - Generates moving and rotating irregular polygonal shapes."
? " - Uses spatial partitioning (areas) to find near neighbours."
? " - Performs circle-circle and pixel-level mask collision tests."
? " - Show collisions by changing the color of the affected shapes."
?
? " Keyboard shortcuts:"
? " S - Toggle step mode (when active, press any key to advance a frame)"
? " D - Toggle drawing of proximity detection areas"
? " G - Toggle grid of areas"
? " C - Toggle highlighting of areas with potential collisions"
? " Esc - Quit"
?
? " Press any key to start..."
do : k$ = inkey$ : loop while k$ = ""
' generate all shapes
for i% = 1 to SHAPES_COUNT
generateShape _
shapes(), points(), _
MIN_SHAPE_RADIUS, MAX_SHAPE_RADIUS, _
MIN_SHAPE_VERTICES, MAX_SHAPE_VERTICES, _
MIN_SHAPE_SPEED, MAX_SHAPE_SPEED
next i%
' prepare screen rendering
viewport& = _newimage(VIEWPORT_WIDTH,VIEWPORT_HEIGHT,32)
canvas& = _newimage(CANVAS_WIDTH,CANVAS_HEIGHT,32)
textview& = _newimage(CANVAS_WIDTH,64,32)
screen viewport&
' timer to compute frames per second
t = timer(.001)
' main loop
do
_limit EXPECTED_FPS
_dest canvas&
cls
' draw shapes
for i%=lbound(shapes) to ubound(shapes)
drawShape shapes(i%), points()
shapes(i%).collid = 0
next i%
' draw grid
if show_grid_activated% then
for x% = 0 to AREAS_WIDTH
xx%= (x% + 0.5) * MAX_SHAPE_RADIUS
line (xx%,0)-(xx%,CANVAS_HEIGHT),_rgba(255,255,255,63)
next x%
for y% = 0 to AREAS_HEIGHT
yy% = (y% + 0.5) * MAX_SHAPE_RADIUS
line (0,yy%)-(CANVAS_WIDTH,yy%),_rgba(255,255,255,63)
next y%
end if
' init areas for collision detection
for i% = lbound(areas) to ubound(areas)
areas(i%).shapeLocator = space$(SHAPES_COUNT)
next i%
' move shapes
for i%=lbound(shapes) to ubound(shapes)
moveShape shapes(i%), points()
next i%
' compute proximity detections areas
' and draw on demand
for i%=lbound(shapes) to ubound(shapes)
redim targets(-1) as integer
evaluateShapeSector shapes(i%), areas(), targets()
if show_detection_activated% then
if shapes(i%).area>=0 then
for j% = 0 to ubound(targets)
x% = targets(j%) mod AREAS_WIDTH
y% = targets(j%) \ AREAS_WIDTH + 1
circle ( _
x% * MAX_SHAPE_RADIUS, _
y% * MAX_SHAPE_RADIUS _
), MAX_SHAPE_RADIUS\2, _rgba(255,255,255,127)
next j%
end if
end if
next i%
' detect collisions
' and draw ondemand
for i% = lbound(areas) to ubound(areas)
if instr(areas(i%).shapeLocator,"*") <> _instrrev(areas(i%).shapeLocator,"*") then
collid% = collision(shapes(),areas(i%))
' draw potentials collisions areas
if show_collisions_activated% then
if collid% then
c~& = _rgb(255,0,0)
else
c~& = _rgba(255,255,0,127)
end if
circle ( _
areas(i%).x, _
areas(i%).y _
), MAX_SHAPE_RADIUS\2, c~&
end if
end if
next i%
color &HFFFFFFFF
_printstring (100,100), "fps:"+str$(fps%)
frames% = frames% + 1
if timer(.001)>=t+1 then
fps% = frames%
frames% = 0
t = timer(.001)
end if
' display result
_putimage (- X_DECAY,- Y_DECAY), canvas&, viewport&
' keyboard interaction
do
key$ = inkey$
if key$ = chr$(27) then
system
end if
select case ucase$(key$)
case STEP_MODE_KEY
step_mode_activated% = - step_mode_activated% - 1
case SHOW_DETECTION_KEY
show_detection_activated% = - show_detection_activated% - 1
case SHOW_GRID_KEY
show_grid_activated% = - show_grid_activated% - 1
case SHOW_COLLISIONS_KEY
show_collisions_activated% = - show_collisions_activated% - 1
end select
if step_mode_activated% then
if key$ <> "" then exit do
else
exit do
end if
loop
loop
' generate a polygonal shape
' with movement attributes
sub generateShape ( _
shapes() as shape_type, _
points() as point_type, _
minRadius as integer, maxRadius as integer, _
minPoints as integer, maxPoints as integer,_
minSpeed as double, maxSpeed as double _
)
dim shape as shape_type
dim pointsCounter as integer
shape.radius = int(rnd * (maxRadius - minRadius)) + minRadius
pointsCounter = int(rnd * (maxPoints - minPoints)) + minPoints
shape.firstPointIndex = ubound(points) + 1
shape.lastPointIndex = ubound(points) + pointsCounter
shape.rgbaColor = _rgb32(int(rnd*127)+128,int(rnd*127)+128,int(rnd*127)+128)
shape.x = int(rnd*CANVAS_WIDTH)
shape.y = int(rnd*CANVAS_HEIGHT)
shape.speed = rnd*(maxSpeed - minSpeed) + minSpeed
shape.direction = rnd*TAU
shape.rotation = (rnd*TAU - TAU/2)/100
shape.orientation = 0
shape.imageHandle = _newimage(2*MAX_SHAPE_RADIUS,2*MAX_SHAPE_RADIUS,32)
shape.maskHandle = _newimage(2*MAX_SHAPE_RADIUS\PIXELS_PRECISION,2*MAX_SHAPE_RADIUS\PIXELS_PRECISION,32)
redim _preserve points(1 to shape.lastPointIndex) as point_type
delta! = TAU / pointsCounter
angle! = 0
for i% = shape.firstPointIndex to shape.lastPointIndex
radius% = int(rnd * (shape.radius - minRadius)) + minRadius
points(i%).x = int(cos(angle!) * radius%)
points(i%).y = int(sin(angle!) * radius%)
angle! = angle! + delta!
next i%
convertShapeToDrawString shape, points()
redim _preserve shapes(1 to ubound(shapes) + 1) as shape_type
shape.index = ubound(shapes)
shapes(ubound(shapes)) = shape
end sub
' compute a shape movement and rotation
sub moveShape ( shape as shape_type, points() as point_type )
shape.x = shape.x + cos(shape.direction) * shape.speed
shape.y = shape.y + sin(shape.direction) * shape.speed
if shape.x<0 then
shape.x = CANVAS_WIDTH - shape.x
elseif shape.x>CANVAS_WIDTH then
shape.x = - (shape.x - CANVAS_WIDTH)
end if
if shape.y<0 then
shape.y = CANVAS_HEIGHT - shape.y
elseif shape.y > CANVAS_HEIGHT then
shape.y = - (shape.y - CANVAS_HEIGHT)
end if
shape.orientation = shape.orientation + shape.rotation
if shape.orientation < 0 then
shape.orientation = TAU + shape.orientation
elseif shape.orientation > TAU then
shape.orientation = shape.orientation - TAU
end if
for i%=shape.firstPointIndex to shape.lastPointIndex
x! = points(i%).x
y! = points(i%).y
rotation x!, y!, shape.rotation
points(i%).x = x!
points(i%).y = y!
next i%
convertShapeToDrawString shape, points()
' shape change the mask is not valid
shape.maskComputed = 0
end sub
' helper to angular rotation
sub rotation (x!, y!, a!)
xr! = x! * cos(a!) - y! * sin(a!)
yr! = x! * sin(a!) + y! * cos(a!)
x! = xr!
y! = yr!
end sub
' convert a points array to DRAW string sequence
sub convertShapeToDrawString (shape as shape_type, points() as point_type)
shape.drawString = ""
n% = 0
for i% = shape.firstPointIndex to shape.lastPointIndex
x% = int(points(i%).x + shape.x)
y% = int(points(i%).y + shape.y)
if x%<0 or y%<0 then n% = -1
rx$ = _tostr$(x%)
ry$ = _tostr$(y%)
shape.drawString = shape.drawString + "M " + rx$ + ", " + ry$
next i%
x% = int(points(shape.firstPointIndex).x + shape.x)
y% = int(points(shape.firstPointIndex).y + shape.y)
rx$ = _tostr$(x%)
ry$ = _tostr$(y%)
shape.drawString = shape.drawString + "M " + rx$ + ", " + ry$
if n% then shape.drawString = ""
end sub
' draw shape
' CAUTION : the DRAW mode is not efficient, prefer then LINE mode
sub drawShape ( shape as shape_type, points() as point_type )
h& = _dest
_dest shape.imageHandle
cls , &H00FFFFFF
dim rgbaColor as _unsigned long
rgbaColor = shape.rgbaColor
if shape.collid then rgbaColor = _rgba(255,255,0,255)
select case DRAW_MODE
case 0
if shape.drawString<>"" then
draw "C"+str$(shape.rgbaColor)
draw "B"+shape.drawString
paint (MAX_SHAPE_RADIUS,MAX_SHAPE_RADIUS),rgbaColor and &H7FFFFFFF ,rgbaColor
end if
case 1
pset (points(shape.firstPointIndex).x + MAX_SHAPE_RADIUS, points(shape.firstPointIndex).y + MAX_SHAPE_RADIUS), rgbaColor
for i%=shape.firstPointIndex to shape.lastPointIndex
line - (points(i%).x + MAX_SHAPE_RADIUS, points(i%).y + MAX_SHAPE_RADIUS), rgbaColor
next i%
line - (points(shape.firstPointIndex).x + MAX_SHAPE_RADIUS, points(shape.firstPointIndex).y + MAX_SHAPE_RADIUS), rgbaColor
paint (MAX_SHAPE_RADIUS,MAX_SHAPE_RADIUS),rgbaColor and &H7FFFFFFF ,rgbaColor
end select
_putimage (shape.x - MAX_SHAPE_RADIUS, shape.y - MAX_SHAPE_RADIUS), shape.imageHandle, h&
_dest h&
end sub
' generates a semi-transparent mask image
sub computeMask ( shape as shape_type )
h& = _dest
_source shape.imageHandle
_dest shape.maskHandle
cls , &H00000000
m% = 2 * MAX_SHAPE_RADIUS - 1
for x% = 0 to m% step PIXELS_PRECISION
for y% = 0 to m% step PIXELS_PRECISION
if point(x%,y%) <> &H00FFFFFF then
pset(x%\PIXELS_PRECISION,y%\PIXELS_PRECISION), &H7FFFFFFF
end if
next y%
next x%
' the mask is now valid
shape.maskComputed = -1
_dest h&
end sub
' calculation of the areas affected by the shape
sub evaluateShapeSector ( shape as shape_type, areas() as area_type, targets() as integer )
x% = shape.x
y% = shape.y
' shape outside the canvas, so not in an area
if x% < 0 or x% > CANVAS_WIDTH or y% < 0 or y% > CANVAS_HEIGHT then
shape.area = -1
exit sub
end if
' computes area
shape.areaX = _round(x% / MAX_SHAPE_RADIUS)
shape.areaY = _round(y% / MAX_SHAPE_RADIUS)
shape.area = (shape.areaY - 1) * AREAS_WIDTH + shape.areaX
' search other potential areas around
if shape.area>=0 then
redim targets(-1) as integer
x0! = shape.x - shape.radius
y0! = shape.y - shape.radius
sx0% = _round(x0! / MAX_SHAPE_RADIUS)
sy0% = _round(y0! / MAX_SHAPE_RADIUS)
x2! = shape.x + shape.radius
y2! = shape.y + shape.radius
sx2% = _round(x2! / MAX_SHAPE_RADIUS)
sy2% = _round(y2! / MAX_SHAPE_RADIUS)
s0% = (sy0% - 1) * AREAS_WIDTH + sx0%
s1% = (sy0% - 1) * AREAS_WIDTH + shape.areaX
s2% = (sy0% - 1) * AREAS_WIDTH + sx2%
s3% = (shape.areaY - 1) * AREAS_WIDTH + sx0%
s4% = (shape.areaY - 1) * AREAS_WIDTH + shape.areaX
s5% = (shape.areaY - 1) * AREAS_WIDTH + sx2%
s6% = (sy2% - 1) * AREAS_WIDTH + sx0%
s7% = (sy2% - 1) * AREAS_WIDTH + shape.areaX
s8% = (sy2% - 1) * AREAS_WIDTH + sx2%
addUniqueInteger targets(), s0%
addUniqueInteger targets(), s1%
addUniqueInteger targets(), s2%
addUniqueInteger targets(), s3%
addUniqueInteger targets(), s4%
addUniqueInteger targets(), s5%
addUniqueInteger targets(), s6%
addUniqueInteger targets(), s7%
addUniqueInteger targets(), s8%
' remembers the presence of the shape in the area in the character array
for i% = 0 to ubound(targets)
if targets(i%)>=0 and targets(i%)<=AREAS_COUNT then mid$(areas(targets(i%)).shapeLocator,shape.index,1) = "*"
next i%
end if
end sub
' helper to keep only unique values
sub addUniqueInteger ( t() as integer, v as integer )
for i%=lbound(t) to ubound(t)
if t(i%)=v then exit sub
next i%
redim _preserve t(ubound(t)+1) as integer
t(ubound(t)) = v
end sub
' detects collisions between shapes
function collision% ( shapes() as shape_type, area as area_type )
res% = 0
redim obj(-1) as integer
' collect unique shape indices from the area string (positions of '*')
p0% = instr(area.shapeLocator,"*")
do until p0% = 0
s0% = p0%
found% = 0
for i%=lbound(obj) to ubound(obj)
if obj(i%) = s0% then
found% = -1
exit for
end if
next i%
if not found% then
redim _preserve obj(ubound(obj)+1) as integer
obj(ubound(obj)) = s0%
end if
p0% = instr(p0%+1,area.shapeLocator,"*")
loop
' pairwise collision test (circle-circle) then test pixel-perfect
' when the distance is short enough to have a possible collision
for i%=lbound(obj) to ubound(obj)
for j%=i%+1 to ubound(obj)
if shapes(obj(i%)).collid and shapes(obj(j%)).collid then exit for
h% = _hypot(shapes(obj(i%)).x-shapes(obj(j%)).x,shapes(obj(i%)).y-shapes(obj(j%)).y)
r% = shapes(obj(i%)).radius + shapes(obj(j%)).radius
if h% <= r% then
res% = fusion%(shapes(obj(i%)),shapes(obj(j%)),area)
if res% then
shapes(obj(i%)).collid = -1
shapes(obj(j%)).collid = -1
end if
end if
next j%
next i%
collision% = res%
end function
' detects the overlapping of shapes
'
' each shape mask is semi-transparent ;
' copies each shape mask to its actual position in the area ;
' if we find at least one point that is no longer transparent
' then there is overlap and therefore collision detection
function fusion% ( shapeA as shape_type, shapeB as shape_type, area as area_type )
if not shapeA.maskComputed then
computeMask shapeA
end if
if not shapeB.maskComputed then
computeMask shapeB
end if
res% = 0
m% = 2 * MAX_SHAPE_RADIUS \ PIXELS_PRECISION - 1
buffer& = _newimage(WIDTH_OF_AREA\PIXELS_PRECISION,HEIGHT_OF_AREA\PIXELS_PRECISION,32)
_putimage ( (shapeA.x - area.center.x)\PIXELS_PRECISION, (shapeA.y - area.center.y)\PIXELS_PRECISION ), shapeA.maskHandle, buffer&
_putimage ( (shapeB.x - area.center.x)\PIXELS_PRECISION, (shapeB.y - area.center.y)\PIXELS_PRECISION ), shapeB.maskHandle, buffer&
_source buffer&
for x% = 0 to m%
for y% = 0 to m%
if _alpha32(point(x%,y%)) > &H7F then
res% = -1
exit for
end if
next y%
next x%
_freeimage buffer&
fusion% = res%
end function
Posts: 347
Threads: 45
Joined: Jun 2024
Reputation:
32
Sweet, as you say there is room for improvement but for someone who was asking only last week about it to have then dropped this...DAMN! Nice one bro!
Questions, did you go the radius route to avoid calculating corners, rotation points, rectangle collision areas, etc? Also, what if a sprite is vastly longer than it is wide? How do you deal with all the blank space?
Unseen
Posts: 41
Threads: 8
Joined: Jul 2025
Reputation:
7
Thank you 
The initial idea was that each sprite can fully fit within a circle with a radius of MAX_SHAPE_RADIUS; so if the distance between the centers of two sprites is less than twice the maximum radius, it is very likely that they are touching.
The size of the detection areas is also twice the maximum radius, which seemed optimal to me; if they were smaller, then many more areas would need to be explored, and if they were larger, it would take more time to check the pixel overlay.
For sprites that are wider than they are long, this should work, but I suppose the limit is six times the maximum radius for the length, because I set a limit to test only nine areas for each sprite (the one where its center is located + the eight surrounding areas).
Hey, I might just test that!
Posts: 41
Threads: 8
Joined: Jul 2025
Reputation:
7
(09-15-2025, 06:12 PM)Herve Wrote: For sprites that are wider than they are long, this should work, but I suppose the limit is six times the maximum radius for the length, because I set a limit to test only nine areas for each sprite (the one where its center is located + the eight surrounding areas).
Hey, I might just test that! Well, no, it doesn't work with sprites larger than 2 * MAX_SHAPE_RADIUS!!! And if you increase MAX_SHAPE_RADIUS too much, performance drops very quickly. But hey, it was mostly for fun; pixel-perfect is a luxury that isn't necessary in most applications.
Posts: 347
Threads: 45
Joined: Jun 2024
Reputation:
32
(09-15-2025, 07:06 PM)Herve Wrote: (09-15-2025, 06:12 PM)Herve Wrote: For sprites that are wider than they are long, this should work, but I suppose the limit is six times the maximum radius for the length, because I set a limit to test only nine areas for each sprite (the one where its center is located + the eight surrounding areas).
Hey, I might just test that! Well, no, it doesn't work with sprites larger than 2 * MAX_SHAPE_RADIUS!!! And if you increase MAX_SHAPE_RADIUS too much, performance drops very quickly. But hey, it was mostly for fun; pixel-perfect is a luxury that isn't necessary in most applications. Sorry for bursting your bubble bro...if youre still into collisions see if you can come up with an idea for this....im thinking a raycast will work but as Steve says, sometimes i overthink things so any ideas would be great.
John
![[Image: Accurate-Collision.png]](https://i.ibb.co/ndpGL83/Accurate-Collision.png)
Posts: 3,446
Threads: 376
Joined: Apr 2022
Reputation:
345
If current_x > target_x2 and old_x < _target_x1 then collision as bullet traveled through target.
Or would that not work along that line?
Posts: 1,213
Threads: 162
Joined: Apr 2022
Reputation:
34
09-15-2025, 11:41 PM
(This post was last modified: 09-16-2025, 12:36 AM by madscijr.)
No thoughts on memory compare, or ways to simplify it?
Another thought I had, was to encode each sprite as an array of integers - for example an 8x8 sprite would be 8 bytes, where each byte holds the on/off bits of a single row. A 64x64 sprite would be a 64 element array of Int64. To test if any pixels of one collide with the other, use a binary AND. This will get more complicated but for a first example assume the 2nd sprite is also 64x64 and its X coordinate is at an even multiple of 64 pixels. You can compare the elements in sprite #2 with the elements of sprite #1 that overlap its Y position. Then do a logical AND of the aligned Int64 values - if the result >0 then we know at least one pixel overlapped. But what if sprite2 X position is not an even multiple of 64? What if Sprite2 X is Sprite1 X + 5? Would it work to take the Int64 value for the row to compare, and bit shift it left by 5? I haven't worked out how that could be done. Also, what if we want to check collision between two sprites of different sizes, e.g., 32x32 & 64x64, or 8x8 and 64x64? Do we need to instead encode the 64x64 as 8 bytes per row (times 64 rows)? Then we need to track which block the 8x8 would coincide with and bit shift that? This could get complicated or maybe not, maybe someone who understands bit operations can see a way to do this easily. I am not sure.
Another method to consider is a simple 2D array of booleans holding TRUE for each location with a pixel, so instead of looping through each image's pixels in the overlap region using POINT(x,y), we're now only comparing TRUE/FALSE. Would that improve efficiency?
(I had thought about maybe a 2nd array holding ONLY the x,y of the points with pixels, to use to compare FROM, as a way to avoid having to loop over empty pixels, but that could get HUGE for a 64x64 sprite that has more pixels than empty spaces... Probably not worth it.)
Thoughts on doing the memory compare or leveraging the binary AND operation for finding overlap?
Posts: 41
Threads: 8
Joined: Jul 2025
Reputation:
7
That really made me want to dig into collisions.
1st challenge: handle collisions for objects that are longer than they are wide.
2nd challenge: detect collisions before they happen using ray tracing.
But first, a short debrief of how my proximity-and-mask-overlap collision detection code works.
- All objects (shapes) are built to fit inside a circle with a predefined maximum radius.
- Space is divided into square areas whose side length equals the maximum radius.
- At any given moment an object will overlap at least 1 area and at most 9 areas.
- If an area is overlapped by several objects, the distance between the centers of those objects is computed pairwise.
- If the calculated distance is less than or equal to 2 times the maximum radius, the masks of the two objects are copied into an image buffer the size of the area, placed according to their actual positions relative to that area.
- Since the masks are semi‑transparent, overlapping pixels become opaque.
- If the resulting image buffer contains at least one opaque pixel, a collision is confirmed for both objects.
- Pairs of objects already detected as colliding do not need to be detected again.
I made two improvements (code updated in post #21):
1. Because an object’s mask must be recalculated every cycle due to the object rotating, the mask is now recomputed for an object only when a collision is suspected.
2. For better performance, detection precision can now be reduced by changing mask size with the PIXELS_PRECISION parameter. A mask’s area is divided by PIXELS_PRECISION squared.
Posts: 41
Threads: 8
Joined: Jul 2025
Reputation:
7
Hi,
Here’s the new program that performs pixel‑perfect detection without using mask techniques; it’s based on polygon intersection calculations.
It handles shapes that are longer than they are wide well. Performance is pretty good (60 FPS for 128 objects on a Raspberry Pi 500).
There are definitely optimizations to be found. And also need more comments to explain how it works. This could become a library — what do you think?
Code: (Select All)
type point_type
x as double
y as double
end type
type shape_type
index as integer
verticescounter as integer
firstpointindex as integer
lastpointindex as integer
center as point_type
min as point_type
max as point_type
coord as point_type
rgbacolor as _unsigned long
speed as double
direction as double
rotation as double
orientation as double
imageHandle as long
touchdownHandle as long
width as long
height as long
radius as long
area as integer ' area where the center of the shape is located
areaX as integer '
areaY as integer '
collid as integer
end type
type context_type
step_mode_activated as integer ' -1 = step by step / 0 = don't
show_grid_activated as integer ' -1 = show grid of areas / 0 = dont't
show_detection_activated as integer ' -1 = show proximity detections areas / 0 = don't
show_collisions_activated as integer ' -1 = show areas where collisions are potentials / 0 = dont't
show_radius_activated as integer
show_index_activated as integer
fullscreen_activated as integer
show_help_activated as integer
textHandle as long
extra_shape_activated as integer
end type
const STEP_MODE_KEY = "S" ' toggle stepmode
const SHOW_DETECTION_KEY = "P" ' toggle drawing proximity detection areas
const SHOW_GRID_KEY = "G" ' toggle drawing grid to show area delimitations
const SHOW_COLLISIONS_KEY = "C" ' toogle drawing areas with potential collisions
const SHOW_RADIUS_KEY = "R"
const SHOW_INDEX_KEY = "I"
const SWAP_FULLSCREEN = "F"
const HIDE_HELP = "H"
const EXTRA_SHAPE_KEY = "E"
const UP_KEY = chr$(0) + chr$(72)
const RIGHT_KEY = chr$(0) + chr$(77)
const DOWN_KEY = chr$(0) + chr$(80)
const LEFT_KEY = chr$(0) + chr$(75)
dim context as context_type
const SHAPES_COUNTER = 64
const MIN_SHAPE_VERTICES = 3
const MAX_SHAPE_VERTICES = 12
const MIN_SHAPE_WIDTH = 30
const MAX_SHAPE_WIDTH = 60
const MIN_SHAPE_HEIGHT = 10
const MAX_SHAPE_HEIGHT = 20
const MIN_SHAPE_SPEED = 0.5 ' minimum speed of a shape
const MAX_SHAPE_SPEED = 1.1 ' maximum speed of a shape
const EXPECTED_FPS = 60 ' expected frames per second
const VIEWPORT_WIDTH = 640 ' viewport width
const VIEWPORT_HEIGHT = 480 ' viewport height
const FULLSCREEN = 0 ' -1 = fullscreen / 0 = don't
dim shared tau as single ' 2 * pi
tau = 8 * atn(1)
CONST EPS = 0 '1E-9
randomize timer
' areas initialization
type area_type
shapeLocator as string * SHAPES_COUNTER ' Character array to memorize shapes in area
column as integer ' area colum
row as integer ' area row
x as integer ' top-left position of the area on the screen
y as integer
center as point_type ' center position of the area onthe screen
end type
dim shared AREA_SIDE_WIDTH as integer
dim shared AREAS_ROWS_COUNT as integer
dim shared AREAS_COLUMNS_COUNT as integer
dim shared AREAS_COUNT as integer
AREA_SIDE_WIDTH = _max(MAX_SHAPE_WIDTH,MAX_SHAPE_HEIGHT)
' definition of the page dimension in which the shapes are drawn
const X_DECAY = 120 '_ceil(2.5 * MAX_SHAPE_WIDTH) ' offset between canvas and viewport
const Y_DECAY = 120 'X_DECAY
const CANVAS_WIDTH = VIEWPORT_WIDTH + 2 * X_DECAY ' canvas size
const CANVAS_HEIGHT = VIEWPORT_HEIGHT + 2 * Y_DECAY
AREAS_COLUMNS_COUNT = _ceil(CANVAS_WIDTH / AREA_SIDE_WIDTH)
AREAS_ROWS_COUNT = _ceil(CANVAS_HEIGHT / AREA_SIDE_WIDTH)
AREAS_COUNT = AREAS_COLUMNS_COUNT * AREAS_ROWS_COUNT
areas_max = AREAS_COUNT
redim areas(0 to areas_max-1) as area_type
redim infos(-1) as string
dim i as integer
$console
_dest _console
for i=lbound(areas) to ubound(areas)
areas(i).column = i mod AREAS_COLUMNS_COUNT
areas(i).row = i \ AREAS_COLUMNS_COUNT
areas(i).x = areas(i).column * area_side_width
areas(i).y = areas(i).row * area_side_width
areas(i).center.x = areas(i).x + area_side_width / 2
areas(i).center.y = areas(i).y + area_side_width / 2
next i
' shapes initialization
redim shapes(-1) as shape_type
redim points(0) as point_type
for i=1 to SHAPES_COUNTER
generateshape shapes(), points()
next i
' prepare screen rendering
viewport& = _newimage(VIEWPORT_WIDTH,VIEWPORT_HEIGHT,32)
_printmode _keepbackground, viewport&
canvas& = _newimage(CANVAS_WIDTH,CANVAS_HEIGHT,32)
textDest& = _newimage(CANVAS_WIDTH,CANVAS_HEIGHT,32)
context.textHandle = textDest&
screen viewport&
if FULLSCREEN then _fullscreen , _smooth
' timer to compute frames per second
t = timer(.001)
fps% = 0
frames% = 0
color &HFFFFFFFF, &H00000000
' main loop
do
_limit EXPECTED_FPS
for i=lbound(shapes) to ubound(shapes)
moveShape shapes(i), points()
shapes(i).collid = 0
next i
' reset areas
for i = lbound(areas) to ubound(areas)
areas(i).shapeLocator = ""
next i
' compute shapes' areas
for i=lbound(shapes) to ubound(shapes)
redim targets(-1) as integer
evaluateShapeSector shapes(i), areas(), targets()
next i
_dest canvas&
cls
' draw grid
if context.show_grid_activated then
for x% = 0 to AREAS_COLUMNS_COUNT
xx%= x% * AREA_SIDE_WIDTH
line (xx%,0)-(xx%,CANVAS_HEIGHT),_rgba(255,255,255,63)
next x%
for y% = 0 to AREAS_ROWS_COUNT
yy% = y% * AREA_SIDE_WIDTH
line (0,yy%)-(CANVAS_WIDTH,yy%),_rgba(255,255,255,63)
next y%
end if
areasNotEmpty% = 0
areasWithPossibleCollisions% = 0
areasWithCollisions% = 0
shapesInCollision% = 0
for i = lbound(areas) to ubound(areas)
showme% = 0
if instr(areas(i).shapeLocator,"*") > 0 then
showme% = 1
areasNotEmpty% = areasNotEmpty% + 1
end if
if instr(areas(i).shapeLocator,"*") <> _instrrev(areas(i).shapeLocator,"*") then
showme% = 2
areasWithPossibleCollisions% = areasWithPossibleCollisions% + 1
status% = collision(shapes(), points(), areas(i))
if status% then areasWithCollisions% = areasWithCollisions% + 1
end if
if showme% > 0 then
if context.show_detection_activated or context.show_collisions_activated then
if context.show_detection_activated and not context.show_collisions_activated then
showme% = 1
end if
showcolor! = _iif(showme%=1,&H7FFFFF00,&HFFFF0000)
if context.show_detection_activated or (context.show_collisions_activated and showme% = 2) then
pset (areas(i).x,areas(i).y)
line -step (area_side_width,0), showcolor!
line -step (0,area_side_width), showcolor!
line -step (-area_side_width,0), showcolor!
line -step (0,-area_side_width), showcolor!
if context.show_index_activated then
color &HFFFFFFFF '', &H00000000
_printstring (x%,y%), _tostr$(i), context.textHandle
end if
end if
end if
end if
next i
_dest textDest&
cls , _rgba(0,0,0,0)
for i=lbound(shapes) to ubound(shapes)
if shapes(i).collid then shapesInCollision% = shapesInCollision% + 1
drawShape context,shapes(i), points(), 0
next i
' fps
frames% = frames% + 1
if timer(.001)>=t+1 then
fps% = frames%
frames% = 0
t = timer(.001)
end if
' display result
_dest textDest&
color &HFFFFFFFF, &HE0A0A0FF
if context.show_help_activated then
resetInfo infos()
addinfo infos(), " fps: "+right$("000"+_tostr$(fps%),3)
addInfo infos(), " *** Pixel Perfect Collision Detection Demonstrator ***"
addinfo infos(), ""
addInfo infos(), "SHAPES"
addinfo infos(), "======"
addInfo infos(), " - total: "+right$("000"+_tostr$(SHAPES_COUNTER),3)
addInfo infos(), " - in collision: "+right$("000"+_tostr$(shapesInCollision%),3)
addinfo infos(), ""
addInfo infos(), "AREAS"
addinfo infos(), "======"
addinfo infos(), " - not empty: "+right$("000"+_tostr$(areasNotEmpty%),3)
addinfo infos(), " - with possible collisions: "+right$("000"+_tostr$(areasWithPossibleCollisions%),3)
addinfo infos(), " - with detected collisions: "+right$("000"+_tostr$(areasWithCollisions%),3)
addinfo infos(), ""
addinfo infos(), "ACTION KEYS"
addinfo infos(), "==========="
addinfo infos(), " - H) hide/show this screen (hiding it will increase the performance)"
addInfo infos(), " - S) swicth step mode (then SPACE to move forward step by step): "+_iif(context.step_mode_activated,"ON","OFF")
addinfo infos(), " - G) show areas grid (number,coordinates,1st overlaid shape): "+_iif(context.show_grid_activated,"ON","OFF")
addinfo infos(), " - P) show proximity detection areas: "+_iif(context.show_detection_activated,"ON","OFF")
addInfo infos(), " - C) show probable collision areas: "+_iif(context.show_collisions_activated,"ON","OFF")
addinfo infos(), " - R) show shapes radius: "+_iif(context.show_radius_activated,"ON","OFF")
addinfo infos(), " - I) show shapes index (+ coordinates + area number): "+_iif(context.show_index_activated,"ON","OFF")
addInfo infos(), " - E) swicth control of a shape (use arrows key to move): "+_iif(context.extra_shape_activated,"ON","OFF")
addinfo infos(), " - F) swicth fullscreen"
addinfo infos(), " - ESC) stop and quit this program"
addinfo infos(), ""
showInfo infos()
else
color &HE0FFFFFF, &H00000000
_printstring (1 + X_DECAY,1+Y_DECAY), "fps:"+right$("000"+_tostr$(fps%),3)
_printstring (1 + X_DECAY,1+VIEWPORT_HEIGHT+Y_DECAY-16), "H)elp S)tep G)rid P)roximity C)ollision R)adius I)ndex E)xtra F)ullscr ESC)quit"
end if
if context.show_grid_activated then
color &HA0FFFFFF, &H00000000
for i = lbound(areas) to ubound(areas)
_printstring (areas(i).x,areas(i).y), _tostr$(i)
_printstring (areas(i).x,areas(i).y+12), _tostr$(areas(i).x)
_printstring (areas(i).x,areas(i).y+24), _tostr$(areas(i).y)
_printstring (areas(i).x,areas(i).y+36), _tostr$(instr(areas(i).shapeLocator,"*")-1)
next i
end if
_putimage (0,0), textDest&, canvas&
_putimage (- X_DECAY,- Y_DECAY), canvas&, viewport&
' keyboard interaction
do
key$ = inkey$
if key$ = chr$(27) then system
select case ucase$(key$)
case STEP_MODE_KEY
switch context.step_mode_activated
case SHOW_DETECTION_KEY
switch context.show_detection_activated
case SHOW_GRID_KEY
switch context.show_grid_activated
case SHOW_COLLISIONS_KEY
switch context.show_collisions_activated
case SHOW_RADIUS_KEY
switch context.show_radius_activated
case SHOW_INDEX_KEY
switch context.show_index_activated
case HIDE_HELP
switch context.show_help_activated
case SWAP_FULLSCREEN
switch context.fullscreen_activated
if context.fullscreen_activated then
_fullscreen _squarepixels, _smooth
else
_fullscreen _off
end if
case EXTRA_SHAPE_KEY
switch context.extra_shape_activated
if context.extra_shape_activated then
extraShape shapes(lbound(shapes)), points()
else
disextraShape shapes(lbound(shapes)), points()
end if
case UP_KEY
if context.extra_shape_activated then shapes(lbound(shapes)).coord.y = shapes(lbound(shapes)).coord.y - 5
case DOWN_KEY
if context.extra_shape_activated then shapes(lbound(shapes)).coord.y = shapes(lbound(shapes)).coord.y + 5
case RIGHT_KEY
if context.extra_shape_activated then shapes(lbound(shapes)).coord.x = shapes(lbound(shapes)).coord.x + 5
case LEFT_KEY
if context.extra_shape_activated then shapes(lbound(shapes)).coord.x = shapes(lbound(shapes)).coord.x - 5
end select
if context.step_mode_activated then
if key$ <> "" then exit do
else
exit do
end if
loop
loop
sub switch (boolean as integer)
boolean = not boolean
end sub
' draw a shape
sub drawShape (context as context_type, shape as shape_type, points() as point_type, mask as integer)
x0 = shape.coord.x '- X_DECAY '- shape.width\2
y0 = shape.coord.y '+ Y_DECAY '- shape.height\2
if shape.collid then
RotoZoom3 x0, y0, shape.touchdownHandle, 1, 1, shape.orientation
circle (x0,y0), shape.radius/4, &HFFFF0000
else
RotoZoom3 x0, y0, shape.imageHandle, 1, 1, shape.orientation
end if
if context.show_radius_activated then
circle (x0,y0), shape.radius, shape.rgbaColor
end if
if context.extra_shape_activated and shape.index = 0 then
circle (x0,y0), shape.radius/4, &HFFFF0000
paint (x0,y0), &HFFFF0000, &HFFFF0000
end if
if context.show_index_activated then
color &HFFFFFFFF, &H00000000
'_printstring (shape.center.x - 6,shape.center.y - 6), _tostr$(shape.index), shape.imageHandle
_printstring (x0 - 6,y0 - 6), _tostr$(shape.index)+"("+_tostr$(int(shape.coord.x))+","+_tostr$(int(shape.coord.y))+")"+"["+_tostr$(shape.area)+"]", context.textHandle
end if
end sub
' prepare the sprite image
sub prepareSpriteImage (shape as shape_type, points() as point_type)
h& = _dest
_dest shape.imageHandle
cls , &H00FFFFFF
borderColor& = shape.rgbacolor
fillColor& = shape.rgbacolor AND &H80FFFFFF
x0 = points(shape.firstpointindex).x + shape.center.x
y0 = points(shape.firstpointindex).y + shape.center.y
pset (x0,y0), borderColor&
for p = shape.firstpointindex to shape.lastpointindex
x1 = points(p).x + shape.center.x
y1 = points(p).y + shape.center.y
line -(x1, y1), borderColor&
next p
line -(x0, y0), borderColor&
paint (shape.center.x,shape.center.y), borderColor&, borderColor&
pset (shape.center.x,shape.center.y), borderColor&
_dest h&
end sub
' prepare the touchdown image
sub prepareTouchdownImage (shape as shape_type, points() as point_type)
colorizeImage shape.imageHandle, shape.touchdownHandle, &HA0FFFF00
end sub
sub colorizeImage (imageSource as long, imageDest as long, colorDest as _unsigned long)
h& = _dest
_dest imageDest
cls , &H00FFFFFF
_source imageSource
for x% = 0 to _width(imageSource) - 1
for y% = 0 to _height(imageSource) - 1
if _alpha32(point(x%,y%))>0 then pset (x%,y%), colorDest
next y%
next x%
_dest h&
end sub
' generate a shape
sub generateshape (shapes() as shape_type, points() as point_type)
' nombre de sommets
n = int(rnd * (MAX_SHAPE_VERTICES - MIN_SHAPE_VERTICES)) + MIN_SHAPE_VERTICES + 1
' largeur
w = int(rnd * (MAX_SHAPE_WIDTH - MIN_SHAPE_WIDTH)) + MIN_SHAPE_WIDTH + 1
' hauteur
h = int(rnd * (MAX_SHAPE_HEIGHT - MIN_SHAPE_HEIGHT)) + MIN_SHAPE_HEIGHT + 1
' type (convexe / concave) t$
t$ = _iif(rnd > 0.5, "convexe", "concave")
' facteur de concavité (0..1, pour concave) : ", cf
cf = rnd
redim polygon(n - 1) as point_type
attempts = 0
generatepolygon n, w, h, t$, cf, polygon()
dim shape as shape_type
shape.verticescounter = n
shape.firstpointindex = ubound(points)+1
shape.lastpointindex = shape.firstpointindex + n - 1
redim _preserve points(1 to shape.lastpointindex) as point_type
dim as point_type min, max
min.x = 1.0E308 : max.x = - min.x
min.y = 1.0E308 : max.y = - min.y
for i = lbound(polygon) to ubound(polygon)
min.x = _iif(polygon(i).x < min.x,polygon(i).x,min.x)
min.y = _iif(polygon(i).y < min.y,polygon(i).y,min.y)
max.x = _iif(polygon(i).x > max.x,polygon(i).x,max.x)
max.y = _iif(polygon(i).y > max.y,polygon(i).y,max.y)
points(shape.firstpointindex + i).x = polygon(i).x
points(shape.firstpointindex + i).y = polygon(i).y
next i
shape.min = min
shape.max = max
shape.width = max.x - min.x + 1
shape.height = max.y - min.y + 1
shape.center.x = shape.width / 2
shape.center.y = shape.height / 2
shape.radius = _max(shape.width,shape.height)/2
shape.imageHandle = _newimage(shape.width,shape.height,32)
shape.touchdownHandle = _newimage(shape.width,shape.height,32)
for i = lbound(polygon) to ubound(polygon)
points(shape.firstpointindex + i).x = int(points(shape.firstpointindex + i).x - shape.center.x)
points(shape.firstpointindex + i).y = int(points(shape.firstpointindex + i).y - shape.center.y)
next i
shape.speed = rnd*(MAX_SHAPE_SPEED - MIN_SHAPE_SPEED) + MIN_SHAPE_SPEED
shape.direction = rnd*TAU
shape.rotation = (rnd*TAU - TAU/2)/100
shape.orientation = 0
shape.rgbaColor = _rgb32(int(rnd*127)+128,int(rnd*127)+128,int(rnd*127)+128)
shape.coord.x = int(rnd * CANVAS_WIDTH)
shape.coord.y = int(rnd * CANVAS_HEIGHT)
shape.index = ubound(shapes)+1
redim _preserve shapes(lbound(shapes) to shape.index) as shape_type
shapes(shape.index) = shape
prepareSpriteImage shape, points()
prepareTouchdownImage shape, points()
end sub
function randdouble(min#, max#) 'as double
randdouble = min# + rnd * (max# - min#)
end function
' test for segment intersection (excluding shared endpoints of segments)
function segintersect(ax#, ay#, bx#, by#, cx#, cy#, dx#, dy#)
dim s1x#, s1y#, s2x#, s2y#, s#, t#
s1x = bx - ax: s1y = by - ay
s2x = dx - cx: s2y = dy - cy
denom = (-s2x * s1y + s1x * s2y)
if abs(denom) < 1e-12 then
segintersect = 0
exit function
end if
s = (-s1y * (ax - cx) + s1x * (ay - cy)) / denom
t = ( s2x * (ay - cy) - s2y * (ax - cx)) / denom
if s > 0 and s < 1 and t > 0 and t < 1 then
segintersect = 1
else
segintersect = 0
end if
end function
' detect self intersection
function hasselfintersection(pts() as point_type, n as integer)
dim i as integer, j as integer
' vérifier chaque paire d'arêtes non-adjacentes
for i = 0 to n - 1
a1 = i
a2 = (i + 1) mod n
for j = i + 1 to n - 1
b1 = j
b2 = (j + 1) mod n
' ignorer arêtes adjacentes et première/dernière partage
if a1 = b1 or a1 = b2 or a2 = b1 or a2 = b2 then
_continue
end if
if segintersect(pts(a1).x, pts(a1).y, pts(a2).x, pts(a2).y, _
pts(b1).x, pts(b1).y, pts(b2).x, pts(b2).y) then
hasselfintersection = -1
exit function
end if
next j
next i
hasselfintersection = 0
end function
' generate a new polygon
sub generatepolygon(n as integer, w as double, h as double, polytype$ , concavityfactor as double, pts() as point_type)
if n < 3 then
print "n doit être >= 3": end
end if
dim angles() as double
dim radii() as double
redim angles(n - 1)
redim radii(n - 1)
dim i as integer
do
' Generate evenly distributed angles with jitter
for i = 0 to n - 1
basis = tau * i / n
perturb = randdouble(-0.3, 0.3) * (tau / n) * 0.3
angles(i) = basis + perturb
next i
' simple sort (bubble sort acceptable for small n)
for i = 0 to n - 2
for j = i + 1 to n - 1
if angles(i) > angles(j) then
swap angles(i), angles(j)
'tmp# = angles(i): angles(i) = angles(j): angles(j) = tmp#
end if
next j
next i
' initial radii near 1 with small variation
for i = 0 to n - 1
radii(i) = 1 + randdouble(-0.15, 0.15)
next i
' If concave: reduce a few radii
if lcase$(polytype$) = "concave" then
k = int(_max(1, _round(concavityfactor * n / 3)))
if k < 1 then k = 1
' choose k distinct indices
dim chosen() as integer
redim chosen(k - 1)
m = 0
do while m < k
idx = int(rnd * n)
found = 0
for t = 0 to m - 1
if chosen(t) = idx then found = 1: exit for
next t
if found = 0 then
chosen(m) = idx
m = m + 1
end if
loop
for t = 0 to k - 1
idx = chosen(t)
reduction = 1 - (0.3 + 0.65 * concavityfactor * rnd)
radii(idx) = radii(idx) * reduction
left = (idx - 1 + n) mod n
right = (idx + 1) mod n
radii(left) = radii(left) * (1 + 0.05 * rnd)
radii(right) = radii(right) * (1 + 0.05 * rnd)
next t
end if
' build points centered at (0,0) with ellipse rx, ry
rx = w / 2
ry = h / 2
for i = 0 to n - 1
pts(i).x = radii(i) * cos(angles(i)) * rx
pts(i).y = radii(i) * sin(angles(i)) * ry
next i
' normalize to fit exactly within [0,w]×[0,h]
minx = pts(0).x: maxx = pts(0).x
miny = pts(0).y: maxy = pts(0).y
for i = 1 to n - 1
if pts(i).x < minx then minx = pts(i).x
if pts(i).x > maxx then maxx = pts(i).x
if pts(i).y < miny then miny = pts(i).y
if pts(i).y > maxy then maxy = pts(i).y
next i
curw = maxx - minx
curh = maxy - miny
if curw < 1e-9 then curw = 1
if curh < 1e-9 then curh = 1
sx = w / curw
sy = h / curh
for i = 0 to n - 1
pts(i).x = (pts(i).x - minx) * sx
pts(i).y = (pts(i).y - miny) * sy
next i
' check intersections; if conflicting, regenerate (attempt limit)
intersects = hasselfintersection(pts(), n)
attempts = attempts + 1
if attempts > 200 then
exit do
end if
loop while intersects <> 0
end sub
' stop movement for a shape
sub extraShape ( shape as shape_type, points() as point_type )
shape.coord.x = CANVAS_WIDTH \ 2
shape.coord.y = CANVAS_HEIGHT \ 2
shape.speed = 0
shape.rotation = 0
end sub
'
sub disextraShape ( shape as shape_type, points() as point_type )
shape.speed = rnd*(MAX_SHAPE_SPEED - MIN_SHAPE_SPEED) + MIN_SHAPE_SPEED
shape.rotation = (rnd*TAU - TAU/2)/100
end sub
' compute a shape movement and rotation
sub moveShape ( shape as shape_type, points() as point_type )
shape.coord.x = shape.coord.x + cos(shape.direction) * shape.speed
shape.coord.y = shape.coord.y + sin(shape.direction) * shape.speed
if shape.coord.x<0 then
shape.coord.x = CANVAS_WIDTH - shape.coord.x
elseif shape.coord.x>CANVAS_WIDTH then
shape.coord.x = - (shape.coord.x - CANVAS_WIDTH)
end if
if shape.coord.y<0 then
shape.coord.y = CANVAS_HEIGHT - shape.coord.y
elseif shape.coord.y > CANVAS_HEIGHT then
shape.coord.y = - (shape.coord.y - CANVAS_HEIGHT)
end if
shape.orientation = shape.orientation + shape.rotation
if shape.orientation < 0 then
shape.orientation = TAU + shape.orientation
elseif shape.orientation > TAU then
shape.orientation = shape.orientation - TAU
end if
for i%=shape.firstPointIndex to shape.lastPointIndex
x! = points(i%).x
y! = points(i%).y
rotation x!, y!, shape.rotation
points(i%).x = x!
points(i%).y = y!
next i%
end sub
' helper to angular rotation
sub rotation (x!, y!, a!)
xr! = x! * cos(a!) - y! * sin(a!)
yr! = x! * sin(a!) + y! * cos(a!)
x! = xr!
y! = yr!
end sub
Sub RotoZoom3 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, radianRotation As Single)
' This assumes you have set your drawing location with _DEST or default to screen.
' X, Y - is where you want to put the middle of the image
' Image - is the handle assigned with _LOADIMAGE
' xScale, yScale - are shrinkage < 1 or magnification > 1 on the given axis, 1 just uses image size.
' These are multipliers so .5 will create image .5 size on given axis and 2 for twice image size.
' radianRotation is the Angle in Radian units to rotate the image
' note: Radian units for rotation because it matches angle units of other Basic Trig functions
' and saves a little time converting from degree.
' Use the _D2R() function if you prefer to work in degree units for angles.
Dim px(3) As Single: Dim py(3) As Single ' simple arrays for x, y to hold the 4 corners of image
Dim W&, H&, sinr!, cosr!, i&, x2&, y2& ' variables for image manipulation
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2 'left top corner
px(1) = -W& / 2: py(1) = H& / 2 ' left bottom corner
px(2) = W& / 2: py(2) = H& / 2 ' right bottom
px(3) = W& / 2: py(3) = -H& / 2 ' right top
sinr! = Sin(-radianRotation): cosr! = Cos(-radianRotation) ' rotation helpers
For i& = 0 To 3 ' calc new point locations with rotation and zoom
x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle _seamless (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(1), py(1))-(px(2), py(2)),
_MapTriangle _seamless (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(3), py(3))-(px(2), py(2)),
End Sub
' orient (cross product)
function orient (a as point_type, b as point_type, c as point_type)
orient = (b.x - a.x) * (c.y - a.y) - (b.y - a.y) * (c.x - a.x)
end function
' on segment: p colinear and within bbox of [a,b]
' return -1 if p in the bbox
' EPS = small epsilon tolerance for comparaison
function onsegment (a as point_type, b as point_type, p as point_type)
dim minx as double, maxx as double, miny as double, maxy as double
if a.x < b.x then
minx = a.x: maxx = b.x
else
minx = b.x: maxx = a.x
end if
if a.y < b.y then
miny = a.y: maxy = b.y
else
miny = b.y: maxy = a.y
end if
if (p.x + EPS >= minx) and (p.x - EPS <= maxx) and (p.y + EPS >= miny) and (p.y - EPS <= maxy) then
onsegment = -1
else
onsegment = 0
end if
end function
' segments intersect
' return -1 if segment p1 to p2 intersects with segment q1 to q2
' EPS = small epsilon tolerance for comparaison
function segmentsintersect (p1 as point_type, p2 as point_type, q1 as point_type, q2 as point_type)
dim d1 as double, d2 as double, d3 as double, d4 as double
d1 = orient(p1, p2, q1)
d2 = orient(p1, p2, q2)
d3 = orient(q1, q2, p1)
d4 = orient(q1, q2, p2)
if (d1 * d2 < -EPS) and (d3 * d4 < -EPS) then
segmentsintersect = -1
exit function
end if
if (abs(d1) <= EPS) and (onsegment(p1, p2, q1) <> 0) then
segmentsintersect = -1
exit function
end if
if (abs(d2) <= EPS) and (onsegment(p1, p2, q2) <> 0) then
segmentsintersect = -1
exit function
end if
if (abs(d3) <= EPS) and (onsegment(q1, q2, p1) <> 0) then
segmentsintersect = -1
exit function
end if
if (abs(d4) <= EPS) and (onsegment(q1, q2, p2) <> 0) then
segmentsintersect = -1
exit function
end if
segmentsintersect = 0
end function
' point in polygon (ray casting to +x)
' returns -1 if inside or on edge, 0 if outside
function pointinpolygon (pt as point_type, shape as shape_type, points() as point_type)
dim i as long, j as long
dim inside as integer
dim xi as point_type, xj as point_type
inside = 0
j = shape.lastPointIndex
for i = shape.firstPointIndex to shape.lastPointIndex
sum xi, points(i), shape.coord
sum xj, points(j), shape.coord
' check if point is exactly on segment
if abs(orient(xi, xj, pt)) <= eps then
if onsegment(xi, xj, pt) <> 0 then
pointinpolygon = -1
exit function
end if
end if
if ((xi.y > pt.y) <> (xj.y > pt.y)) then
dim x_intersect as double
x_intersect = xi.x + (pt.y - xi.y) * (xj.x - xi.x) / (xj.y - xi.y)
if x_intersect > pt.x then
inside = not inside
end if
end if
j = i
next i
if inside then
pointinpolygon = -1
else
pointinpolygon = 0
end if
end function
' polygonsintersect
' returns -1 if intersecting (including touching), 0 otherwise
function polygonsintersect (shapeA as shape_type, shapeB as shape_type, points() as point_type)
dim i as long, j as long
dim a1 as point_type, a2 as point_type, b1 as point_type, b2 as point_type
h% = _hypot(shapeA.coord.x-shapeB.coord.x,shapeA.coord.y-shapeA.coord.y)
r% = shapeA.radius + shapeB.radius
if h% > r% then
polygonsintersect = 0
exit function
end if
for i = shapeA.firstPointIndex to shapeA.lastPointIndex
sum a1, points(i), shapeA.coord
if i = shapeA.lastPointIndex then
sum a2, points(shapeA.firstPointIndex), shapeA.coord
else
sum a2, points(i+1), shapeA.coord
end if
for j = shapeB.firstPointIndex to shapeB.lastPointIndex
sum b1, points(j), shapeB.coord
if i = shapeB.lastPointIndex then
sum b2, points(shapeB.firstPointIndex), shapeB.coord
else
sum b2, points(i+1), shapeB.coord
end if
if segmentsintersect(a1, a2, b1, b2) <> 0 then
polygonsintersect = -1
exit function
end if
next j
next i
' no edge intersections: test containment
sum a1, points(shapeA.firstPointIndex), shapeA.coord
if pointinpolygon(a1, shapeB, points()) <> 0 then
polygonsintersect = -1
exit function
end if
sum b1, points(shapeB.firstPointIndex), shapeB.coord
if pointinpolygon(b1, shapeA, points()) <> 0 then
polygonsintersect = -1
exit function
end if
polygonsintersect = 0
end function
' sum point 1 and 2 given point 0
sub sum(p0 as point_type, p1 as point_type, p2 as point_type)
p0.x = p1.x + p2.x
p0.y = p1.y + p2.y
end sub
' calculation of the areas affected by the shape
sub evaluateShapeSector ( shape as shape_type, areas() as area_type, targets() as integer )
' shape outside the canvas, so not in an area
if shape.coord.x < 0 or shape.coord.x > CANVAS_WIDTH or shape.coord.y < 0 or shape.coord.y > CANVAS_HEIGHT then
shape.area = -1
exit sub
end if
' computes area
shape.areaX = shape.coord.x \ AREA_SIDE_WIDTH
shape.areaY = shape.coord.y \ AREA_SIDE_WIDTH
shape.area = shape.areaY * AREAS_COLUMNS_COUNT + shape.areaX
' search other potential areas around
if shape.area>=0 then
redim targets(-1) as integer
x0! = shape.coord.x - shape.radius
y0! = shape.coord.y - shape.radius
sx0% = x0! \ AREA_SIDE_WIDTH
sy0% = y0! \ AREA_SIDE_WIDTH
x2! = shape.coord.x + shape.radius
y2! = shape.coord.y + shape.radius
sx2% = x2! \ AREA_SIDE_WIDTH
sy2% = y2! \ AREA_SIDE_WIDTH
s0% = sy0% * AREAS_COLUMNS_COUNT + sx0%
s1% = sy0% * AREAS_COLUMNS_COUNT + shape.areaX
s2% = sy0% * AREAS_COLUMNS_COUNT + sx2%
s3% = shape.areaY * AREAS_COLUMNS_COUNT + sx0%
s4% = shape.areaY * AREAS_COLUMNS_COUNT + shape.areaX
s5% = shape.areaY * AREAS_COLUMNS_COUNT + sx2%
s6% = sy2% * AREAS_COLUMNS_COUNT + sx0%
s7% = sy2% * AREAS_COLUMNS_COUNT + shape.areaX
s8% = sy2% * AREAS_COLUMNS_COUNT + sx2%
addUniqueInteger targets(), s0%
addUniqueInteger targets(), s1%
addUniqueInteger targets(), s2%
addUniqueInteger targets(), s3%
addUniqueInteger targets(), s4%
addUniqueInteger targets(), s5%
addUniqueInteger targets(), s6%
addUniqueInteger targets(), s7%
addUniqueInteger targets(), s8%
' remembers the presence of the shape in the area in the character array
for i% = 0 to ubound(targets)
if targets(i%)>=0 and targets(i%)<=AREAS_COUNT then
if targets(i%)>=lbound(areas) and targets(i%)<=ubound(areas) then
mid$(areas(targets(i%)).shapeLocator,shape.index+1,1) = "*"
end if
end if
next i%
end if
end sub
' helper to keep only unique values
sub addUniqueInteger ( t() as integer, v as integer )
for i%=lbound(t) to ubound(t)
if t(i%)=v then exit sub
next i%
redim _preserve t(ubound(t)+1) as integer
t(ubound(t)) = v
end sub
' detects collisions between shapes
function collision% ( shapes() as shape_type, points() as point_type, area as area_type )
collision% = 0
redim obj(-1) as integer
' collect unique shape indices from the area string (positions of '*')
p0% = instr(area.shapeLocator,"*")
do until p0% = 0
s0% = p0%
found% = 0
for i%=lbound(obj) to ubound(obj)
if obj(i%) = s0% then
found% = -1
exit for
end if
next i%
if not found% then
redim _preserve obj(ubound(obj)+1) as integer
obj(ubound(obj)) = s0%
end if
p0% = instr(p0%+1,area.shapeLocator,"*")
loop
' pairwise collision test (circle-circle) then test pixel-perfect
' when the distance is short enough to have a possible collision
for i%=lbound(obj) to ubound(obj)
for j%=i%+1 to ubound(obj)
if shapes(obj(i%)-1).collid and shapes(obj(j%)-1).collid then exit sub
if polygonsintersect(shapes(obj(i%)-1),shapes(obj(j%)-1),points()) then
shapes(obj(i%)-1).collid = -1
shapes(obj(j%)-1).collid = -1
collision% = -1
exit for
end if
next j%
next i%
end function
sub showInfo (infos() as string)
for i% = lbound(infos) to ubound(infos)
_printstring (30 + X_DECAY,i%*16 + Y_DECAY), left$(" " + infos(i%) + space$(72-len(infos(i%))),73)
next i%
end sub
sub resetInfo (infos() as string)
redim infos(-1) as string
end sub
sub addInfo (infos() as string, info as string)
redim _preserve infos(1 to ubound(infos)+1) as string
infos(ubound(infos)) = info
end sub
Posts: 4,701
Threads: 222
Joined: Apr 2022
Reputation:
322
Man I give you guys pixel perfect collision for any shape and you want to settle for less and with way more code.
I understand though, DIY! everyone can only understand their own stuff LOL
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
|
