记录编号	756	评测结果	AAWWWWWW
题目名称	求图形面积	最终得分	25
用户昵称	zhai	是否通过	未通过
代码语言	Pascal	运行时间	0.092 s
提交时间	2008-07-22 11:24:37	内存使用	0.12 MiB

program area;
  type
    fa=record
      yy,xx:integer;
    end;
  const
    f:array[1..8]of fa=((yy:0;xx:1),(yy:1;xx:1),(yy:1;xx:0),(yy:1;xx:-1),(yy:0;xx:-1),(yy:-1;xx:-1),(yy:-1;xx:0),(yy:-1;xx:1));
  var
    f1,f2:text;
    a:array[1..30,1..30]of integer;
    e:array[1..2,1..900]of integer;
    h,b,n,g:integer;
    procedure ini;
      var
      i,j:integer;
      begin
        assign(f1,'area.in');reset(f1);
        assign(f2,'area.out');rewrite(f2);
        readln(f1,h,b,n);
        for i:=1 to b do
          for j:=1 to h do a[i,j]:=1;
        fillchar(e,sizeof(e),0);
      end;
    procedure moni;
      var
        i,j,k:integer;
        x1,x2,y1,y2,c:integer;
      begin
        h:=h div 2;
        b:=b div 2;
        g:=0;
        for i:=1 to n do begin
          readln(f1,x1,y1,x2,y2,c);
          if g<c then g:=c;
          for j:=b-y2+1 to b-y1 do
            for k:=h+x1+1 to h+x2 do a[j,k]:=c;
        end;
        close(f1);
      end;
    procedure chuli;
      var
        d:array[1..2,1..900]of integer;
        i,j,k,l,s,head,tail:integer;
      begin
        fillchar(d,sizeof(d),0);
        s:=1;
        for i:=1 to g do
          for k:=1 to 2*h do
            for j:=1 to 2*b do
              if a[j,k]=i then begin
                head:=1;
                tail:=2;
                fillchar(d,sizeof(d),0);
                d[1,1]:=j;
                d[2,1]:=k;
                a[j,k]:=0;
                e[1,s]:=i;
                e[2,s]:=1;
                repeat
                  for l:=1 to 8 do
                  if (d[1,head]+f[l].yy>0)and(d[2,head]+f[l].xx>0)and
                  (a[d[1,head]+f[l].yy,d[2,head]+f[l].xx]=i)
                  then begin
                    inc(e[2,s]);
                    a[d[1,head]+f[l].yy,d[2,head]+f[l].xx]:=0;
                    d[1,tail]:=d[1,head]+f[l].yy;
                    d[2,tail]:=d[2,head]+f[l].xx;
                    inc(tail);
                  end;
                  inc(head);
                until head=tail;
                inc(s);
              end;
      end;
    procedure shuchu;
      var
        i:integer;
      begin
        i:=1;
        while e[1,i]<>0 do begin
          writeln(f2,e[1,i],' ',e[2,i]);
          inc(i);
        end;
        close(f2);
      end;
  begin
    ini;
    moni;
    chuli;
    shuchu;
  end.