unit Collision2D;
{
original code from https://jeffreythompson.org/collision-detection/
}
{$mode ObjFPC}{$H+}
{$modeswitch AdvancedRecords}
interface
uses Types;
type
ArrayOfTPointF = array of TPointF;
// For rectangular shape, use TRectF if you don't rotate your objects.
// For rotated object, use instead Polygon.
TCollisionFunctions = record
function PointCircle(const aPt, aCenter: TPointF; const aRadius: single): boolean;
function PointRectF(const aPt: TPointF; const aR: TRectF): boolean;
function CircleCircle(const aCenter1: TPointF; const aRadius1: single;
const aCenter2: TPointF; const aRadius2: single): boolean;
function CircleRectF(const aCenter: TPointF; const aRadius: single; const r: TRectF): boolean;
function RectFRectF(const r1, r2: TRectF): boolean;
function LinePoint(aLinePt1, aLinePt2, aPt: TPointF): boolean;
function LineLine(aLine1Pt1, aLine1Pt2, aLine2Pt1, aLine2Pt2: TPointF): boolean;
function LineCircle(aLinePt1, aLinePt2, aCircleCenter: TPointF; aRadius: single): boolean;
function LineRectF(aLinePt1, aLinePt2: TPointF; aRect: TRectF): boolean;
function RectFContainLine(const r: TRectF; aLinePt1, aLinePt2: TPointF): boolean;
function CircleContainRectF(const aCenter: TPointF; const aRadius: single; const r: TRectF): boolean;
function PolygonPoint(const aPts: ArrayOfTPointF; const aPt: TPointF): boolean;
function PolygonLine(const aPts: ArrayOfTPointF; const aLinePt1, aLinePt2: TPointF): boolean;
function PolygonCircle(const aPts: ArrayOfTPointF; const aCenter: TPointF; const aRadius: single): boolean;
function PolygonRectF(const aPts: ArrayOfTPointF; r: TRectF): boolean;
function PolygonPolygon(const aPts1, aPts2: ArrayOfTPointF): boolean;
end;
// all functions are grouped into a record because Lazarus IDE
// show them when we enter 'Collision.'
// -> its easier to select the needed one without going to this unit every time.
var
Collision: TCollisionFunctions;
function PointF(aX, aY: single): TPointF;
function Distance(aPt1, aPt2: TPointF): single;
function DistanceSqr(aPt1, aPt2: TPointF): single;
implementation
function PointF(aX, aY: single): TPointF;
begin
Result.x := aX;
Result.y := aY;
end;
function Distance(aPt1, aPt2: TPointF): single;
begin
Result := sqrt(sqr(aPt2.x-aPt1.x) + sqr(aPt2.y-aPt1.y));
end;
function DistanceSqr(aPt1, aPt2: TPointF): single;
begin
Result := sqr(aPt2.x-aPt1.x) + sqr(aPt2.y-aPt1.y);
end;
function TCollisionFunctions.PointCircle(const aPt, aCenter: TPointF; const aRadius: single): boolean;
begin
Result := DistanceSqr(aPt, aCenter) < Sqr(aRadius);
end;
function TCollisionFunctions.PointRectF(const aPt: TPointF; const aR: TRectF): boolean;
begin
Result := (aPt.x >= aR.Left) and (aPt.x < aR.Right) and
(aPt.y >= aR.Top) and (aPt.y < aR.Bottom);
end;
function TCollisionFunctions.CircleCircle(const aCenter1: TPointF;
const aRadius1: single; const aCenter2: TPointF; const aRadius2: single): boolean;
begin
Result := DistanceSqr(aCenter1, aCenter2) < Sqr(aRadius1 + aRadius2);
end;
function TCollisionFunctions.CircleRectF(const aCenter: TPointF;
const aRadius: single; const r: TRectF): boolean;
var closestX, closestY: single;
begin
closestX := aCenter.x;
if closestX <= r.Left then closestX := r.Left
else if closestX > r.Right then closestX := r.Right;
closestY := aCenter.y;
if closestY < r.Top then closestY := r.Top
else if closestY > r.Bottom then closestY := r.Bottom;
Result := DistanceSqr(PointF(closestX, closestY), aCenter) < Sqr(aRadius);
end;
function TCollisionFunctions.RectFRectF(const r1, r2: TRectF): boolean;
begin
Result := (r1.Right >= r2.Left) and ( r1.Left <= r2.Right) and
(r1.Bottom >= r2.Top) and (r1.Top <= r2.Bottom);
end;
function TCollisionFunctions.LinePoint(aLinePt1, aLinePt2, aPt: TPointF): boolean;
var d1, d2, lineLen, buffer: single;
begin
// get distance from the point to the two ends of the line
d1 := Distance(aPt, aLinePt1);
d2 := Distance(aPt, aLinePt2);
// get the length of the line
lineLen := Distance(aLinePt1, aLinePt2);
// since floats are so minutely accurate, add
// a little buffer zone that will give collision
buffer := 0.1; // higher # = less accurate
// if the two distances are equal to the line's length, the point is on the line!
// note we use the buffer here to give a range, rather than one #
Result := (d1+d2 >= lineLen-buffer) and (d1+d2 <= lineLen+buffer);
end;
function TCollisionFunctions.LineLine(aLine1Pt1, aLine1Pt2, aLine2Pt1, aLine2Pt2: TPointF): boolean;
var uA, uB, x4_x3, y1_y3, y4_y3, x1_x3, x2_x1, y2_y1: single;
begin
x4_x3 := aLine2Pt2.x - aLine2Pt1.x;
y1_y3 := aLine1Pt1.y - aLine2Pt1.y;
y4_y3 := aLine2Pt2.y - aLine2Pt1.y;
x1_x3 := aLine1Pt1.x - aLine2Pt1.x;
x2_x1 := aLine1Pt2.x - aLine1Pt1.x;
y2_y1 := aLine1Pt2.y - aLine1Pt1.y;
// calculate the distance to intersection point
uA := (x4_x3 * y1_y3 - y4_y3 * x1_x3) / (y4_y3 * x2_x1 - x4_x3 * y2_y1);
uB := (x2_x1 * y1_y3 - y2_y1 * x1_x3) / (y4_y3 * x2_x1 - x4_x3 * y2_y1);
// if uA and uB are between 0-1, lines are colliding
Result := (uA >= 0) and (uA <= 1) and (uB >= 0) and (uB <= 1);
end;
// from https://github.com/jeffThompson/CollisionDetection
function TCollisionFunctions.LineCircle(aLinePt1, aLinePt2, aCircleCenter: TPointF; aRadius: single): boolean;
var distX, distY, len, dot, closestX, closestY: single;
begin
// is either end INSIDE the circle? if so, return true immediately
if Collision.PointCircle(aLinePt1, aCircleCenter, aRadius) or
Collision.PointCircle(aLinePt2, aCircleCenter, aRadius) then exit(True);
// get length of the line
distX := aLinePt1.x - aLinePt2.x;
distY := aLinePt1.y - aLinePt2.y;
len := sqrt((distX*distX) + (distY*distY));
// get dot product of the line and circle
dot := (((aCircleCenter.x-aLinePt1.x)*(aLinePt2.x-aLinePt1.x)) +
((aCircleCenter.y-aLinePt1.y)*(aLinePt2.y-aLinePt1.y))) / (len*len);
// find the closest point on the line
closestX := aLinePt1.x + (dot * (aLinePt2.x-aLinePt1.x));
closestY := aLinePt1.y + (dot * (aLinePt2.y-aLinePt1.y));
// is this point actually on the line segment? if so keep going, but if not, return false
if not Collision.LinePoint(aLinePt1, aLinePt2, PointF(closestX,closestY)) then exit(False);
// get distance to closest point
distX := closestX - aCircleCenter.x;
distY := closestY - aCircleCenter.y;
Result := (distX*distX) + (distY*distY) <= Sqr(aRadius);
end;
function TCollisionFunctions.LineRectF(aLinePt1, aLinePt2: TPointF; aRect: TRectF): boolean;
begin
// check if the rect contain the line
if PointRectF(aLinePt1, aRect) then exit(True);
// check if the line has hit any of the rectangle's sides
// uses the Line/Line function
Result := Collision.LineLine(aLinePt1, aLinePt2, aRect.TopLeft, PointF(aRect.Left, aRect.Bottom)) or
Collision.LineLine(aLinePt1, aLinePt2, PointF(aRect.Right, aRect.Top), aRect.BottomRight) or
Collision.LineLine(aLinePt1, aLinePt2, aRect.TopLeft, PointF(aRect.Right, aRect.Top)) or
Collision.LineLine(aLinePt1, aLinePt2, PointF(aRect.Left, aRect.Bottom), aRect.BottomRight);
end;
function TCollisionFunctions.RectFContainLine(const r: TRectF; aLinePt1, aLinePt2: TPointF): boolean;
begin
Result := PointRectF(aLinePt1, r) and PointRectF(aLinePt2, r);
end;
function TCollisionFunctions.CircleContainRectF(const aCenter: TPointF;
const aRadius: single; const r: TRectF): boolean;
begin
Result := PointCircle(r.TopLeft, aCenter, aRadius) and
PointCircle(PointF(r.Right, r.Top), aCenter, aRadius) and
PointCircle(r.BottomRight, aCenter, aRadius) and
PointCircle(PointF(r.Left, r.Bottom), aCenter, aRadius);
end;
function TCollisionFunctions.PolygonPoint(const aPts: ArrayOfTPointF; const aPt: TPointF): boolean;
var next, current: integer;
vc, vn: TPointF;
begin
Result := False;
if Length(aPts) = 0 then exit;
for current :=0 to High(aPts) do begin
next := current + 1;
if next = Length(aPts) then next := 0;
vc := aPts[current];
vn := aPts[next];
if ((vc.y > aPt.y) <> (vn.y > aPt.y)) and (aPt.x < (vn.x-vc.x) * (aPt.y-vc.y) / (vn.y-vc.y) + vc.x)
then Result := not Result;
end;
end;
function TCollisionFunctions.PolygonLine(const aPts: ArrayOfTPointF;
const aLinePt1, aLinePt2: TPointF): boolean;
var current: integer;
begin
if Length(aPts) = 0 then exit(False);
current := 0;
while current < High(aPts)-1 do begin
if LineLine(aPts[current], aPts[current+1], aLinePt1, aLinePt2) then exit(True);
inc(current, 2);
end;
// optional: check if line is inside the polygon
Result := PolygonPoint(aPts, aLinePt1);
end;
function TCollisionFunctions.PolygonCircle(const aPts: ArrayOfTPointF;
const aCenter: TPointF; const aRadius: single): boolean;
var current: integer;
begin
if Length(aPts) = 0 then exit(False);
current := 0;
while current < High(aPts)-1 do begin
if LineCircle(aPts[current], aPts[current+1], aCenter, aRadius) then exit(True);
inc(current, 2);
end;
// optional:
if PolygonPoint(aPts, aCenter) then exit(True); // check if the circle is inside the polygon
Result := PointCircle(aPts[0], aCenter, aRadius); // check if the polygon is inside the circle
end;
function TCollisionFunctions.PolygonRectF(const aPts: ArrayOfTPointF; r: TRectF): boolean;
var current: integer;
begin
if Length(aPts) = 0 then exit(False);
current := 0;
while current < High(aPts)-1 do begin
if LineRectF(aPts[current], aPts[current+1], r) then exit(True);
inc(current, 2);
end;
// optional:
if PolygonPoint(aPts, r.TopLeft) then exit(True); // check if the rectangle is inside the polygon
Result := PointRectF(aPts[0], r); // check if the polygon is inside the rectangle
end;
function TCollisionFunctions.PolygonPolygon(const aPts1, aPts2: ArrayOfTPointF): boolean;
var current: integer;
begin
if (Length(aPts1) = 0) or (Length(aPts2) = 0) then exit(False);
current := 0;
while current < High(aPts1)-1 do begin
if PolygonLine(aPts2, aPts1[current], aPts1[current+1]) then exit(True);
inc(current, 2);
end;
// optional:
if PolygonPoint(aPts1, aPts2[0]) then exit(True); // check if the polygon2 is inside polygon1
Result := PolygonPoint(aPts2, aPts1[0]); // check if the polygon1 is inside polygon2
end;
end.
Recent
