1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Даны 2 треугольника, заданные координатами своих вершин, нужно определить находится ли кокой либо из них полностью внутри другого. Алгоритм построен на следующем утверждении: Если в треугольнике есть такая вершина, что прямая проведенная через нее и заданную точку не пересекает сторону треугольника, противоположную этой вершине, то заданная точка находится вне треугольника.
tline = record p1, p2: tpoint; k, b : tfloat; end;
ttriangle = record top: array [1..3] of tpoint; end;
{ функция вернет true, если координаты точе p1 и p2 совпадают } function points_equal(const p1, p2: tpoint): boolean; begin points_equal := (abs(p1.x - p2.x) < eps) and (abs(p1.y - p2.y) < eps) end;
{ получаем уравнение вида y = k*x+b для прямой по двум точкам, случаи если прямая параллельна одной из осей, в программе рассматриваются отдельно } procedure get_line_equation(var line: tline; const point1, point2: tpoint); begin with line do begin
if not((p1.x = p2.x) or (p1.y = p2.y)) then begin k := (p2.y - p1.y) / (p2.x - p1.x); b := -p1.x * ((p2.y - p1.y) / (p2.x - p1.x)) + p1.y; end else begin k := 0; b := 0; end;
end; end;
{ значение функции заданной прямой line в точке x } function get_equation_value(const line: tline; const x: tfloat): tfloat; begin get_equation_value := line.k * x + line.b; end;
{ функция вернет true, если значение value находится между значений A и B } function value_between(const value: tfloat; const a, b: tfloat): boolean; begin value_between := ((value >= a) and (value <= b)) or ((value >= b) and (value <= a)); end;
{ функция вернет true, если точка point принадлежит прямой line (не отрезку) } function in_line(const point: tpoint; const line: tline): boolean; begin with line do begin if (p1.x = p2.x) then in_line := point.x = p1.x else if (p1.y = p2.y) then in_line := point.y = p1.y else in_line := abs(point.y - get_equation_value(line, point.x)) < eps; end; end;
{ функция вернет true, если точка point принадлежит отрезку прямой line крайние точки отрезка line1.p1 и line2.p2 } function in_piece_line(const point: tpoint; const line: tline): boolean; var belongs: boolean;
begin belongs := in_line(point, line);
if belongs then with line do begin if abs(p1.x - p2.x) < eps then belongs := belongs and value_between(point.y, p1.y, p2.y) else belongs := value_between(point.x, p1.x, p2.x) end;
in_piece_line := belongs; end;
{ если у прямых line1 и line2 есть точка пересечения, то функция вернет true и cross_point будет содержать ее координаты } function get_crossing_point(const line1, line2: tline; var cross_point: tpoint): boolean; begin if ((abs(line1.p1.x - line1.p2.x) < eps) and (abs(line2.p1.x - line2.p2.x) < eps)) or((abs(line1.p1.y - line1.p2.y) < eps) and (abs(line2.p1.y - line2.p2.y) < eps)) then get_crossing_point := false else begin
{ функция вернет true, если точка point находится в треугольнике triangle } function point_in_triangle(const point: tpoint; const triangle: ttriangle): boolean; var test_line, check_side: tline; cross_point: tpoint;
i, j: integer; _include: boolean; begin i := 1; _include := false;
while (i <= 2) and not(_include) do begin j := i + 1;
case i of 1: get_line_equation(check_side, triangle.top[2], triangle.top[3]); 2: get_line_equation(check_side, triangle.top[1], triangle.top[3]); 3: get_line_equation(check_side, triangle.top[1], triangle.top[2]); end;
_include := get_crossing_point(test_line, check_side, cross_point) and (in_piece_line(cross_point, check_side));
inc(i); end; end;
point_in_triangle := _include; end;
{ функция вернет true, если треугольник t_1 находится в треугольнике t_2 } function triangle_in_triangle(const t_1, t_2: ttriangle): boolean; var i: byte; begin i := 1; while (i <= 3) and point_in_triangle(t_1.top[i], t_2) do inc(i); triangle_in_triangle := (i > 3); end;
var cross_point: tpoint; t: array [1..2] of ttriangle;
i, j: byte;
begin clrscr;
for i := 1 to 2 do with t[i] do begin writeln('Enter coords of ', i, ' triangle: '); writeln; for j := 1 to 3 do begin write('top(', j, ').x = '); readln(top[j].x); write('top(', j, ').y = '); readln(top[j].y); writeln; end; end;
if triangle_in_triangle(t[1], t[2]) then writeln('1 in 2') else if (triangle_in_triangle(t[2], t[1])) then writeln('2 in 1') else writeln('none');
readln; end.
--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
{ функция вернет true, если точка point принадлежит отрезку прямой line, координаты крайних точек отрезка соотверствую координатам точек, по которым была построена прямая line: line.p1 и line.p2 } function in_piece_line(const point: tpoint; const line: tline): boolean; var belongs: boolean;
begin belongs := in_line(point, line);
if belongs then with line do begin if abs(p1.x - p2.x) < eps then belongs := belongs and value_between(point.y, p1.y, p2.y) else belongs := belongs and value_between(point.x, p1.x, p2.x) end; end;
Функция ничего не возвращает, обрати внимание - нет идентификатора, определяющего имя функции... Аккуратнее с этим...