⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ac1180.pas

📁 同济大学 Online在线题库 AC源代码合集 程序设计竞赛必看资料
💻 PAS
字号:
program tju1180;
const
  maxn=50;
  zero=1e-6;
type
  dot=record x,y:real;end;
  lxtype=record x:real;up,down:shortint;end;
var
  ver:array[1..maxn,1..3]of dot;
  lx:array[1..maxn*2]of lxtype;
  ly:array[1..sqr(maxn)*3]of real;
  n,i,j,k,p,q,r,cx,cy:word;
  u1,d1,u2,d2,ans:real;
  td:dot;
function sgn(x:real):shortint;
  begin
    if abs(x)<0 then sgn:=0 else if x>0 then sgn:=1 else sgn:=-1;
  end;
function cross(a,b,c:dot):real;
  var
    x1,y1,x2,y2:real;
  begin
    x1:=b.x-a.x;y1:=b.y-a.y;
    x2:=c.x-a.x;y2:=c.y-a.y;
    cross:=x1*y2-x2*y1;
  end;
procedure intersect(a,b,c,d:dot);
  var
    c1,c2:real;
  begin
    if sgn(cross(c,d,a))*sgn(cross(c,d,b))>=0 then exit;
    c1:=cross(a,b,c);c2:=cross(a,d,b);
    inc(cy);ly[cy]:=(c.y*c2+d.y*c1)/(c1+c2);
  end;
procedure qsorty(s,t:word);
  var
    p,i,j:word;
    ty:real;
  begin
    if s>=t then exit;
    p:=s+random(t-s+1);
    ty:=ly[p];ly[p]:=ly[s];
    i:=s;j:=t;
    repeat
      while (i<j) and (ly[j]>ty) do dec(j);
      if i=j then break;ly[i]:=ly[j];inc(i);
      while (i<j) and (ly[i]<ty) do inc(i);
      if i=j then break;ly[j]:=ly[i];dec(j);
    until i=j;
    ly[i]:=ty;
    qsorty(s,i-1);
    qsorty(i+1,t);
  end;
procedure qsortx(s,t:word);
  var
    p,i,j:word;
    tx:lxtype;
  begin
    if s>=t then exit;
    p:=s+random(t-s+1);
    tx:=lx[p];lx[p]:=lx[s];
    i:=s;j:=t;
    repeat
      while (i<j) and (lx[j].x>tx.x) do dec(j);
      if i=j then break;lx[i]:=lx[j];inc(i);
      while (i<j) and (lx[i].x<tx.x) do inc(i);
      if i=j then break;lx[j]:=lx[i];dec(j);
    until i=j;
    lx[i]:=tx;
    qsortx(s,i-1);
    qsortx(i+1,t);
  end;
procedure cut(a,b,c:dot;y0:real);
  begin
    if (y0<a.y) or (y0>b.y) then exit;
    inc(cx);with lx[cx] do begin
      x:=(a.x*(b.y-y0)+b.x*(y0-a.y))/(b.y-a.y);
      if cross(a,b,c)>0 then begin up:=-1;down:=-1;end else begin up:=1;down:=1;end;
    end;
  end;
procedure cal(y0:real);
  var
    hu,hd,su,sd:shortint;
  begin
    cx:=0;
    for i:=1 to n do begin
      if (y0<ver[i,1].y) or (y0>ver[i,3].y) then continue;
      if abs(y0-ver[i,2].y)<zero then
        if abs(y0-ver[i,1].y)<zero then begin
          inc(cx);with lx[cx] do begin x:=ver[i,1].x;up:=1;down:=0;end;
          inc(cx);with lx[cx] do begin x:=ver[i,2].x;up:=-1;down:=0;end;
        end
        else if abs(y0-ver[i,3].y)<zero then begin
          inc(cx);with lx[cx] do begin x:=ver[i,2].x;up:=1;down:=0;end;
          inc(cx);with lx[cx] do begin x:=ver[i,3].x;up:=-1;down:=0;end;
        end
        else if cross(ver[i,1],ver[i,3],ver[i,2])>0 then begin
          inc(cx);with lx[cx] do begin x:=ver[i,2].x;up:=1;down:=1;end;
          cut(ver[i,1],ver[i,3],ver[i,2],y0);
        end
        else begin
          cut(ver[i,1],ver[i,3],ver[i,2],y0);
          inc(cx);with lx[cx] do begin x:=ver[i,2].x;up:=-1;down:=-1;end;
        end
      else begin
        cut(ver[i,1],ver[i,2],ver[i,3],y0);
        cut(ver[i,1],ver[i,3],ver[i,2],y0);
        cut(ver[i,2],ver[i,3],ver[i,1],y0);
      end;
    end;
    qsortx(1,cx);
    u2:=0;d2:=0;hu:=0;hd:=0;
    for i:=1 to cx do begin
      if lx[i].up<>0 then begin
        if hu=0 then su:=i;
        inc(hu,lx[i].up);
        if hu=0 then u2:=u2+lx[i].x-lx[su].x;
      end;
      if lx[i].down<>0 then begin
        if hd=0 then sd:=i;
        inc(hd,lx[i].down);
        if hd=0 then d2:=d2+lx[i].x-lx[sd].x;
      end;
    end;
  end;
begin
  repeat
    read(n);cy:=0;
    for i:=1 to n do begin
      for j:=1 to 3 do
        with ver[i,j] do read(x,y);
      for j:=1 to 2 do
        for k:=j+1 to 3 do
          if (ver[i,k].y<ver[i,j].y-zero) or
             ((abs(ver[i,k].y-ver[i,j].y)<zero) and
             (ver[i,k].x<ver[i,j].x-zero)) then begin
            td:=ver[i,j];ver[i,j]:=ver[i,k];ver[i,k]:=td;
          end;
      for j:=1 to 3 do begin
        inc(cy);ly[cy]:=ver[i,j].y;
      end;
      for j:=1 to 2 do
        for k:=j+1 to 3 do
          for p:=1 to 2 do
            for q:=p+1 to 3 do
              for r:=1 to i-1 do
                intersect(ver[i,j],ver[i,k],ver[r,p],ver[r,q]);
    end;
    p:=cy;qsorty(1,p);cy:=1;
    for i:=2 to p do
      if ly[i]-ly[cy]>zero then begin
        inc(cy);ly[cy]:=ly[i];
      end;

    ans:=0;cal(ly[1]);
    for p:=2 to cy do begin
      u1:=u2;d1:=d2;cal(ly[p]);
      ans:=ans+(u1+d2)*(ly[p]-ly[p-1]);
    end;
    writeln(ans/2:0:2);
  until seekeof;
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -