My program got WA. Please help me.
Послано
Timur 19 апр 2002 10:20
{Written by Luguev Timur}
{$n+}
const
max=32767;
eps=1e-14;
var
input,out:text;
n,i,j:byte;
c:array[1..100,1..4] of integer;
res:array[1..100] of extended;
xp,yp:integer;
procedure load;
begin
readln(input,n);
for i:=1 to n do
begin
read(input,c[i,1]);
read(input,c[i,2]);
read(input,c[i,3]);
readln(input,c[i,4]);
end;
read(input,xp);
read(input,yp);
end;
function dbetp(x1,y1,x2,y2:extended):extended;
begin
dbetp:=sqrt(sqr(x2-x1)+sqr(y2-y1));
end;
{-------------------------------------------------------}
function finddistance(x1,y1,x3,y3:integer):extended;
var
x2,y2,x4,y4,x,y:extended;
k12,k23,k34,k41,k,c12,c23,c34,c41:extended;
d:extended;
procedure findcoord(k,c,x1,y1:extended;var x,y:extended);
var c1:extended;
begin
c1:=y1+x1/k;
x:=(k*(c1-c))/(sqr(k)-1);
y:=(sqr(k)*(c1-c))/(sqr(k)-1)+c;
end;
procedure findk;
begin
k:=(y3-y1)/(x3-x1);
k12:=(1+k)/(1-k);
k34:=k12;
k23:=(k-1)/(1+k);
k41:=k23;
c12:=y1-k12*x1;
c23:=y3-k23*x3;
c34:=y3-k34*x3;
c41:=y1-k41*x1;
end;
procedure findxy;
begin
if x1=x3 then
begin
if y3>y1 then
begin
x2:=x1-abs(x2-x3);
x4:=x1+abs(x2-x3);
y2:=(y3-y1)/2;
y4:=y2;
end
else
begin
x2:=x1+abs(x2-x3);
x4:=x1-abs(x2-x3);
y2:=(y1-y3)/2;
y4:=y2;
end;
exit;
end;
if y1=y3 then
begin
if x3>x1 then
begin
x2:=(x1+x3)/2;
x4:=x2;
y2:=(x3-x1)/2+y1;
y4:=y1-(x3-x1)/2;
end
else
begin
x2:=(x1+x3)/2;
x4:=x2;
y4:=(x1-x3)/2+y1;
y2:=y1-(x1-x3)/2;
end;
exit;
end;
findk;
findcoord(k23,c23,x1,y1,x2,y2);
findcoord(k34,c34,x1,y1,x4,y4);
end;
procedure exception;
var
a,b,c,l:extended;
begin
if (x3>x1) and (y3<y1) then
begin
a:=x1;
c:=x3;
b:=y1;
l:=y3;
end;
if (x3<x1) and (y3>y1) then
begin
a:=x3;
c:=x1;
b:=y3;
l:=y1;
end;
if (x3>x1) and (y3>y1) then
begin
a:=x1;
b:=y3;
c:=x3;
l:=y1;
end;
if (x3<x1) and (y3<y1) then
begin
a:=x3;
b:=y1;
c:=x1;
l:=y3
end;
if (xp>=a) and (xp<=c) and (yp<=b) and (yp>=l) then
begin
d:=0;
exit;
end;
if (xp<a) and (yp>b) then d:=dbetp(xp,yp,a,b);
if (xp>=a) and (xp<=c) and (yp>b) then d:=yp-b;
if (xp>c) and (yp>b) then d:=dbetp(xp,yp,c,b);
if (xp<a) and (yp<=b) and (yp>=l) then d:=a-xp;
if (xp>c) and (yp<=b) and (yp>=l) then d:=xp-c;
if (xp<a) and (yp<l) then d:=dbetp(xp,yp,a,l);
if (xp>=a) and (xp<=c) and (yp<l) then d:=l-yp;
if (xp>c) and (yp<l) then d:=dbetp(xp,yp,c,l);
end;
function test:boolean;
var
x12,y12,x23,y23,x34,y34,x41,y41:extended;
begin
test:=false;
findcoord(k12,c12,xp,yp,x12,y12);
findcoord(k23,c23,xp,yp,x23,y23);
findcoord(k34,c34,xp,yp,x34,y34);
findcoord(k12,c12,xp,yp,x41,y41);
if ((dbetp(x12,y12,xp,yp)+dbetp(x34,y34,xp,yp))=dbetp
(x12,y12,x34,y34)) and
((dbetp(x23,y23,xp,yp)+dbetp(x41,y41,xp,yp))=dbetp
(x23,y23,x41,y41)) then
test:=true;
end;
begin
if (x3=x1) and (y1=y3) then
begin
finddistance:=dbetp(x1,y1,xp,yp);
exit;
end;
if (abs(x3-x1)=abs(y3-y1)) then
begin
exception;
finddistance:=d;
exit;
end;
findxy;
if test then
begin
finddistance:=0;
exit;
end;
d:=max;
if dbetp(x1,y1,xp,yp)<d then d:=dbetp(x1,y1,xp,yp);
if dbetp(x2,y2,xp,yp)<d then d:=dbetp(x2,y2,xp,yp);
if dbetp(x3,y3,xp,yp)<d then d:=dbetp(x3,y3,xp,yp);
if dbetp(x4,y4,xp,yp)<d then d:=dbetp(x4,y4,xp,yp);
findcoord(k12,c12,xp,yp,x,y);
if ((dbetp(x,y