program line_intersections;
uses
math,graph,wincrt;
Type Point=object
x,y:single;
End;
Type _Line=object
s,f:point;
procedure Draw();
End;
type aol=array of _Line;
procedure _Line.draw();
begin
line(trunc(s.x),trunc(s.y),trunc(f.x),trunc(f.y));
end;
Function isleft(L:_Line;p:point):integer;
begin
exit (-sign((L.s.x-L.f.x)*(p.y-L.f.y)-(p.x-L.f.x)*(L.s.y-L.f.y)));
End;
Function intersects(L1:_Line;L2:_Line):boolean;
begin
If (isleft(L2,L1.s) = isleft(L2,L1.f)) Then exit (false);
If (isleft(L1,L2.s) = isleft(L1,L2.f)) Then exit (false);
exit(true);
End;
function intersections(l1:_Line;l2:_Line;var _out:point):boolean;
var
p1,p2,p3,p4:point;
x12,x34,y12,y34:single;
c:single;
a,b,x,y:single;
begin
p1:=l1.s;p2:=l1.f;p3:=l2.s;p4:=l2.f;
x12:=p1.x-p2.x;x34:=p3.x-p4.x;y12:=p1.y-p2.y;y34:=p3.y-p4.y;
c:=x12 * y34 - y12 * x34;
if (abs(c) < 0.01) then exit(false);
a := p1.x * p2.y - p1.y * p2.x;
b := p3.x * p4.y - p3.y * p4.x;
x := (a * x34 - b * x12) / c;
y := (a * y34 - b * y12) / c;
_out.x:=x;
_out.y:=y;
exit(true)
end;
procedure setup(var k:aol;var s:point);
var
i:integer;
begin
setlength(k,3);
for i:=0 to 2 do
begin
k[i].s.x:=random(800);
k[i].s.y:=random(600);
k[i].f.x:=random(800);
k[i].f.y:=random(600);
s.x:=random(800);s.y:=random(600);
end;
end;
var
k:aol;
gd, gm: SmallInt;
i:integer;
ch:char;
m:_Line;
xpos,ypos:string;
start,p:point;
begin
setup(k,start);
m.s.x:=random(800);
m.s.y:=random(600);
{========== set up graph =========}
gd := D8bit;
gm := m800x600;
InitGraph(gd, gm, '');
if GraphResult <> grok then halt;
setbkcolor(white);
settextstyle(BoldFont,HorizDir,1);
repeat
cleardevice;
setcolor(red);
outtextxy(10,0,'Line intersection demo');
outtextxy(10,20,'Use the arrow keys');
outtextxy(10,40,'Space key to refresh -- esc key to end.');
setcolor(blue);
for i:=0 to 2 do k[i].draw;
m.f.x:=start.x;m.f.y:=start.y;
setcolor(red);
m.draw;
fillellipse(trunc(m.s.x),trunc(m.s.y),5,5) ;
for i :=0 to 2 do
begin
if ((intersections(m,k[i],p)) and (intersects(k[i],m))) then
begin
str(trunc(p.x),xpos);
str(trunc(p.y),ypos);
fillellipse(trunc(p.x),trunc(p.y),2,2) ;
setcolor(green);
outtextxy(trunc(p.x),trunc(p.y),xpos+','+ypos);
end;
end;
ch:=readkey;
if ch='P' then m.s.y:=m.s.y+10;
if ch='H' then m.s.y:=m.s.y-10;
if ch='M' then m.s.x:=m.s.x+10;
if ch='K' then m.s.x:=m.s.x-10;
if ch=' ' then setup(k,start);
until (ord(ch)=27);
closegraph;
end.