Cod sursa(job #37933)

Utilizator andrewgPestele cel Mare andrewg Data 25 martie 2007 13:07:22
Problema Laser Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.8 kb
const maxn = 550;
      maxm = 12000;

type punct = record
        x,y:longint;
     end;

var f:text;
    n,m,k,i,j,sol:longint;
    a,b:array[1..maxn]of punct;
    ok:boolean;
    g:array[1..maxn]of boolean;
    d:array[1..maxm]of real;
    len:longint;
    l:array[1..maxn]of longint;

procedure readdata;
begin
   assign(f,'laser.in');
   reset(f);
   readln(f,n);
   for i:=1 to n do
   begin
      readln(f,a[i].x,a[i].y,b[i].x,b[i].y);
   end;
   for i:=1 to n do
   begin
      read(f,j);
      if j=1 then g[i]:=true
             else g[i]:=false;
   end;
   close(f);
end;

procedure coef(a,b:punct;var aa,bb,cc:real);
begin
   aa:=a.y-b.y;
   bb:=b.x-a.x;
   cc:=a.x*b.y-b.x*a.y;
end;

procedure intersec(a1,b1,c1,a2,b2,c2:real;var x,y:real);
begin
   x:=(b2*c1-b1*c2)/(a2*b1-a1*b2);
   y:=(a1*c2-a2*c1)/(a2*b1-a1*b2);
end;

procedure solve;
var p:punct;
    aa,bb,cc,tan,a1,b1,c1:real;
    x,y:real;
begin
   p.x:=0;
   p.y:=0;
   for i:=1 to n do
   begin
      if g[i]=true then
      begin
         ok:=true;
         len:=0;
         coef(p,a[i],aa,bb,cc);
         for j:=1 to n do
         begin
            {arcsin(x)=arctan(x/sqrt(1-sqr(x)));}
            if i<>j then
            begin
               coef(a[j],b[j],a1,b1,c1);
               intersec(aa,bb,0,a1,b1,c1,x,y);
               if ((a[j].x<=x) and (b[j].x>=x)) or ((a[j].x>=x) and (b[j].x<=x)) and
                (x*a[i].x>0) and (y*a[i].y>0) then
               begin
                  if g[j]=false then
                  begin
                     ok:=false;
                     break;
                  end
                     else
                  begin
                     inc(len);
                     l[len]:=j;
                  end;
               end;
            end;
         end;
         if ok then
         begin
            g[i]:=false;
            inc(sol);
            d[sol]:=arctan(-aa/bb)*180/pi;
            if (a[i].x<0) and (a[i].y>0) then d[sol]:=d[sol]+90;
            if (a[i].x<0) and (a[i].y<0) then d[sol]:=d[sol]+180;
            if (a[i].x>0) and (a[i].y<0) then d[sol]:=d[sol]+270;
            for j:=1 to len do
            begin
               g[l[j]]:=false;
            end;
         end
            else
         begin
         ok:=true;
         coef(p,b[i],aa,bb,cc);
         for j:=1 to n do
         begin
            {arcsin(x)=arctan(x/sqrt(1-sqr(x)));}
            if i<>j then
            begin
               coef(a[j],b[j],a1,b1,c1);
               intersec(aa,bb,0,a1,b1,c1,x,y);
               if ((a[j].x<=x) and (b[j].x>=x)) or ((a[j].x>=x) and (b[j].x<=x)) and
                (x*a[i].x>0) and (y*a[i].y>0) then
               begin
                  if g[j]=false then
                  begin
                     ok:=false;
                     break;
                  end
                     else
                  begin
                     inc(len);
                     l[len]:=j;
                  end;
               end;
            end;
         end;
         if ok then
         begin
            g[i]:=false;
            inc(sol);
            d[sol]:=arctan(-aa/bb)*180/pi;
            if (b[i].x<0) and (b[i].y>0) then d[sol]:=d[sol]+90;
            if (b[i].x<0) and (b[i].y<0) then d[sol]:=d[sol]+180;
            if (b[i].x>0) and (b[i].y<0) then d[sol]:=d[sol]+270;
            for j:=1 to len do
            begin
               g[l[j]]:=false;
            end;
         end;
         end;
      end;
   end;
end;

procedure writedata;
begin
   assign(f,'laser.out');
   rewrite(f);
   writeln(f,sol);
   for i:=1 to sol do
   begin
      if d[i]<0 then d[i]:=d[i]+360;
      writeln(f,d[i]:0:6);
   end;
   close(f);
end;

begin
   readdata;
   solve;
   writedata;
end.