Posts: 41
Threads: 8
Joined: Jul 2025
Reputation:
7
Hi,
Here’s a program that explores a particular approach to collision detection between shapes made of triangles. It’s based on detecting triangle overlap, which makes it possible to determine which parts of a shape are involved in a collision; this could inspire game scenarios — for example, collisions that destroy only part of a shape or cause it to deform.
There may still be some cases where the detection isn't perfect; do you see any? 
Performance is stable, and it holds 60 FPS on my modest setup with 250 small shapes.
Note also that half the code is dedicated to automatically generating shapes by assembling triangles.
Code: (Select All)
$console
type point_type
x as double
y as double
end type
type segment_type
a as point_type
b as point_type
end type
type triangle_type
position as point_type
angle as double
hauteur as double
demibase as point_type
a as point_type
b as point_type
c as point_type
center as point_type
realA as point_type
realB as point_type
realC as point_type
realCenter as point_type
realMin as point_type
realMax as point_type
collid as integer
end type
type shape_type
firstTriangleIndex as integer
lastTriangleIndex as integer
pointsUsageIndicator as string
position as point_type
firstSegmentIndex as integer
lastSegmentIndex as integer
center as point_type
radius as double
direction as double
velocity as double
orientation as double
rotation as double
shapeColor as _unsigned long
borderColor as _unsigned long
collisionColor as _unsigned long
end type
dim as double ix,iy
const TAU = 8 * atn(1)
const VIEWPORT_WIDTH = 1000 '800 '1950
const VIEWPORT_HEIGHT = 800 '600 '1080
const WORLD_WIDTH = VIEWPORT_WIDTH + 100
const WORLD_HEIGHT = VIEWPORT_HEIGHT + 100
const WORLD_MINX = ( VIEWPORT_WIDTH - WORLD_WIDTH ) \ 2
const WORLD_MAXX = - WORLD_MINX + VIEWPORT_WIDTH
const WORLD_MINY = ( VIEWPORT_HEIGHT - WORLD_HEIGHT ) \ 2
const WORLD_MAXY = - WORLD_MINY + VIEWPORT_HEIGHT
const SHAPES_COUNT = 250
const TRIANGLES_IN_SHAPE_MIN = 3
const TRIANGLES_IN_SHAPE_MAX = 15
const TRIANGLE_BASE_MIN = 10
const TRIANGLE_BASE_MAX = 20 'TRIANGLE_BASE_MIN
const TRIANGLE_HEIGHT_MIN = 7 'TRIANGLE_BASE_MIN * 0.86602540378444
const TRIANGLE_HEIGHT_MAX = 13 'TRIANGLE_HEIGHT_MIN
const ATTEMPT_FPS = 60
const FULL_SCREEN = 0
randomize timer
redim segments(-1) as segment_type
redim triangles(-1) as triangle_type
redim shapes(-1) as shape_type
_title "meshes and triangles collisions"
_dest _console
? using "generate #### shapes";SHAPES_COUNT
t0# = timer(.001!)
for i% = 1 to SHAPES_COUNT
generateShape _
shapes(), triangles(), _
TRIANGLES_IN_SHAPE_MIN + (TRIANGLES_IN_SHAPE_MAX - TRIANGLES_IN_SHAPE_MIN)*rnd, _
TRIANGLE_BASE_MIN, TRIANGLE_BASE_MAX,TRIANGLE_HEIGHT_MIN, TRIANGLE_HEIGHT_MAX
shapes(i%-1).position.x = VIEWPORT_WIDTH*rnd
shapes(i%-1).position.y = VIEWPORT_HEIGHT*rnd
shapes(i%-1).direction = TAU*rnd
shapes(i%-1).velocity = 1 - 2*rnd
shapes(i%-1).orientation = 0
shapes(i%-1).rotation = 0.01 - 0.02*rnd
getBorderSegments shapes(i%-1),triangles(),segments()
computeShapeCenter shapes(i%-1), segments()
next i%
t1# = timer(.001!)
? using "create ##### triangles";ubound(triangles)
? using "done in ##.###s";(t1# - t0#)
'h& = _dest : _dest _console : ? ubound(shapes),ubound(triangles) : _dest h&
screen _newimage(VIEWPORT_WIDTH,VIEWPORT_HEIGHT,32)
if FULL_SCREEN then _fullscreen _squarepixels, _smooth
ROWS = VIEWPORT_HEIGHT/_fontheight
COLUMNS = VIEWPORT_WIDTH/_fontwidth
TRIANGLES_COUNT = shapes(ubound(shapes)).lastTriangleIndex
fps% = ATTEMPT_FPS
t# = timer(.001)
do
_limit ATTEMPT_FPS
frames% = frames% + 1
if timer(.001)>=t#+1 then
fps% = frames%
frames% = 0
t# = timer(.001)
end if
do
keycode = inp(96)
loop until keycode = 31 or keycode = 16 or keycode = 1 or keycode = 147 or keycode = 129
_dest 0
cls , &H00000000
color &HFFFFFFFF, &H00000000
' reset triangles collision indicator
for i% = lbound(triangles) to ubound(triangles)
triangles(i%).collid = 0
next i%
' shape moves
for i% = lbound(shapes) to ubound(shapes)
movingShape shapes(i%), triangles()
next i%
' test shapes collisions
trianglesCollisions% = 0
shapesCollisions% = 0
for i% = lbound(shapes) to ubound(shapes)
for j% = i%+1 to ubound(shapes)
if abs(shapes(i%).position.x - shapes(j%).position.x) > (shapes(i%).radius + shapes(j%).radius) _orelse _
abs(shapes(i%).position.y - shapes(j%).position.y) > (shapes(i%).radius + shapes(j%).radius) then
else
dc% = detectCollision(shapes(i%), shapes(j%), triangles())
if dc% then
trianglesCollisions% = trianglesCollisions% + dc%
shapesCollisions% = shapesCollisions% + 1
end if
end if
next j%
next i%
' draw shapes
for i% = lbound(shapes) to ubound(shapes)
drawShape shapes(i%), triangles(), segments()
next i%
' display text informations
locate 1,2 : ? "Q)uit - S)teps - R)esume"
locate 1,COLUMNS-66 : ? using "FPS:## - Shapes clashes:###/### - Triangles clashes:####/####";fps%;shapesCollisions%;SHAPES_COUNT;trianglesCollisions%;TRIANGLES_COUNT
_display
loop until keycode = 16 or keycode = 1
system
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' detect collision beetween two shapes
function detectCollision%(shapeA as shape_type, shapeB as shape_type, triangles() as triangle_type)
newCollisions% = 0
for i% = shapeA.firstTriangleIndex to shapeA.lastTriangleIndex
for j% = shapeB.firstTriangleIndex to shapeB.lastTriangleIndex
if triangles(j%).realMax.x < triangles(i%).realMin.x _orelse _
triangles(j%).realMin.x > triangles(i%).realMax.x _orelse _
triangles(j%).realMax.y < triangles(i%).realMin.y _orelse _
triangles(j%).realMin.y > triangles(i%).realMax.y then
else
if TrianglesCollide(triangles(j%),triangles(i%)) then
if not triangles(i%).collid then
triangles(i%).collid = -1
newCollisions% = newCollisions% + 1
end if
if not triangles(j%).collid then
triangles(j%).collid = -1
newCollisions% = newCollisions% + 1
end if
end if
end if
next j%
next i%
detectCollision% = newCollisions%
end function
' scalar product
function dotProduct#(p as point_type, q as point_type)
dotProduct# = p.x * q.x + p.y * q.y
end function
' test triangles collision
function trianglesCollide%(A as triangle_type, B as triangle_type)
dim t as integer, i as integer, j as integer
dim p1 as point_type, p2 as point_type
dim edge as point_type, axis as point_type
dim minA as double, maxA as double, minB as double, maxB as double
dim vertsA(2) as point_type, vertsB(2) as point_type
const INF = 1e+308
const EPS = 1e-9
' vertices
vertsA(0) = A.realA: vertsA(1) = A.realB: vertsA(2) = A.realC
vertsB(0) = B.realA: vertsB(1) = B.realB: vertsB(2) = B.realC
' triangles comparaison
for t = 0 to 1
for i = 0 to 2
if t = 0 then
p1 = vertsA(i)
p2 = vertsA((i + 1) mod 3)
else
p1 = vertsB(i)
p2 = vertsB((i + 1) mod 3)
end if
edge.x = p2.x - p1.x
edge.y = p2.y - p1.y
axis.x = -edge.y
axis.y = edge.x
' projection A triangle
minA = INF: maxA = -INF
for j = 0 to 2
proj = DotProduct(vertsA(j), axis)
if proj < minA then minA = proj
if proj > maxA then maxA = proj
NEXT j
' projection B triangle
minB = INF: maxB = -INF
for j = 0 to 2
proj = DotProduct(vertsB(j), axis)
if proj < minB then minB = proj
if proj > maxB then maxB = proj
next j
' no intersection beetween A and B
if maxA < minB - EPS OR maxB < minA - EPS then
trianglesCollide% = 0
exit function
end if
next i
next t
' A and B intersect
trianglesCollide% = -1
end function
' move and rotate shape
sub movingShape(shape as shape_type,triangles() as triangle_type)
shape.position.x = shape.position.x + cos(shape.direction) * shape.velocity
if shape.position.x < WORLD_MINX then
shape.position.x = shape.position.x - WORLD_MINX + WORLD_MAXX
elseif shape.position.x > WORLD_MAXX then
shape.position.x = shape.position.x + WORLD_MINX - WORLD_MAXX
end if
shape.position.y = shape.position.y - sin(shape.direction) * shape.velocity
if shape.position.y < WORLD_MINY then
shape.position.y = shape.position.y - WORLD_MINY + WORLD_MAXY
elseif shape.position.y > WORLD_MAXY then
shape.position.y = shape.position.y + WORLD_MINY - WORLD_MAXY
end if
shape.orientation = shape.orientation + shape.rotation
for i% = shape.firstTriangleIndex to shape.lastTriangleIndex
computeRealPositions triangles(i%),shape.position, shape.center, shape.orientation
next i%
end sub
' compute the screen position for a triangle base on shape position, shape center and shape orientation
sub computeRealPositions(t as triangle_type,p as point_type, axe as point_type, angle as double)
dim as point_type a, b, c, center
a.x = t.a.x + t.position.x
a.y = t.a.y + t.position.y
b.x = t.b.x + t.position.x
b.y = t.b.y + t.position.y
c.x = t.c.x + t.position.x
c.y = t.c.y + t.position.y
center.x = t.center.x + t.position.x
center.y = t.center.y + t.position.y
rotation a, axe, angle
rotation b, axe, angle
rotation c, axe, angle
rotation center, axe, angle
t.realA.x = p.x + a.x
t.realA.y = p.y + a.y
t.realB.x = p.x + b.x
t.realB.y = p.y + b.y
t.realC.x = p.x + c.x
t.realC.y = p.y + c.y
t.realCenter.x = p.x + center.x
t.realCenter.y = p.y + center.y
t.realMin.x = _min(_min(t.realA.x,t.realB.x),t.realC.x)
t.realMin.y = _min(_min(t.realA.y,t.realB.y),t.realC.y)
t.realMax.x = _max(_max(t.realA.x,t.realB.x),t.realC.x)
t.realMax.y = _max(_max(t.realA.y,t.realB.y),t.realC.y)
end sub
' compute shape center base on boundary edges (border segments)
sub computeShapeCenter(shape as shape_type, segments() as segment_type)
dim as double x, y, radius
for i% = shape.firstSegmentIndex to shape.lastSegmentIndex
x = x + segments(i%).a.x + segments(i%).b.x
y = y + segments(i%).a.y + segments(i%).b.y
next i%
d% = 2 * (shape.lastSegmentIndex - shape.firstSegmentIndex + 1)
shape.center.x = x/d%
shape.center.y = y/d%
radius = 0
for i% = shape.firstSegmentIndex to shape.lastSegmentIndex
radius = _max(radius,_hypot(segments(i%).a.x - shape.center.x, segments(i%).a.y - shape.center.y))
radius = _max(radius,_hypot(segments(i%).b.x - shape.center.x, segments(i%).b.y - shape.center.y))
next i%
shape.radius = radius
end sub
' get boundary edges (border segments) of a shape
sub getBorderSegments(shape as shape_type, triangles() as triangle_type, segments() as segment_type)
dim segmentCount%
dim shard%
dim s(1 to 3) as segment_type
' explore every triangle of the shape
for i% = shape.firstTriangleIndex to shape.lastTriangleIndex
' get the 3 segments of the triangle
s(1).a = triangles(i%).a : s(1).b = triangles(i%).b
s(2).a = triangles(i%).b : s(2).b = triangles(i%).c
s(3).a = triangles(i%).c : s(3).b = triangles(i%).a
' test segments
for j% = 1 to 3
' a common segment with another triangle is not a boundary edge of the shape
for k% = shape.firstTriangleIndex to shape.lastTriangleIndex
if k% <> i% then
shard% = isSegmentShared(s(j%), triangles(k%))
if shard% then
exit for
end if
end if
next k%
' if the segment is not shared, it is a boundary edge.
if not shard% then
redim _preserve segments(0 to ubound(segments)+1) as segment_type
segments(ubound(segments)) = s(j%)
segmentCount% = segmentCount% + 1
end if
next j%
next i%
shape.firstSegmentIndex = ubound(segments)-segmentCount%+1
shape.lastSegmentIndex = ubound(segments)
end sub
' check if a segment belongs to the triangle
function isSegmentShared%(s as segment_type, t as triangle_type)
if (isPointEqual(s.a, t.a) and isPointEqual(s.b, t.b)) or _
(isPointEqual(s.a, t.b) and isPointEqual(s.b, t.c)) or _
(isPointEqual(s.a, t.c) and isPointEqual(s.b, t.a)) or _
(isPointEqual(s.b, t.a) and isPointEqual(s.a, t.b)) or _
(isPointEqual(s.b, t.b) and isPointEqual(s.a, t.c)) or _
(isPointEqual(s.b, t.c) and isPointEqual(s.a, t.a)) then
result% = -1
else
result% = 0
end if
isSegmentShared% = result%
end function
' compare 2 points
function isPointEqual%(p1 as point_type, p2 as point_type)
const EPSILON = 0.0001
isPointEqual% = (abs(p1.x - p2.x) < EPSILON and abs(p1.y - p2.y) < EPSILON)
end function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' rotate a point around an axis
sub rotation(a as point_type,axe as point_type,angle as double)
ax0 = a.x - axe.x
ay0 = a.y - axe.y
a.x = ax0 * cos(angle) - ay0 * sin(angle) + axe.x
a.y = ax0 * sin(angle) + ay0 * cos(angle) + axe.y
end sub
' draw a shape
sub drawShape(shape as shape_type,triangles() as triangle_type,segments() as segment_type)
dim s as segment_type
for i% = shape.firstSegmentIndex to shape.lastSegmentIndex
s = segments(i%)
rotation s.a, shape.center, shape.orientation
rotation s.b, shape.center, shape.orientation
pset (s.a.x + shape.position.x, s.a.y + shape.position.y), shape.borderColor
line -(s.b.x + shape.position.x, s.b.y + shape.position.y), shape.borderColor
next i%
for i% = shape.firstTriangleIndex to shape.lastTriangleIndex
drawTriangle triangles(i%),shape.shapeColor,shape.collisionColor
next i%
end sub
' draw a triangle
sub drawTriangle(t as triangle_type,shapeColor as _unsigned long,collisionColor as _unsigned long)
c& = _iif(t.collid,collisionColor,shapeColor)
pset ( t.realA.x, t.realA.y ), c&
line -( t.realB.x, t.realB.y ), c&
line -( t.realC.x, t.realC.y ),c&
line -( t.realA.x, t.realA.y ), c&
end sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' create a new shape
sub generateShape(shapes() as shape_type, triangles() as triangle_type, nbr%, baseMin%, baseMax%, hauteurMin%, hauteurMax%)
' Allocation unique pour le shape
redim _preserve shapes(0 to ubound(shapes) + 1) as shape_type
dim shape as shape_type
dim t as triangle_type
' Générer le premier triangle
generateTriangle t, baseMin%, baseMax%, hauteurMin%, hauteurMax%
redim _preserve triangles(0 to ubound(triangles) + 1) as triangle_type
triangles(ubound(triangles)) = t
shape.firstTriangleIndex = ubound(triangles)
shape.lastTriangleIndex = ubound(triangles)
shape.pointsUsageIndicator = "000"
shape.shapeColor = _rgba32(rnd*92+127,rnd*92+127,rnd*92+127,&H70)
shape.borderColor = shape.shapeColor OR &HFF000000
shape.collisionColor = &HFFFF0000
' Variables réutilisées pour éviter les allocations répétées
dim pt1 as point_type, pt2 as point_type, pt3 as point_type, pt0 as point_type
dim a as point_type, b as point_type, c as point_type
dim bs%, p%, i%, cnt%
' Générer les autres triangles
do while nbr% > 1
bs% = chooseBorderSegment(shape, triangles())
p% = bs% mod 3
i% = bs% \ 3
a = triangles(shape.firstTriangleIndex + i%).a
b = triangles(shape.firstTriangleIndex + i%).b
c = triangles(shape.firstTriangleIndex + i%).c
if p% = 0 then
pt1 = a : pt2 = b : pt3 = c
elseif p% = 1 then
pt1 = b : pt2 = c : pt3 = a
else
pt1 = c : pt2 = a : pt3 = b
end if
cnt% = 20
do
cnt% = cnt% - 1
generateVertexOutsideTriangle pt1, pt2, pt3, hauteurMax% - rnd * (hauteurMax% - hauteurMin%), pt0
loop while isVertexInnerShape(shape, triangles(), pt0) and cnt% > 0
createTriangle t, pt1, pt2, pt0
if isTriangleValid(shape, triangles(), t) then
redim _preserve triangles(0 to ubound(triangles) + 1) as triangle_type
triangles(ubound(triangles)) = t
shape.lastTriangleIndex = ubound(triangles)
shape.pointsUsageIndicator = shape.pointsUsageIndicator + "100"
end if
nbr% = nbr% - 1
loop
shapes(ubound(shapes)) = shape
end sub
' check whether a new specific triangle can be added to the shape without covering an other triangle in the shape
function isTriangleValid%(shape as shape_type, triangles() as triangle_type, triangle as triangle_type)
dim s2(1 to 3) as segment_type
dim s1(1 to 3) as segment_type
' Prepare the triangle segments to be tested
s2(1).a = triangle.a : s2(1).b = triangle.b
s2(2).a = triangle.b : s2(2).b = triangle.c
s2(3).a = triangle.c : s2(3).b = triangle.a
for i% = shape.firstTriangleIndex to shape.lastTriangleIndex
' Prepare the segments of the existing triangle
s1(1).a = triangles(i%).a : s1(1).b = triangles(i%).b
s1(2).a = triangles(i%).b : s1(2).b = triangles(i%).c
s1(3).a = triangles(i%).c : s1(3).b = triangles(i%).a
' Checks segments intersection
for k% = 1 to 3
for l% = 1 to 3
if checkSegmentsIntersect(s1(k%), s2(l%), ix, iy) = -1 then
isTriangleValid% = 0
exit function
end if
next l%
next k%
next i%
isTriangleValid% = -1
end function
function checkSegmentsIntersect%(s1 as segment_type, s2 as segment_type, ix as double, iy as double)
const epsilon = 0.001
' tests bouding boxes
dim as double x1min, x1max, y1min, y1max, x2min, x2max, y2min, y2max
if s1.a.x < s1.b.x then x1min = s1.a.x : x1max = s1.b.x else x1min = s1.b.x : x1max = s1.a.x
if s1.a.y < s1.b.y then y1min = s1.a.y : y1max = s1.b.y else y1min = s1.b.y : y1max = s1.a.y
if s2.a.x < s2.b.x then x2min = s2.a.x : x2max = s2.b.x else x2min = s2.b.x : x2max = s2.a.x
if s2.a.y < s2.b.y then y2min = s2.a.y : y2max = s2.b.y else y2min = s2.b.y : y2max = s2.a.y
' no intersection
if x1max < x2min or x2max < x1min or y1max < y2min or y2max < y1min then
checkSegmentsIntersect% = 0
exit function
end if
' vertex testing
if (abs(s1.a.x - s2.a.x) < epsilon and abs(s1.a.y - s2.a.y) < epsilon) or _
(abs(s1.a.x - s2.b.x) < epsilon and abs(s1.a.y - s2.b.y) < epsilon) or _
(abs(s1.b.x - s2.a.x) < epsilon and abs(s1.b.y - s2.a.y) < epsilon) or _
(abs(s1.b.x - s2.b.x) < epsilon and abs(s1.b.y - s2.b.y) < epsilon) then
checkSegmentsIntersect% = -3
exit function
end if
' compute vectors
dim as double dx1, dy1, dx2, dy2
dx1 = s1.b.x - s1.a.x
dy1 = s1.b.y - s1.a.y
dx2 = s2.b.x - s2.a.x
dy2 = s2.b.y - s2.a.y
' test orientation of the segments
dim as double det
det = dx1 * dy2 - dy1 * dx2
if abs(det) < epsilon then
' parallel or collinear segments
if abs((s2.a.x - s1.a.x) * dy1 - (s2.a.y - s1.a.y) * dx1) < epsilon then
' collinear - overlap test
if (x1min <= x2max and x2min <= x1max) and (y1min <= y2max and y2min <= y1max) then
checkSegmentsIntersect% = -1
else
checkSegmentsIntersect% = 0
end if
else
checkSegmentsIntersect% = 0
end if
exit function
end if
' compute intersection parameters
dim as double t1
t1 = ((s2.a.x - s1.a.x) * dy2 - (s2.a.y - s1.a.y) * dx2) / det
dim as double t2
t2 = ((s2.a.x - s1.a.x) * dy1 - (s2.a.y - s1.a.y) * dx1) / det
' check if intersection is in the segments
if t1 >= 0 and t1 <= 1 and t2 >= 0 and t2 <= 1 then
ix = s1.a.x + t1 * dx1
iy = s1.a.y + t1 * dy1
checkSegmentsIntersect% = -1
else
checkSegmentsIntersect% = 0
end if
end function
' check if a vertex is inside the shape
function isVertexInnerShape%(shape as shape_type, triangles() as triangle_type, vertex as point_type)
for i% = shape.firstTriangleIndex to shape.lastTriangleIndex
if isVertexInnerTriangle(triangles(i%), vertex) then
isVertexInnerShape% = -1
exit function
end if
next i%
isVertexInnerShape% = 0
end function
' check if a vertex is inside the triangle
function isVertexInnerTriangle%(triangle as triangle_type, vertex as point_type)
dim v0 as point_type
dim v1 as point_type
dim v2 as point_type
dim dot00 as double, dot01 as double, dot02 as double, dot11 as double, dot12 as double
dim invdenom as double
dim u as double, v as double
' vectors
v0.x = triangle.c.x - triangle.a.x: v0.y = triangle.c.y - triangle.a.y
v1.x = triangle.b.x - triangle.a.x: v1.y = triangle.b.y - triangle.a.y
v2.x = vertex.x - triangle.a.x: v2.y = vertex.y - triangle.a.y
' scalar products
dot00 = v0.x * v0.x + v0.y * v0.y
dot01 = v0.x * v1.x + v0.y * v1.y
dot02 = v0.x * v2.x + v0.y * v2.y
dot11 = v1.x * v1.x + v1.y * v1.y
dot12 = v1.x * v2.x + v1.y * v2.y
' centroid
invdenom = dot00 * dot11 - dot01 * dot01
if abs(invdenom) < 1e-12 then
isVertexInnerTriangle% = 0 ' collinear
exit function
end if
invdenom = 1# / invdenom
u = (dot11 * dot02 - dot01 * dot12) * invdenom
v = (dot00 * dot12 - dot01 * dot02) * invdenom
' point inside only if u>=0, v>=0 and u+v<=1
if u >= 0 - 1e-12 and v >= 0 - 1e-12 and u + v <= 1 + 1e-12 then
isVertexInnerTriangle% = -1
else
isVertexInnerTriangle% = 0 ' à l'extérieur
end if
end function
' select a free border segment
function chooseBorderSegment%(shape as shape_type,triangles() as triangle_type)
l% = len(shape.pointsUsageIndicator)+1
i% = rnd*l%
do
bs% = instr(i%,shape.pointsUsageIndicator,"0")
i% = ( i% + 1 ) mod l%
loop until bs%>0
mid$(shape.pointsUsageIndicator,bs%,1)="1"
chooseBorderSegment% =bs%-1
end function
' create a vertex outside the triangle
sub generateVertexOutsideTriangle (p1 as point_type, p2 as point_type, p3 as point_type, h as double, r as point_type)
dim result as point_type
dim v as point_type ' ab vector
dim l as double
dim u as point_type ' normal unit vetor to ab
dim side as double
v.x = p2.x - p1.x
v.y = p2.y - p1.y
l = _hypot(v.x,v.y)
if l = 0 then
r.x = 0: r.y = 0
exit sub
end if
' normal vector perpendicular to ab : (-vy, vx)
u.x = -v.y / l
u.y = v.x / l
' determine which side of the line ab is c
' sign of (ac x ab) (2D vector product) : (cx-x1,cy-y1) x (vx,vy) = (cx-x1)*vy - (cy-y1)*vx
side = (p3.x - p1.x) * v.y - (p3.y - p1.y) * v.x
' if side > 0 then it is on the side where the normal vector (-vy, vx) gives a positive sign
'to place p in the half-plane opposite c, then reverse the normal if necessary.
if side <= 0 then
u.x = -u.x
u.y = -u.y
end if
' choose the midpoint of ab as the base for measuring the height
r.x = (p1.x + p2.x) / 2 + u.x * h
r.y = (p1.y + p2.y) / 2 + u.y * h
end sub
' generate a new trinagle
sub generateTriangle(t as triangle_type,baseMin%,baseMax%,hauteurMin%,hauteurMax%)
bas = baseMax% - rnd*(baseMax% - baseMin%)
angle = rnd*TAU
t.a.x = 0
t.a.y = 0
t.b.x = cos(angle)*bas
t.b.y = -sin(angle)*bas
hauteur = hauteurMax% - rnd*(hauteurMax% - hauteurMin%)
dim demibase as point_type
demibase.x = t.b.x / 2
demibase.y = t.b.y / 2
t.c.x = demibase.x + cos(angle+TAU/4)*hauteur
t.c.y = demibase.y - sin(angle+TAU/4)*hauteur
t.center.x = (t.a.x + t.b.x + t.c.x ) / 3
t.center.y = (t.a.y + t.b.y + t.c.y ) / 3
end sub
' create a triangle with 3 choosen vertex
sub createTriangle(t as triangle_type, p1 as point_type, p2 as point_type, p3 as point_type)
t.a = p1
t.b = p2
t.c = p3
t.position.x = 0
t.position.y = 0
t.angle = _atan2(t.b.y - t.a.y, t.b.x - t.a.x)
t.hauteur = abs((t.b.x-t.a.x)*(t.a.y-t.c.y) - (t.b.y - t.a.y)*(t.a.x-t.c.x)) / _hypot((t.b.x-t.a.x),(t.b.y-t.a.y))
t.demibase.x = (t.b.x - t.a.x)/2
t.demibase.y = (t.b.y - t.a.y)/2
t.center.x = (t.a.x + t.b.x + t.c.x ) / 3
t.center.y = (t.a.y + t.b.y + t.c.y ) / 3
end sub
Posts: 346
Threads: 45
Joined: Jun 2024
Reputation:
32
11-01-2025, 12:35 AM
(This post was last modified: 11-01-2025, 12:44 AM by Unseen Machine.)
An interesting approach, though most things that will ever use collision detection will be done in Bounding Boxes/Circles. So whilst as I said, its interesting...I fail to see a practical application for it...just like this one i made while back. It does polygons, triangles, squares etc....but apart from the integrated SAT function, it's only good for a demo...
Code: (Select All)
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'// Unseen Machine's Collisions Demo\\
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
RANDOMIZE TIMER
CONST SHAPE_CIRCLE = 1
CONST SHAPE_BOX = 2
CONST SHAPE_TRIANGLE = 3
CONST SHAPE_POLYGON = 4
CONST Vector_Size = 8
CONST TRUE = -1, FALSE = 0
CONST MAX_BOXES = 20
CONST MAX_CIRCLES = 40
CONST MAX_SHAPES = 40
CONST FLASH_TIME = 0.25
'///////////////////////////////////// System Initialisation ////////////////////////////////////////////////
SCREEN _NEWIMAGE(800, 600, 32)
_SCREENMOVE 0, 0
_DELAY 1
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
DIM SHARED Boxes(MAX_BOXES) AS Box
DIM SHARED Circles(MAX_CIRCLES) AS Circle
DIM SHARED Bxs, Crc, Ply
DIM SHARED Shapes(MAX_SHAPES) AS Shape
DIM SHARED GT#, LastGT#
GT# = TIMER(.001): LastGT# = GT#
InitCircles
InitBoxes
InitShapes
'Crc = TRUE
'Bxs = TRUE
'//////////////////////////////////////// Main Loop ////////////////////////////////////////////////////////////
DO
_LIMIT 60
_FPS 60
GT# = TIMER(.001)
dt = GT# - LastGT#
IF Crc THEN UpdateCircles dt
IF Bxs THEN UpdateBoxes dt
IF Crc AND Bxs THEN HandleBoxCircleCollisions dt
UpdateShapes dt
HandleAllCollisions
LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA32(0, 0, 0, 20), BF
IF Crc THEN DrawCircles
IF Bxs THEN DrawBoxes
RenderShapes
_DISPLAY
LastGT# = GT#
LOOP UNTIL INKEY$ = CHR$(27)
SYSTEM
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
TYPE Vector
X AS SINGLE
Y AS SINGLE
END TYPE
'The new Box type for a rotated rectangle, without pre-calculated corners
TYPE Box
Position AS Vector
WidthHeight AS Vector
Rotation AS SINGLE
RotationPointOffset AS Vector
Rotation_Speed AS SINGLE ' New: For rotational speed
Velocity AS Vector ' Movement vector for this box
pColor AS LONG ' Color for drawing
IsColliding AS INTEGER ' Flag to indicate collision state
FlashTimer AS SINGLE ' Timer for collision flash
Mass AS SINGLE
END TYPE
TYPE Circle
Position AS Vector ' Position vector for the circle's center
Radius AS SINGLE ' Radius of the circle
Rotation AS SINGLE ' Rotational property, kept as circles can still spin
Rotation_Speed AS SINGLE ' Rotational speed
Velocity AS Vector ' Movement vector for this circle
pColor AS LONG ' Color for drawing
IsColliding AS INTEGER ' Flag to indicate collision state
FlashTimer AS SINGLE ' Timer for collision flash
Mass AS SINGLE
END TYPE
TYPE Shape
ShapeType AS INTEGER
Position AS Vector
Rotation AS SINGLE
Rotation_Speed AS SINGLE
RotationPointOffset AS Vector
Velocity AS Vector
pColor AS LONG
Mass AS SINGLE
IsColliding AS INTEGER
FlashTimer AS SINGLE
Radius AS SINGLE
WidthHeight AS Vector
numpoints AS INTEGER
MemVertices AS _MEM
END TYPE
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Draws a box using its calculated corner vertices.
SUB DrawBox (Box AS Box, bcolor AS LONG)
DIM Corners(3) AS Vector
CALL GetBoxCorners(Box, Corners())
LINE (Corners(0).X, Corners(0).Y)-(Corners(1).X, Corners(1).Y), bcolor
LINE (Corners(1).X, Corners(1).Y)-(Corners(2).X, Corners(2).Y), bcolor
LINE (Corners(2).X, Corners(2).Y)-(Corners(3).X, Corners(3).Y), bcolor
LINE (Corners(3).X, Corners(3).Y)-(Corners(0).X, Corners(0).Y), bcolor
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Rotates a point around a pivot point by a given angle (in radians)
SUB RotatePoint (Result AS Vector, p AS Vector, pivot AS Vector, angle AS SINGLE)
DIM temp_x AS SINGLE, temp_y AS SINGLE
temp_x = p.X - pivot.X
temp_y = p.Y - pivot.Y
Result.X = temp_x * COS(angle) - temp_y * SIN(angle)
Result.Y = temp_x * SIN(angle) + temp_y * COS(angle)
Result.X = Result.X + pivot.X
Result.Y = Result.Y + pivot.Y
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Calculates the corner vertices for a given box
SUB GetBoxCorners (Box AS Box, Corners() AS Vector)
DIM HalfW AS SINGLE, HalfH AS SINGLE
DIM UnrotatedCorner AS Vector
DIM Center AS Vector
HalfW = Box.WidthHeight.X / 2
HalfH = Box.WidthHeight.Y / 2
Center = Box.Position
UnrotatedCorner.X = Center.X - HalfW
UnrotatedCorner.Y = Center.Y - HalfH
CALL RotatePoint(Corners(0), UnrotatedCorner, Center, Box.Rotation)
UnrotatedCorner.X = Center.X + HalfW
UnrotatedCorner.Y = Center.Y - HalfH
CALL RotatePoint(Corners(1), UnrotatedCorner, Center, Box.Rotation)
UnrotatedCorner.X = Center.X + HalfW
UnrotatedCorner.Y = Center.Y + HalfH
CALL RotatePoint(Corners(2), UnrotatedCorner, Center, Box.Rotation)
UnrotatedCorner.X = Center.X - HalfW
UnrotatedCorner.Y = Center.Y + HalfH
CALL RotatePoint(Corners(3), UnrotatedCorner, Center, Box.Rotation)
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Checks for overlap of projections on a given axis
FUNCTION Overlap_On_Axis (Corners1() AS Vector, Corners2() AS Vector, Axis AS Vector)
DIM Min1 AS SINGLE, Max1 AS SINGLE, Min2 AS SINGLE, Max2 AS SINGLE
DIM Projection AS SINGLE, I AS LONG
Min1 = 9999999!: Max1 = -9999999!
Min2 = 9999999!: Max2 = -9999999!
FOR I = 0 TO 3
Projection = Corners1(I).X * Axis.X + Corners1(I).Y * Axis.Y
IF Projection < Min1 THEN Min1 = Projection
IF Projection > Max1 THEN Max1 = Projection
NEXT I
FOR I = 0 TO 3
Projection = Corners2(I).X * Axis.X + Corners2(I).Y * Axis.Y
IF Projection < Min2 THEN Min2 = Projection
IF Projection > Max2 THEN Max2 = Projection
NEXT I
IF Max1 >= Min2 AND Max2 >= Min1 THEN Overlap_On_Axis = -1 ELSE Overlap_On_Axis = 0
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Checks for intersection using SAT
FUNCTION Box_Intersect (Box1 AS Box, Box2 AS Box)
DIM Box1_Corners(3) AS Vector, Box2_Corners(3) AS Vector
DIM Axis(3) AS Vector, length AS SINGLE, I AS LONG
CALL GetBoxCorners(Box1, Box1_Corners())
CALL GetBoxCorners(Box2, Box2_Corners())
Axis(0).X = -(Box1_Corners(1).Y - Box1_Corners(0).Y): Axis(0).Y = Box1_Corners(1).X - Box1_Corners(0).X
Axis(1).X = -(Box1_Corners(0).Y - Box1_Corners(3).Y): Axis(1).Y = Box1_Corners(0).X - Box1_Corners(3).X
FOR I = 0 TO 1
length = SQR(Axis(I).X * Axis(I).X + Axis(I).Y * Axis(I).Y)
IF length > 0 THEN Axis(I).X = Axis(I).X / length: Axis(I).Y = Axis(I).Y / length
IF NOT Overlap_On_Axis(Box1_Corners(), Box2_Corners(), Axis(I)) THEN Box_Intersect = 0: EXIT FUNCTION
NEXT I
Axis(2).X = -(Box2_Corners(1).Y - Box2_Corners(0).Y): Axis(2).Y = Box2_Corners(1).X - Box2_Corners(0).X
Axis(3).X = -(Box2_Corners(0).Y - Box2_Corners(3).Y): Axis(3).Y = Box2_Corners(0).X - Box2_Corners(3).X
FOR I = 2 TO 3
length = SQR(Axis(I).X * Axis(I).X + Axis(I).Y * Axis(I).Y)
IF length > 0 THEN Axis(I).X = Axis(I).X / length: Axis(I).Y = Axis(I).Y / length
IF NOT Overlap_On_Axis(Box1_Corners(), Box2_Corners(), Axis(I)) THEN Box_Intersect = 0: EXIT FUNCTION
NEXT I
Box_Intersect = -1
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION Circle_Intersect (Circle1 AS Circle, Circle2 AS Circle)
' Calculate the squared distance between the circle centers
DIM dx AS SINGLE: dx = Circle1.Position.X - Circle2.Position.X
DIM dy AS SINGLE: dy = Circle1.Position.Y - Circle2.Position.Y
DIM distance_squared AS SINGLE: distance_squared = dx * dx + dy * dy
' Calculate the sum of the radii and square it
DIM radii_sum AS SINGLE: radii_sum = Circle1.Radius + Circle2.Radius
DIM radii_sum_squared AS SINGLE: radii_sum_squared = radii_sum * radii_sum
' If the distance squared is less than or equal to the sum of radii squared, they intersect
IF distance_squared <= radii_sum_squared THEN
Circle_Intersect = -1 ' Collision
ELSE
Circle_Intersect = 0 ' No collision
END IF
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB InitCircles
DIM I AS LONG, R AS SINGLE, S AS SINGLE
FOR I = 0 TO MAX_CIRCLES - 1
R = 5 + RND * 25 ' Radius
S = 1 + RND * 10 ' Speed factor
Circles(I).Position.X = RND * _WIDTH
Circles(I).Position.Y = RND * _HEIGHT
Circles(I).Radius = R
Circles(I).Rotation_Speed = (RND - 5) * 0.3 ' Random speed and direction
Circles(I).Velocity.X = (RND * 300) + -150
Circles(I).Velocity.Y = (RND * 300) + -150
Circles(I).pColor = _RGB32(RND * 255, RND * 255, RND * 255)
Circles(I).IsColliding = FALSE
Circles(I).FlashTimer = 0
Circles(I).Mass = _PI * Circles(I).Radius * Circles(I).Radius
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB UpdateCircles (dt AS SINGLE)
DIM I AS LONG, J AS LONG
DIM Circle_Hit AS INTEGER
FOR I = 0 TO MAX_CIRCLES - 1
' Update position and rotation
Circles(I).Position.X = Circles(I).Position.X + Circles(I).Velocity.X * dt
Circles(I).Position.Y = Circles(I).Position.Y + Circles(I).Velocity.Y * dt
Circles(I).Rotation = Circles(I).Rotation + Circles(I).Rotation_Speed * dt
' Screen wrapping
IF Circles(I).Position.X + Circles(I).Radius < 0 THEN Circles(I).Position.X = _WIDTH + Circles(I).Radius
IF Circles(I).Position.X - Circles(I).Radius > _WIDTH THEN Circles(I).Position.X = 0 - Circles(I).Radius
IF Circles(I).Position.Y + Circles(I).Radius < 0 THEN Circles(I).Position.Y = _HEIGHT + Circles(I).Radius
IF Circles(I).Position.Y - Circles(I).Radius > _HEIGHT THEN Circles(I).Position.Y = 0 - Circles(I).Radius
' Check for collision with other circles
Circle_Hit = FALSE
FOR J = I + 1 TO MAX_CIRCLES - 1
IF Circle_Intersect(Circles(I), Circles(J)) THEN
Circle_Hit = TRUE
' Simple bounce logic (swapping velocities)
DIM tempX AS SINGLE, tempY AS SINGLE
tempX = Circles(I).Velocity.X: tempY = Circles(I).Velocity.Y
Circles(I).Velocity.X = Circles(J).Velocity.X: Circles(I).Velocity.Y = Circles(J).Velocity.Y
Circles(J).Velocity.X = tempX: Circles(J).Velocity.Y = tempY
Circles(J).FlashTimer = FLASH_TIME
END IF
NEXT J
' Manage flash timer
IF Circle_Hit THEN
Circles(I).FlashTimer = FLASH_TIME
ELSEIF Circles(I).FlashTimer > 0 THEN
Circles(I).FlashTimer = Circles(I).FlashTimer - dt
END IF
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB DrawCircles
DIM I AS LONG, pColor AS LONG
FOR I = 0 TO MAX_CIRCLES - 1
IF Circles(I).FlashTimer > 0 THEN
pColor = _RGB32(255, 255, 255) ' White flash color
ELSE
pColor = Circles(I).pColor
END IF
' Draw the circle using QB64's CIRCLE command
CIRCLE (Circles(I).Position.X, Circles(I).Position.Y), Circles(I).Radius, pColor
' To draw a filled circle, use PAINT after drawing the outline.
PAINT (Circles(I).Position.X, Circles(I).Position.Y), pColor, pColor
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB DrawBoxes
DIM I AS LONG
DIM pColor AS LONG
DIM Corners(3) AS Vector ' This needs to be defined
FOR I = 0 TO MAX_BOXES - 1
' Set color, flashing white if collision timer is active
IF Boxes(I).FlashTimer > 0 THEN
pColor = _RGB32(255, 255, 255) ' White flash color
ELSE
pColor = Boxes(I).pColor
END IF
' Get the world-space coordinates of the box's four corners
CALL GetBoxCorners(Boxes(I), Corners())
' Draw the box outline by connecting the corners
LINE (Corners(0).X, Corners(0).Y)-(Corners(1).X, Corners(1).Y), pColor
LINE (Corners(1).X, Corners(1).Y)-(Corners(2).X, Corners(2).Y), pColor
LINE (Corners(2).X, Corners(2).Y)-(Corners(3).X, Corners(3).Y), pColor
LINE (Corners(3).X, Corners(3).Y)-(Corners(0).X, Corners(0).Y), pColor
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION DistanceSquared (Vec1 AS Vector, Vec2 AS Vector)
DIM dx AS SINGLE: dx = Vec1.X - Vec2.X
DIM dy AS SINGLE: dy = Vec1.Y - Vec2.Y
DistanceSquared = dx * dx + dy * dy
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION BoxCircle_Intersect (Box AS Box, pCircle AS Circle)
DIM BoxCenter AS Vector
DIM LocalCirclePos AS Vector
DIM ClampedPos AS Vector
DIM dx AS SINGLE, dy AS SINGLE, distance_squared AS SINGLE
DIM HalfWidth AS SINGLE, HalfHeight AS SINGLE
' Calculate the box's true center in world space, accounting for the rotation offset
BoxCenter.X = Box.Position.X + Box.RotationPointOffset.X
BoxCenter.Y = Box.Position.Y + Box.RotationPointOffset.Y
' Create a copy of the circle's position to rotate
LocalCirclePos = pCircle.Position
' Rotate the circle's position into the box's local, axis-aligned space
CALL RotateVector(LocalCirclePos, BoxCenter, -Box.Rotation)
' Separate the declaration and initialization as required by QB64
HalfWidth = Box.WidthHeight.X / 2.0
HalfHeight = Box.WidthHeight.Y / 2.0
' Clamp the local circle's position to the axis-aligned box in local space.
ClampedPos.X = LocalCirclePos.X
IF LocalCirclePos.X < BoxCenter.X - HalfWidth THEN ClampedPos.X = BoxCenter.X - HalfWidth
IF LocalCirclePos.X > BoxCenter.X + HalfWidth THEN ClampedPos.X = BoxCenter.X + HalfWidth
ClampedPos.Y = LocalCirclePos.Y
IF LocalCirclePos.Y < BoxCenter.Y - HalfHeight THEN ClampedPos.Y = BoxCenter.Y - HalfHeight
IF LocalCirclePos.Y > BoxCenter.Y + HalfHeight THEN ClampedPos.Y = BoxCenter.Y + HalfHeight
' Calculate the squared distance between the clamped point and the rotated circle's center
dx = ClampedPos.X - LocalCirclePos.X
dy = ClampedPos.Y - LocalCirclePos.Y
distance_squared = dx * dx + dy * dy
' Compare with the squared radius
IF distance_squared <= pCircle.Radius * pCircle.Radius THEN
BoxCircle_Intersect = -1 ' Collision
ELSE
BoxCircle_Intersect = 0 ' No collision
END IF
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB InitBoxes
DIM I AS LONG, W AS SINGLE, H AS SINGLE, S AS SINGLE
FOR I = 0 TO MAX_BOXES - 1
' Randomize box dimensions
W = 10 + RND * 50
H = 10 + RND * 50
' Randomize box position within the screen boundaries
Boxes(I).Position.X = RND * _WIDTH
Boxes(I).Position.Y = RND * _HEIGHT
Boxes(I).WidthHeight.X = W
Boxes(I).WidthHeight.Y = H
Boxes(I).Mass = Boxes(I).WidthHeight.X * Boxes(I).WidthHeight.Y
' Randomize initial rotation and rotation speed
Boxes(I).Rotation = RND * 2 * _PI
Boxes(I).Rotation_Speed = (RND * .3) - .15 ' Rotational speed can be positive or negative
' Set the rotation point to the center of the box
Boxes(I).RotationPointOffset.X = W / 2: Boxes(I).RotationPointOffset.Y = H / 2
' Randomize velocity with a scaling factor
S = 10 + RND * 5
Boxes(I).Velocity.X = (RND * 30) + -15 ' RND * 2 - 1 gives a range from -1 to 1
Boxes(I).Velocity.Y = (RND * 30) + -15
' Randomize a color
Boxes(I).pColor = _RGB32(RND * 255, RND * 255, RND * 255)
' Reset collision and flash timer state
Boxes(I).IsColliding = FALSE
Boxes(I).FlashTimer = 0
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB RotateVector (PointToRotate AS Vector, Center AS Vector, Angle AS SINGLE)
DIM Translated AS Vector
DIM Rotated AS Vector
' Translate point so center of rotation is at the origin
Translated.X = PointToRotate.X - Center.X
Translated.Y = PointToRotate.Y - Center.Y
' Apply the rotation
Rotated.X = Translated.X * COS(Angle) - Translated.Y * SIN(Angle)
Rotated.Y = Translated.X * SIN(Angle) + Translated.Y * COS(Angle)
' Translate back and update the original vector
PointToRotate.X = Rotated.X + Center.X
PointToRotate.Y = Rotated.Y + Center.Y
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB UpdateBoxes (dt AS SINGLE)
DIM I AS LONG, J AS LONG
DIM Box_Hit AS INTEGER
DIM tempX AS SINGLE, tempY AS SINGLE
DIM minX AS SINGLE, maxX AS SINGLE, minY AS SINGLE, maxY AS SINGLE
DIM Corners(3) AS Vector ' This needs to be defined
FOR I = 0 TO MAX_BOXES - 1
' Update position and rotation
Boxes(I).Position.X = Boxes(I).Position.X + Boxes(I).Velocity.X * dt
Boxes(I).Position.Y = Boxes(I).Position.Y + Boxes(I).Velocity.Y * dt
Boxes(I).Rotation = Boxes(I).Rotation + Boxes(I).Rotation_Speed * dt
' --- Screen wrapping logic ---
' Calculate the AABB (Axis-Aligned Bounding Box) of the rotated box to find its min/max extents
CALL GetBoxCorners(Boxes(I), Corners()) ' Assuming GetBoxCorners fills the Corners array
minX = Corners(0).X: maxX = Corners(0).X
minY = Corners(0).Y: maxY = Corners(0).Y
FOR k = 1 TO 3
IF Corners(k).X < minX THEN minX = Corners(k).X
IF Corners(k).X > maxX THEN maxX = Corners(k).X
IF Corners(k).Y < minY THEN minY = Corners(k).Y
IF Corners(k).Y > maxY THEN maxY = Corners(k).Y
NEXT k
' Apply wrapping based on the AABB
IF maxX < 0 THEN Boxes(I).Position.X = _WIDTH + (Boxes(I).Position.X - minX)
IF minX > _WIDTH THEN Boxes(I).Position.X = 0 - (maxX - Boxes(I).Position.X)
IF maxY < 0 THEN Boxes(I).Position.Y = _HEIGHT + (Boxes(I).Position.Y - minY)
IF minY > _HEIGHT THEN Boxes(I).Position.Y = 0 - (maxY - Boxes(I).Position.Y)
' --- Collision handling ---
Box_Hit = FALSE
FOR J = I + 1 TO MAX_BOXES - 1
IF Box_Intersect(Boxes(I), Boxes(J)) THEN
Box_Hit = TRUE
' Simple bounce logic
tempX = Boxes(I).Velocity.X: tempY = Boxes(I).Velocity.Y
Boxes(I).Velocity.X = Boxes(J).Velocity.X: Boxes(I).Velocity.Y = Boxes(J).Velocity.Y
Boxes(J).Velocity.X = tempX: Boxes(J).Velocity.Y = tempY
Boxes(J).FlashTimer = FLASH_TIME
END IF
NEXT J
' Manage flash timer for box
IF Box_Hit THEN
Boxes(I).FlashTimer = FLASH_TIME
ELSEIF Boxes(I).FlashTimer > 0 THEN
Boxes(I).FlashTimer = Boxes(I).FlashTimer - dt
END IF
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB HandleBoxCircleCollisions (dt AS SINGLE)
DIM I AS LONG, J AS LONG, Vector(0, 0) AS Vector
DIM BoxCenter AS Vector
DIM LocalCirclePos AS Vector
DIM HalfWidth AS SINGLE, HalfHeight AS SINGLE
DIM ClampedPos AS Vector
DIM Normal AS Vector
DIM Length AS SINGLE
DIM Penetration AS SINGLE
DIM MassInverseSum AS SINGLE
DIM PosCorrection AS SINGLE
DIM RelVel AS Vector
DIM VelAlongNormal AS SINGLE
DIM Restitution AS SINGLE
DIM ImpulseScalar AS SINGLE
DIM MinSeparation AS SINGLE
' Constants for the physics simulation
Restitution = 0.9
MinSeparation = 0.01
FOR I = 0 TO MAX_CIRCLES - 1
FOR J = 0 TO MAX_BOXES - 1
IF BoxCircle_Intersect(Boxes(J), Circles(I)) THEN
Circles(I).FlashTimer = FLASH_TIME
Boxes(J).FlashTimer = FLASH_TIME
' === Collision Resolution ===
' Calculate the box's true center in world space
BoxCenter.X = Boxes(J).Position.X + Boxes(J).RotationPointOffset.X
BoxCenter.Y = Boxes(J).Position.Y + Boxes(J).RotationPointOffset.Y
' Get local space circle position
LocalCirclePos = Circles(I).Position
CALL RotateVector(LocalCirclePos, BoxCenter, -Boxes(J).Rotation)
' Get box dimensions
HalfWidth = Boxes(J).WidthHeight.X / 2.0
HalfHeight = Boxes(J).WidthHeight.Y / 2.0
' Clamp the local circle's position to the axis-aligned box
ClampedPos.X = LocalCirclePos.X
IF LocalCirclePos.X < BoxCenter.X - HalfWidth THEN ClampedPos.X = BoxCenter.X - HalfWidth
IF LocalCirclePos.X > BoxCenter.X + HalfWidth THEN ClampedPos.X = BoxCenter.X + HalfWidth
ClampedPos.Y = LocalCirclePos.Y
IF LocalCirclePos.Y < BoxCenter.Y - HalfHeight THEN ClampedPos.Y = BoxCenter.Y - HalfHeight
IF LocalCirclePos.Y > BoxCenter.Y + HalfHeight THEN ClampedPos.Y = BoxCenter.Y + HalfHeight
' Calculate the normal vector and penetration depth
Normal.X = LocalCirclePos.X - ClampedPos.X
Normal.Y = LocalCirclePos.Y - ClampedPos.Y
Length = SQR(Normal.X * Normal.X + Normal.Y * Normal.Y)
Penetration = Circles(I).Radius - Length
IF Penetration > 0 THEN
IF Length > 0 THEN
' Normalize the normal vector
Normal.X = Normal.X / Length
Normal.Y = Normal.Y / Length
ELSE
' This case occurs if the circle's center is exactly on the box's center.
' Choose a random normal to prevent a division by zero.
Normal.X = 1: Normal.Y = 0
END IF
' Rotate the normal back into world space
CALL RotateVector(Normal, Vector(0, 0), Boxes(J).Rotation)
' === Positional Correction ===
MassInverseSum = 1 / Circles(I).Mass + 1 / Boxes(J).Mass
IF MassInverseSum > 0 THEN
PosCorrection = _MAX(Penetration - MinSeparation, 0) / MassInverseSum
Circles(I).Position.X = Circles(I).Position.X + Normal.X * PosCorrection / Circles(I).Mass
Circles(I).Position.Y = Circles(I).Position.Y + Normal.Y * PosCorrection / Circles(I).Mass
Boxes(J).Position.X = Boxes(J).Position.X - Normal.X * PosCorrection / Boxes(J).Mass
Boxes(J).Position.Y = Boxes(J).Position.Y - Normal.Y * PosCorrection / Boxes(J).Mass
END IF
' === Velocity Impulse ===
RelVel.X = Circles(I).Velocity.X - Boxes(J).Velocity.X
RelVel.Y = Circles(I).Velocity.Y - Boxes(J).Velocity.Y
VelAlongNormal = RelVel.X * Normal.X + RelVel.Y * Normal.Y
IF VelAlongNormal < 0 THEN
IF MassInverseSum > 0 THEN
ImpulseScalar = -(1 + Restitution) * VelAlongNormal / MassInverseSum
Circles(I).Velocity.X = Circles(I).Velocity.X + ImpulseScalar * Normal.X / Circles(I).Mass
Circles(I).Velocity.Y = Circles(I).Velocity.Y + ImpulseScalar * Normal.Y / Circles(I).Mass
Boxes(J).Velocity.X = Boxes(J).Velocity.X - ImpulseScalar * Normal.X / Boxes(J).Mass
Boxes(J).Velocity.Y = Boxes(J).Velocity.Y - ImpulseScalar * Normal.Y / Boxes(J).Mass
END IF
END IF
END IF
END IF
NEXT J
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_NewPolygon (Shape AS Shape, Position AS Vector, Vertices() AS Vector, numpoints AS INTEGER, Mass AS SINGLE)
DIM I AS INTEGER
Shape.ShapeType = SHAPE_POLYGON
Shape.Position = Position
Shape.Mass = Mass
' Allocate and copy vertices using the MEM-based helper functions
CALL Shape_NewPolygon_Mem(Shape, numpoints)
FOR I = 0 TO numpoints - 1
CALL Shape_SetVertex(Shape, I, Vertices(I))
NEXT I
' Set the rotation point to the average center of the vertices
' You may need a more sophisticated method for complex shapes
DIM Center AS Vector
Center.X = 0: Center.Y = 0
FOR I = 0 TO numpoints - 1
Center.X = Center.X + Vertices(I).X
Center.Y = Center.Y + Vertices(I).Y
NEXT I
Shape.RotationPointOffset.X = Center.X / numpoints
Shape.RotationPointOffset.Y = Center.Y / numpoints
' Initialize other properties
Shape.Velocity.X = 0: Shape.Velocity.Y = 0
Shape.Rotation = 0
Shape.Rotation_Speed = 0
Shape.pColor = _RGB32(255, 255, 255)
Shape.IsColliding = 0
Shape.FlashTimer = 0
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Helper for the memory allocation part, using a different name to avoid confusion
SUB Shape_NewPolygon_Mem (Shape AS Shape, numpoints AS INTEGER)
Shape.MemVertices = _MEMNEW(numpoints * Vector_Size)
Shape.numpoints = numpoints
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_SetVertex (Shape AS Shape, index AS INTEGER, Vertex AS Vector)
_MEMPUT Shape.MemVertices, Shape.MemVertices.OFFSET + (index * Vector_Size), Vertex
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_GetVertex (Shape AS Shape, index AS INTEGER, Result AS Vector)
' Set the result UDT to default values
Result.X = 0
Result.Y = 0
IF index >= 0 AND index < Shape.numpoints THEN
_MEMGET Shape.MemVertices, Shape.MemVertices.OFFSET + (index * Vector_Size), Result
END IF
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_Free (Shape AS Shape)
IF _MEMEXISTS(Shape.MemVertices) THEN
_MEMFREE Shape.MemVertices
END IF
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_NewCircle (Shape AS Shape, Position AS Vector, Radius AS SINGLE, Mass AS SINGLE)
Shape.ShapeType = SHAPE_CIRCLE
Shape.Position = Position
Shape.Radius = Radius
Shape.Mass = Mass
' Initialize other properties
Shape.Velocity.X = 0: Shape.Velocity.Y = 0
Shape.Rotation = 0
Shape.Rotation_Speed = 0
Shape.RotationPointOffset.X = 0: Shape.RotationPointOffset.Y = 0
Shape.pColor = _RGB32(255, 255, 255)
Shape.IsColliding = 0
Shape.FlashTimer = 0
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_NewBox (Shape AS Shape, Position AS Vector, WidthHeight AS Vector, Mass AS SINGLE)
Shape.ShapeType = SHAPE_BOX
Shape.Position = Position
Shape.WidthHeight = WidthHeight
Shape.Mass = Mass
' Set the rotation point to the center of the box for convenience
Shape.RotationPointOffset.X = WidthHeight.X / 2: Shape.RotationPointOffset.Y = WidthHeight.Y / 2
' Initialize other properties
Shape.Velocity.X = 0: Shape.Velocity.Y = 0
Shape.Rotation = 0
Shape.Rotation_Speed = 0
Shape.pColor = _RGB32(255, 255, 255)
Shape.IsColliding = 0
Shape.FlashTimer = 0
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_Handle_Collisions (Shape1 AS Shape, Shape2 AS Shape)
DIM CollisionDetected AS INTEGER
DIM tempX AS SINGLE, tempY AS SINGLE
CollisionDetected = 0
SELECT CASE Shape1.ShapeType
CASE SHAPE_CIRCLE
SELECT CASE Shape2.ShapeType
CASE SHAPE_CIRCLE
IF Intersect_CircleCircle(Shape1, Shape2) THEN CollisionDetected = -1
CASE SHAPE_BOX
IF Intersect_CircleBox(Shape1, Shape2) THEN CollisionDetected = -1
CASE SHAPE_TRIANGLE, SHAPE_POLYGON
IF Intersect_CirclePolygon(Shape1, Shape2) THEN CollisionDetected = -1
END SELECT
CASE SHAPE_BOX
SELECT CASE Shape2.ShapeType
CASE SHAPE_CIRCLE
IF Intersect_CircleBox(Shape2, Shape1) THEN CollisionDetected = -1
CASE SHAPE_BOX
IF Intersect_PolygonPolygon(Shape1, Shape2) THEN CollisionDetected = -1
CASE SHAPE_TRIANGLE, SHAPE_POLYGON
IF Intersect_PolygonPolygon(Shape1, Shape2) THEN CollisionDetected = -1
END SELECT
CASE SHAPE_TRIANGLE, SHAPE_POLYGON
SELECT CASE Shape2.ShapeType
CASE SHAPE_CIRCLE
IF Intersect_CirclePolygon(Shape2, Shape1) THEN CollisionDetected = -1
CASE SHAPE_BOX
IF Intersect_PolygonPolygon(Shape1, Shape2) THEN CollisionDetected = -1
CASE SHAPE_TRIANGLE, SHAPE_POLYGON
IF Intersect_PolygonPolygon(Shape1, Shape2) THEN CollisionDetected = -1
END SELECT
END SELECT
IF CollisionDetected THEN
' Flash to indicate collision
Shape1.FlashTimer = FLASH_TIME
Shape2.FlashTimer = FLASH_TIME
' === HACKY SIMPLE BOUNCE LOGIC ===
' This swaps velocity vectors, which produces a bouncy but not perfectly accurate result.
tempX = Shape1.Velocity.X: tempY = Shape1.Velocity.Y
Shape1.Velocity.X = Shape2.Velocity.X: Shape1.Velocity.Y = Shape2.Velocity.Y
Shape2.Velocity.X = tempX: Shape2.Velocity.Y = tempY
END IF
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB HandleAllCollisions
DIM I AS INTEGER, J AS INTEGER
FOR I = 0 TO MAX_SHAPES - 1
FOR J = I + 1 TO MAX_SHAPES - 1
CALL Shape_Handle_Collisions(Shapes(I), Shapes(J))
NEXT J
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION Intersect_CircleCircle (Shape1 AS Shape, Shape2 AS Shape)
DIM dx AS SINGLE, dy AS SINGLE, distance_squared AS SINGLE
dx = Shape1.Position.X - Shape2.Position.X
dy = Shape1.Position.Y - Shape2.Position.Y
distance_squared = dx * dx + dy * dy
DIM radii_sum AS SINGLE
radii_sum = Shape1.Radius + Shape2.Radius
IF distance_squared <= radii_sum * radii_sum THEN
Intersect_CircleCircle = -1
ELSE
Intersect_CircleCircle = 0
END IF
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION Intersect_CirclePolygon (Circ AS Shape, Polygon AS Shape)
' Logic adapted from previous box-circle collision, but generalized for polygons.
DIM PolyCenter AS Vector, LocalCirclePos AS Vector, ClampedPos AS Vector
DIM Normal AS Vector, Length AS SINGLE, Penetration AS SINGLE
DIM I AS INTEGER, EdgeStart AS Vector, EdgeEnd AS Vector, ClampedPointOnEdge AS Vector
PolyCenter.X = Polygon.Position.X + Polygon.RotationPointOffset.X
PolyCenter.Y = Polygon.Position.Y + Polygon.RotationPointOffset.Y
LocalCirclePos = Circ.Position
CALL RotateVector(LocalCirclePos, PolyCenter, -Polygon.Rotation)
' Loop through each edge of the polygon to find the closest point
DIM MinDistanceSq AS SINGLE: MinDistanceSq = -1 ' Use a negative number as an initial flag
FOR I = 0 TO Polygon.numpoints - 1
CALL Shape_GetVertex(Polygon, I, EdgeStart)
CALL Shape_GetVertex(Polygon, (I + 1) MOD Polygon.numpoints, EdgeEnd)
ClosestPointOnLineSegment EdgeStart, EdgeEnd, LocalCirclePos, ClampedPointOnEdge
distSq = DistanceSquared(ClampedPointOnEdge, LocalCirclePos)
IF MinDistanceSq < 0 OR distSq < MinDistanceSq THEN
MinDistanceSq = distSq
ClampedPos = ClampedPointOnEdge
END IF
NEXT I
IF MinDistanceSq < 0 THEN
Intersect_CirclePolygon = 0: EXIT FUNCTION
END IF
DIM dx AS SINGLE, dy AS SINGLE
dx = ClampedPos.X - LocalCirclePos.X
dy = ClampedPos.Y - LocalCirclePos.Y
distance_squared = dx * dx + dy * dy
IF distance_squared <= Circle.Radius * Circle.Radius THEN
Intersect_CirclePolygon = -1
ELSE
Intersect_CirclePolygon = 0
END IF
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION Intersect_CircleBox (Shape1 AS Shape, Shape2 AS Shape)
' Ensure correct shape types for this function
IF Shape1.ShapeType <> SHAPE_CIRCLE OR Shape2.ShapeType <> SHAPE_BOX THEN
Intersect_CircleBox = 0
EXIT FUNCTION
END IF
DIM BoxCenter AS Vector
DIM LocalCirclePos AS Vector
DIM ClampedPos AS Vector
DIM dx AS SINGLE, dy AS SINGLE, distance_squared AS SINGLE
DIM HalfWidth AS SINGLE, HalfHeight AS SINGLE
' Calculate the box's true center in world space, accounting for the rotation offset
BoxCenter.X = Shape2.Position.X + Shape2.RotationPointOffset.X
BoxCenter.Y = Shape2.Position.Y + Shape2.RotationPointOffset.Y
' Create a copy of the circle's position to rotate
LocalCirclePos = Shape1.Position
' Rotate the circle's position into the box's local, axis-aligned space
CALL RotateVector(LocalCirclePos, BoxCenter, -Shape2.Rotation)
' Separate the declaration and initialization as required by QB64
HalfWidth = Shape2.WidthHeight.X / 2.0
HalfHeight = Shape2.WidthHeight.Y / 2.0
' Clamp the local circle's position to the axis-aligned box in local space.
ClampedPos.X = LocalCirclePos.X
IF LocalCirclePos.X < BoxCenter.X - HalfWidth THEN ClampedPos.X = BoxCenter.X - HalfWidth
IF LocalCirclePos.X > BoxCenter.X + HalfWidth THEN ClampedPos.X = BoxCenter.X + HalfWidth
ClampedPos.Y = LocalCirclePos.Y
IF LocalCirclePos.Y < BoxCenter.Y - HalfHeight THEN ClampedPos.Y = BoxCenter.Y - HalfHeight
IF LocalCirclePos.Y > BoxCenter.Y + HalfHeight THEN ClampedPos.Y = BoxCenter.Y + HalfHeight
' Calculate the squared distance between the clamped point and the rotated circle's center
dx = ClampedPos.X - LocalCirclePos.X
dy = ClampedPos.Y - LocalCirclePos.Y
distance_squared = dx * dx + dy * dy
' Compare with the squared radius
IF distance_squared <= Shape1.Radius * Shape1.Radius THEN
Intersect_CircleBox = -1 ' Collision
ELSE
Intersect_CircleBox = 0 ' No collision
END IF
END FUNCTION
SUB ClosestPointOnLineSegment (StartPoint AS Vector, EndPoint AS Vector, TestPoint AS Vector, ResultPoint AS Vector)
DIM Vector_AB AS Vector
DIM Vector_AC AS Vector
DIM ScalarProjection AS SINGLE
DIM LengthSq AS SINGLE
DIM T AS SINGLE
' Vector from start point (A) to end point (B)
Vector_AB.X = EndPoint.X - StartPoint.X
Vector_AB.Y = EndPoint.Y - StartPoint.Y
' Vector from start point (A) to test point (C)
Vector_AC.X = TestPoint.X - StartPoint.X
Vector_AC.Y = TestPoint.Y - StartPoint.Y
' Calculate the scalar projection of Vector_AC onto Vector_AB
ScalarProjection = Vector_AC.X * Vector_AB.X + Vector_AC.Y * Vector_AB.Y
' Calculate the squared length of Vector_AB
LengthSq = Vector_AB.X * Vector_AB.X + Vector_AB.Y * Vector_AB.Y
' Calculate the parameter 't' for the closest point on the infinite line
IF LengthSq > 0 THEN
T = ScalarProjection / LengthSq
ELSE
' The segment has zero length (StartPoint equals EndPoint), so the closest point is StartPoint
T = 0
END IF
' Clamp 't' to the range [0, 1] to ensure the closest point is on the line segment
IF T < 0 THEN
T = 0
ELSEIF T > 1 THEN
T = 1
END IF
' Calculate the final result point on the line segment
ResultPoint.X = StartPoint.X + T * Vector_AB.X
ResultPoint.Y = StartPoint.Y + T * Vector_AB.Y
END SUB
SUB InitShapes
DIM I AS INTEGER, shapeType AS INTEGER
DIM Post AS Vector, Wh AS Vector
DIM Vertices(10) AS Vector ' Temp array for polygon vertices
RANDOMIZE TIMER ' Seed the random number generator
FOR I = 0 TO MAX_SHAPES - 1
shapeType = INT(RND * 4) + 1 ' Randomly pick a shape type
shapeType = SHAPE_POLYGON '//temp
Post.X = RND * _WIDTH
Post.Y = RND * _HEIGHT
SELECT CASE shapeType
CASE SHAPE_CIRCLE
CALL Shape_NewCircle(Shapes(I), Post, 5 + RND * 20, 10 + RND * 40)
Shapes(I).Velocity.X = (RND * 2 - 1) * 50
Shapes(I).Velocity.Y = (RND * 2 - 1) * 50
CASE SHAPE_BOX
Wh.X = 10 + RND * 40
Wh.Y = 10 + RND * 40
CALL Shape_NewBox(Shapes(I), Post, Wh, 10 + RND * 40)
Shapes(I).Rotation = RND * 2 * _PI
Shapes(I).Rotation_Speed = (RND * 2 - 1) * 0.5
Shapes(I).Velocity.X = (RND * 2 - 1) * 50
Shapes(I).Velocity.Y = (RND * 2 - 1) * 50
CASE SHAPE_TRIANGLE
Vertices(0).X = -15: Vertices(0).Y = -15
Vertices(1).X = 15: Vertices(1).Y = -15
Vertices(2).X = 0: Vertices(2).Y = 15
CALL Shape_NewPolygon(Shapes(I), Post, Vertices(), 3, 10 + RND * 20)
Shapes(I).Rotation = RND * 2 * _PI
Shapes(I).Rotation_Speed = (RND * 2 - 1) * 0.5
Shapes(I).Velocity.X = (RND * 2 - 1) * 50
Shapes(I).Velocity.Y = (RND * 2 - 1) * 50
CASE SHAPE_POLYGON
DIM sides AS INTEGER: sides = INT(RND * 6) + 3 ' 5 to 8 sides
DIM angleStep AS SINGLE: angleStep = 2 * _PI / sides
DIM radius AS SINGLE: radius = 15 + RND * 15
FOR J = 0 TO sides - 1
Vertices(J).X = COS(J * angleStep) * radius
Vertices(J).Y = SIN(J * angleStep) * radius
NEXT J
CALL Shape_NewPolygon(Shapes(I), Post, Vertices(), sides, 10 + RND * 40)
Shapes(I).Rotation = RND * 2 * _PI
Shapes(I).Rotation_Speed = (RND * 2 - 1) * 0.5
Shapes(I).Velocity.X = (RND * 2 - 1) * 50
Shapes(I).Velocity.Y = (RND * 2 - 1) * 50
END SELECT
Shapes(I).pColor = _RGB32(RND * 255, RND * 255, RND * 255)
NEXT I
END SUB
SUB UpdateShapes (dt AS SINGLE)
DIM I AS INTEGER
DIM RotatedCorner AS Vector
DIM minX AS SINGLE, maxX AS SINGLE, minY AS SINGLE, maxY AS SINGLE
DIM Corner AS Vector
FOR I = 0 TO MAX_SHAPES - 1
' Update position and rotation
Shapes(I).Position.X = Shapes(I).Position.X + Shapes(I).Velocity.X * dt
Shapes(I).Position.Y = Shapes(I).Position.Y + Shapes(I).Velocity.Y * dt
Shapes(I).Rotation = Shapes(I).Rotation + Shapes(I).Rotation_Speed * dt
' Screen wrapping based on shape type
SELECT CASE Shapes(I).ShapeType
CASE SHAPE_CIRCLE
IF Shapes(I).Position.X + Shapes(I).Radius < 0 THEN Shapes(I).Position.X = _WIDTH + Shapes(I).Radius
IF Shapes(I).Position.X - Shapes(I).Radius > _WIDTH THEN Shapes(I).Position.X = 0 - Shapes(I).Radius
IF Shapes(I).Position.Y + Shapes(I).Radius < 0 THEN Shapes(I).Position.Y = _HEIGHT + Shapes(I).Radius
IF Shapes(I).Position.Y - Shapes(I).Radius > _HEIGHT THEN Shapes(I).Position.Y = 0 - Shapes(I).Radius
CASE SHAPE_BOX
' Simplified wrapping for box
DIM halfW AS SINGLE: halfW = Shapes(I).WidthHeight.X / 2
DIM halfH AS SINGLE: halfH = Shapes(I).WidthHeight.Y / 2
IF Shapes(I).Position.X + halfW < 0 THEN Shapes(I).Position.X = _WIDTH + halfW
IF Shapes(I).Position.X - halfW > _WIDTH THEN Shapes(I).Position.X = 0 - halfW
IF Shapes(I).Position.Y + halfH < 0 THEN Shapes(I).Position.Y = _HEIGHT + halfH
IF Shapes(I).Position.Y - halfH > _HEIGHT THEN Shapes(I).Position.Y = 0 - halfH
CASE ELSE ' Polygons
minX = 1000000!: maxX = -1000000!
minY = 1000000!: maxY = -1000000!
FOR J = 0 TO Shapes(I).numpoints - 1
CALL Shape_GetVertex(Shapes(I), J, Corner)
Corner.X = Shapes(I).Position.X + Corner.X
Corner.Y = Shapes(I).Position.Y + Corner.Y
IF Corner.X < minX THEN minX = Corner.X
IF Corner.X > maxX THEN maxX = Corner.X
IF Corner.Y < minY THEN minY = Corner.Y
IF Corner.Y > maxY THEN maxY = Corner.Y
NEXT J
IF maxX < 0 THEN Shapes(I).Position.X = _WIDTH + (Shapes(I).Position.X - minX)
IF minX > _WIDTH THEN Shapes(I).Position.X = 0 - (maxX - Shapes(I).Position.X)
IF maxY < 0 THEN Shapes(I).Position.Y = _HEIGHT + (Shapes(I).Position.Y - minY)
IF minY > _HEIGHT THEN Shapes(I).Position.Y = 0 - (maxY - Shapes(I).Position.Y)
END SELECT
' Manage flash timer
IF Shapes(I).FlashTimer > 0 THEN
Shapes(I).FlashTimer = Shapes(I).FlashTimer - dt
END IF
NEXT I
END SUB
SUB RenderShapes
DIM I AS INTEGER, J AS INTEGER
DIM pColor AS LONG
DIM prevX AS SINGLE, prevY AS SINGLE
DIM CurrentVertex AS Vector, RotatedVertex AS Vector, Vector(0, 0) AS Vector
DIM ShapeCenter AS Vector
FOR I = 0 TO MAX_SHAPES - 1
IF Shapes(I).FlashTimer > 0 THEN
pColor = _RGB32(255, 255, 255) ' White flash color
ELSE
pColor = Shapes(I).pColor
END IF
SELECT CASE Shapes(I).ShapeType
CASE SHAPE_CIRCLE
CIRCLE (Shapes(I).Position.X, Shapes(I).Position.Y), Shapes(I).Radius, pColor
CASE SHAPE_BOX
' Calculate corners and draw lines
ShapeCenter.X = Shapes(I).Position.X + Shapes(I).RotationPointOffset.X
ShapeCenter.Y = Shapes(I).Position.Y + Shapes(I).RotationPointOffset.Y
DIM HalfW AS SINGLE: HalfW = Shapes(I).WidthHeight.X / 2
DIM HalfH AS SINGLE: HalfH = Shapes(I).WidthHeight.Y / 2
REDIM Corners(3) AS Vector
Corners(0).X = ShapeCenter.X - HalfW: Corners(0).Y = ShapeCenter.Y - HalfH
Corners(1).X = ShapeCenter.X + HalfW: Corners(1).Y = ShapeCenter.Y - HalfH
Corners(2).X = ShapeCenter.X + HalfW: Corners(2).Y = ShapeCenter.Y + HalfH
Corners(3).X = ShapeCenter.X - HalfW: Corners(3).Y = ShapeCenter.Y + HalfH
FOR J = 0 TO 3
CALL RotateVector(Corners(J), ShapeCenter, Shapes(I).Rotation)
NEXT J
FOR J = 0 TO 3
LINE (Corners(J).X, Corners(J).Y)-(Corners((J + 1) MOD 4).X, Corners((J + 1) MOD 4).Y), pColor
NEXT J
CASE SHAPE_TRIANGLE, SHAPE_POLYGON
IF Shapes(I).numpoints > 0 THEN
ShapeCenter.X = Shapes(I).Position.X + Shapes(I).RotationPointOffset.X
ShapeCenter.Y = Shapes(I).Position.Y + Shapes(I).RotationPointOffset.Y
CALL Shape_GetVertex(Shapes(I), 0, CurrentVertex)
RotatedVertex = CurrentVertex
CALL RotateVector(RotatedVertex, Vector(0, 0), Shapes(I).Rotation)
prevX = RotatedVertex.X + Shapes(I).Position.X
prevY = RotatedVertex.Y + Shapes(I).Position.Y
FOR J = 1 TO Shapes(I).numpoints - 1
CALL Shape_GetVertex(Shapes(I), J, CurrentVertex)
RotatedVertex = CurrentVertex
CALL RotateVector(RotatedVertex, Vector(0, 0), Shapes(I).Rotation)
LINE (prevX, prevY)-(RotatedVertex.X + Shapes(I).Position.X, RotatedVertex.Y + Shapes(I).Position.Y), pColor
prevX = RotatedVertex.X + Shapes(I).Position.X
prevY = RotatedVertex.Y + Shapes(I).Position.Y
NEXT J
' Connect the last vertex to the first
CALL Shape_GetVertex(Shapes(I), 0, CurrentVertex)
RotatedVertex = CurrentVertex
CALL RotateVector(RotatedVertex, Vector(0, 0), Shapes(I).Rotation)
LINE (prevX, prevY)-(RotatedVertex.X + Shapes(I).Position.X, RotatedVertex.Y + Shapes(I).Position.Y), pColor
END IF
END SELECT
NEXT I
END SUB
FUNCTION Intersect_PolygonPolygon (Polygon1 AS Shape, Polygon2 AS Shape)
DIM I AS INTEGER, J AS INTEGER
DIM Vertex1 AS Vector, Vertex2 AS Vector, EdgeNormal AS Vector, Vector(0, 0) AS Vector
DIM Min1 AS SINGLE, Max1 AS SINGLE, Min2 AS SINGLE, Max2 AS SINGLE
DIM Edge AS Vector
' Project onto axes of Polygon1
FOR I = 0 TO Polygon1.numpoints - 1
' Get edge vector
CALL Shape_GetVertex(Polygon1, I, Vertex1)
CALL Shape_GetVertex(Polygon1, (I + 1) MOD Polygon1.numpoints, Vertex2)
Edge.X = Vertex2.X - Vertex1.X
Edge.Y = Vertex2.Y - Vertex1.Y
' Get normal to the edge
EdgeNormal.X = -Edge.Y
EdgeNormal.Y = Edge.X
length = SQR(EdgeNormal.X * EdgeNormal.X + EdgeNormal.Y * EdgeNormal.Y)
IF length > 0 THEN
EdgeNormal.X = EdgeNormal.X / length
EdgeNormal.Y = EdgeNormal.Y / length
END IF
' Rotate normal to world space
CALL RotateVector(EdgeNormal, Vector(0, 0), Polygon1.Rotation)
' Project polygons onto this axis
CALL ProjectPolygon(Polygon1, EdgeNormal, Min1, Max1)
CALL ProjectPolygon(Polygon2, EdgeNormal, Min2, Max2)
' Check for overlap
IF NOT Overlap(Min1, Max1, Min2, Max2) THEN
Intersect_PolygonPolygon = 0
EXIT FUNCTION
END IF
NEXT I
' Project onto axes of Polygon2
FOR I = 0 TO Polygon2.numpoints - 1
' Get edge vector
CALL Shape_GetVertex(Polygon2, I, Vertex1)
CALL Shape_GetVertex(Polygon2, (I + 1) MOD Polygon2.numpoints, Vertex2)
Edge.X = Vertex2.X - Vertex1.X
Edge.Y = Vertex2.Y - Vertex1.Y
' Get normal to the edge
EdgeNormal.X = -Edge.Y
EdgeNormal.Y = Edge.X
length = SQR(EdgeNormal.X * EdgeNormal.X + EdgeNormal.Y * EdgeNormal.Y)
IF length > 0 THEN
EdgeNormal.X = EdgeNormal.X / length
EdgeNormal.Y = EdgeNormal.Y / length
END IF
' Rotate normal to world space
CALL RotateVector(EdgeNormal, Vector(0, 0), Polygon2.Rotation)
' Project polygons onto this axis
CALL ProjectPolygon(Polygon1, EdgeNormal, Min1, Max1)
CALL ProjectPolygon(Polygon2, EdgeNormal, Min2, Max2)
' Check for overlap
IF NOT Overlap(Min1, Max1, Min2, Max2) THEN
Intersect_PolygonPolygon = 0
EXIT FUNCTION
END IF
NEXT I
' If no separating axis found, there is a collision
Intersect_PolygonPolygon = -1
END FUNCTION
' Helper sub to project a polygon onto an axis
SUB ProjectPolygon (Shape AS Shape, Axis AS Vector, Min AS SINGLE, Max AS SINGLE)
DIM I AS INTEGER
DIM Vertex AS Vector, Vector(0, 0) AS Vector
DIM RotatedVertex AS Vector
DIM Projection AS SINGLE
' Rotate first vertex to world space
CALL Shape_GetVertex(Shape, 0, Vertex)
RotatedVertex = Vertex
CALL RotateVector(RotatedVertex, Vector(0, 0), Shape.Rotation)
RotatedVertex.X = RotatedVertex.X + Shape.Position.X
RotatedVertex.Y = RotatedVertex.Y + Shape.Position.Y
' Project first vertex onto axis
Projection = RotatedVertex.X * Axis.X + RotatedVertex.Y * Axis.Y
Min = Projection
Max = Projection
' Loop through remaining vertices
FOR I = 1 TO Shape.numpoints - 1
CALL Shape_GetVertex(Shape, I, Vertex)
RotatedVertex = Vertex
CALL RotateVector(RotatedVertex, Vector(0, 0), Shape.Rotation)
RotatedVertex.X = RotatedVertex.X + Shape.Position.X
RotatedVertex.Y = RotatedVertex.Y + Shape.Position.Y
' Project vertex onto axis
Projection = RotatedVertex.X * Axis.X + RotatedVertex.Y * Axis.Y
' Update min and max projections
IF Projection < Min THEN Min = Projection
IF Projection > Max THEN Max = Projection
NEXT I
END SUB
' Helper function to check if two intervals overlap
FUNCTION Overlap (Min1 AS SINGLE, Max1 AS SINGLE, Min2 AS SINGLE, Max2 AS SINGLE)
IF Min1 <= Max2 AND Min2 <= Max1 THEN
Overlap = -1
ELSE
Overlap = 0
END IF
END FUNCTION
What WE (the community) is lacking currently is, FAST pixel perfect sprites collisions and ANY 3d bounding box/sphere collisions...give me one of them and i'll give you +2!
Unseen
(Dont take this as a cuss please, I love things like this!)
Posts: 41
Threads: 8
Joined: Jul 2025
Reputation:
7
11-01-2025, 01:10 AM
(11-01-2025, 12:35 AM)Unseen Machine Wrote: (Dont take this as a cuss please, I love things like this!) No problem, as long as I rack my brains, I'm fine with it.
Posts: 346
Threads: 45
Joined: Jun 2024
Reputation:
32
(11-01-2025, 01:10 AM)Herve Wrote: (11-01-2025, 12:35 AM)Unseen Machine Wrote: (Dont take this as a cuss please, I love things like this!) No problem, as long as I rack my brains, I'm fine with it. Then you've found a good home here bro! Brain aches are part and parcel of us QB folks!
And to be fair, it deserves a +1 anyway!
Love it
John
|
