Тупой колижн

{$mode objfpc}

uses
  rwSystem, rwMath;

// плоскость по точке и нормали
// нормализована, если normal.length = 1
function PlanePN(const point: tVec3; const normal: tVec3): tPlane;
begin
  // нормаль (A, B, C)
  // точка (x0, y0, z0)
  // тогда A(x - x0) + B(y - y0) + C(z - z0) = 0
  result.a := normal.x;
  result.b := normal.y;
  result.c := normal.z;
  result.d := -(result.a * point.x + result.b * point.y + result.c * point.z);
end;

// площадь треугольника по 3 точкам
function TriSq(const pt1, pt2, pt3: tVec3): float;
begin
  result := 0.5 * ((pt2 - pt1) >< (pt3 - pt1)).Length;
end;

// проецирует точку p на линию, заданную точкой и _направляющим_ вектором
function ProjOnLine(const p: tVec3; const lineP, lineN: tVec3): tVec3;
var
  k: float;
begin
  k := Dot(lineN, p - lineP);
  result := k * lineN + lineP;
end;

// pl должна быть нормализована, или будет верен знак, но не расстояние!!
function SignedDistance(const pl: tPlane; const pt: tVec3): float;
begin
  result := pl.a * pt.x + pl.b * pt.y + pl.c * pt.z + pl.d;
end;

// проецирует точку на плоскость
function ProjectPointOnPlane(const p: tVec3; const plane: tPlane): tVec3;
var
  k: float;
begin
  k := SignedDistance(plane, p);
  result := p - plane.v3 * k;
end;

// to-do: optimize
function CollideSphereToTriangle(
  const center: tVec3; radius: float;
  const p1, p2, p3: tVec3; out ofs: tVec3): boolean;
var
  plane: tPlane; // плоскость треугольника
  square: float; // площадь треугольника
  v1, v2, v3: tVec3; // единичные векторы сторон треугольника
  normal: tVec3; // нормаль к треугольнику
  len1, len2, len3: float; // длины соотв. сторон

  dist: float; // какое-нибудь расстояние
  proj: tVec3; // проекция center на плоскость треугольника
begin
  // подготовка
  // это стоит посчитать лишь однажды, при инициализации треугольника
  v1 := p2 - p1;
  v2 := p3 - p2;
  v3 := p1 - p3;
  normal := v1 >< v2;
  square := 0.5 * normal.Length; // normal - векторное произведение же!
  len1 := v1.Length;
  len2 := v2.Length;
  len3 := v3.Length;
  v1.Normalize;
  v2.Normalize;
  v3.Normalize;
  normal.Normalize;
  plane := PlanePN(p1, normal);

  // сфера слишком далеко от плоскости треугольника?
  dist := SignedDistance(plane, center);
  if abs(dist) > radius then exit(false);

  // центр сферы проецируется внутрь треугольника?
  // если да - она может сталкиваться только с плоскостью
  proj := ProjectPointOnPlane(center, plane);
  if Equals(square, TriSq(p1, p2, proj) + TriSq(p2, p3, proj) + TriSq(p3, p1, proj)) then
  begin
    //if dist > 0 then
    ofs := normal * (radius - dist){
    else
    ofs := -normal * (radius + dist)};
    exit(true);
  end;

  // проецируем на каждую сторону. Проецируется - значит, может сталкиваться
  // с ней.
  proj := ProjOnLine(center, p1, v1);
  dist := Distance(center, proj);
  if (dist < radius) and (Equals(len1, Distance(p1, proj) + Distance(proj, p2))) then
  begin
    ofs := (center - proj) * (1.0 - dist / radius);
    exit(true);
  end;

  proj := ProjOnLine(center, p2, v2);
  dist := Distance(center, proj);
  if (dist < radius) and (Equals(len2, Distance(p2, proj) + Distance(proj, p3))) then
  begin
    ofs := (center - proj) * (1.0 - dist / radius);
    exit(true);
  end;

  proj := ProjOnLine(center, p3, v3);
  dist := SqrDistance(center, proj);
  if (dist < radius) and (Equals(len3, Distance(p3, proj) + Distance(proj, p1))) then
  begin
    ofs := (center - proj) * (1.0 - dist / radius);
    exit(true);
  end;

  // наконец, сталкиваем с вершинами
  // это всё можно опустить, но тогда можно будет, если ОЧЕНЬ постараться,
  // проходить сквозь подобные стыки ОЧЕНЬ БОЛЬШИХ полигонов.
  // Кажется, я обычно опускал. :3
  dist := Distance(center, p1);
  if Dist < radius then
  begin
    ofs := (center - p1) * (1.0 - dist / radius);
    exit(true);
  end;
  dist := Distance(center, p2);
  if dist < radius then
  begin
    ofs := (center - p2) * (1.0 - dist / radius);
    exit(true);
  end;
  dist := Distance(center, p3);
  if dist < radius then
  begin
    ofs := (center - p3) * (1.0 - dist / radius);
    exit(true);
  end;

  // ничего не сталкивается лол
  result := false;
end;

begin
end.