确定两条线段p1p2、p3p4是否相交

[复制链接]
发表于 2023-12-30 09:47:59 | 显示全部楼层 |阅读模式
确定两条线段p1p2、p3p4是否相交
程序如下:
program xdxj;
type p=record
     x, y:real
end;
var p1,p2,p3,p4:p;
function m(p1,p2,p0:p):real;
begin
m:=(p1.x-p0.x)*(p2.y-p0.y)-(p2.x-p0.x)*(p1.y-p0.y);
end;
function max(a,b:real):real;
begin
if a>b then max:=a else max:=b;
end;
function min(a,b:real):real;
begin
if a<b then min:=a else min:=b;
end;
function across(p1,p2,p3,p4:p):boolean;
begin
if (max(p1.x,p2.x)>=min(p3.x,p4.x)) and
    (max(p3.x,p4.x)>=min(p1.x,p2.x)) and
    (max(p1.y,p2.y)>=min(p3.y,p4.y)) and
    (max(p3.y, p4.y)>=min(p1.y,p2.y)) and
    (m(p2,p3,p1)*m(p2,p4,p1)<0) and(m(p4,p1,p3)*m(p4,p2,p3)<0)
   then across:=true else across:=false;
end;
begin
readln(p1.x,p1.y,p2.x,p2.y);
readln(p3.x,p3.y,p4.x,p4.y);
if across(p1,p2,p3,p4) then writeln('yes') else writeln('no');
end.

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

快速回复 返回顶部 返回列表