ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1111. Squares

Compilation Error. Why? Help me, please.
Posted by Timur 18 Apr 2002 10:19
{Written by Luguev Timur}
{$n+}
uses crt;
const max=32767;
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,x1,y1
Maybe the readkey at end(-)
Posted by ijk 18 Apr 2002 12:19
> {Written by Luguev Timur}
> {$n+}
> uses crt;
> const max=32767;
> 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