Code:

+--------+      +-+--+--+
|        |      | |2 |  |
|        |      + +--+  |
|  +-+   |  --> | |  |  |
|  +-+   |      |1|  |3 |
|        |      | +--+  |
|        |      | | 4|  |
+--------+      +-+--+--+

Code:

program rect1;
{$APPTYPE CONSOLE}
uses
  SysUtils;
const
  MaxN = 2505;
var
  pom, dx, dy, Area, Heap, Pos, x, y, color: array [1.. MaxN] of LongInt;
  n, d, Size: LongInt;
  f, g: Text;

  procedure InPut;
  var
    i, a, b: LongInt;
  begin
    Assign (f, 'rect1.in');
    Reset (f);
    Read (f, a, b, n);
    Inc (n);
    x [1] := 0; y [1] := 0;
    x [n + 1] := a; y [n + 1] := b;
    Color [1] := 1;
    for i := 2 to n do
      Read (f, x [i], y [i], x [n + i], y [n + i], Color [i]);
    Close (f);
  end;

  procedure Quick_Sort_X (l, r: LongInt);
  var
    i, j, tmp, pivot: LongInt;
  begin
    if (l < r) then begin
      pivot := pom [(l + r) DIV 2];
      i := l; j := r;
      repeat
        while (pom [i] < pivot) do Inc (i);
        while (pom [j] > pivot) do Dec (j);
        if (i <= j) then begin
          tmp := pom [i]; pom [i] := pom [j]; pom [j] := tmp;
          Inc (i); Dec (j);
        end;
      until (i > j);
      Quick_Sort_X (l, j);
      Quick_Sort_X (i, r);
    end;
  end;

  procedure Quick_Sort_Y (l, r: LongInt);
  var
    i, j, tmp, pivot: LongInt;
  begin
    if (l < r) then begin
      pivot := pom [(l + r) DIV 2];
      i := l; j := r;
      repeat
        while (pom [i] < pivot) do Inc (i);
        while (pom [j] > pivot) do Dec (j);
        if (i <= j) then begin
          tmp := pom [i]; pom [i] := pom [j]; pom [j] := tmp;
          tmp := dy [i]; dy [i] := dy [j]; dy [j] := tmp;
          Inc (i); Dec (j);
        end;
      until (i > j);
      Quick_Sort_Y (l, j);
      Quick_Sort_Y (i, r);
    end;
  end;

  procedure Exc (var a, b: LongInt);
  var
    tmp: LongInt;
  begin
    tmp := a; a := b; b := tmp;
  end;

  procedure Insert (v: LongInt);
  var
    p, q: LongInt;
  begin
    Inc (Size);
    Heap [Size] := v;
    Pos [v] := Size;
    p := Size;
    q := p DIV 2;
    while (q > 0) and (Heap [q] < Heap [p]) do begin
      Exc (Pos [Heap [p]], Pos [Heap [q]]);
      Exc (Heap [p], Heap [q]);
      p := q;
      q := p DIV 2;
    end;
  end;

  procedure Delete (x: LongInt);
  var
    p, q: LongInt;
  begin
    Heap [Pos [x]] := Heap [Size];
    Pos [Heap [Size]] :=  Pos [x];
    Heap [Size] := 0;
    Dec (Size);
    p := Pos [x];
    q := p DIV 2;
    if (q > 0) and (Heap [q] < Heap [p]) then begin
      while (q > 0) and (Heap [q] < Heap [p]) do begin
        Exc (Pos [Heap [p]], Pos [Heap [q]]);
        Exc (Heap [p], Heap [q]);
        p := q;
        q := p DIV 2;
      end;
    end
    else begin
      while ((Heap [p] < Heap [2 * p]) or (Heap [p] < Heap [2 * p + 1])) do
        if (Heap [2 * p] > Heap [2 * p + 1]) then begin
          Exc (Pos [Heap [p]], Pos [Heap [2 * p]]);
          Exc (Heap [p], Heap [2 * p]);
          p := 2 * p;
        end
        else begin
          Exc (Pos [Heap [p]], Pos [Heap [2 * p + 1]]);
          Exc (Heap [p], Heap [2 * p + 1]);
          p := 2 * p + 1;
        end;
    end;
  end;

  procedure Solve;
  var
    i, k, j, v: LongInt;
  begin
    {Sortiram po X, i (dx [i], dx [i + 1]) x-koordinate trake}
    pom := x;
    Quick_Sort_X (1, 2 * n);
    d := 0; i := 1;
    while (i <= 2 * n) do begin
      Inc (d);
      dx [d] := pom [i];
      while (dx [d] = pom [i]) and (i <= 2 * n) do Inc (i);
    end;

    {Sortiramo po Y i dy [i] = pozicija u ne soriranom nizu}
    pom := y;
    for i := 1 to 2 * n do dy [i] := i;
    Quick_Sort_Y (1, 2 * n);

    FillChar (Area, SizeOf (Area), 0);
    for k := 1 to d - 1 do begin
      FillChar (Heap, SizeOf (Heap), 0);
      FillChar (Pos, SizeOf (Pos), 0);
      j := 1;
      while not ((x [dy [j]] <= dx [k]) and (dx [k + 1] <= x [dy [j] + n])) do Inc (j);
      Heap [1] := dy [j];
      Pos [dy [j]] := 1;
      Size := 1;
      for i := j + 1 to 2 * n do begin
        Area [Color [Heap [1]]] := Area [Color [Heap [1]]] +
          (dx [k + 1] - dx [k]) * (y [dy [i]] - y [dy [i - 1]]);
        v := dy [i];
        if (v > n) then v := v - n;
        if (x [v] <= dx [k]) and (dx [k + 1] <= x [v + n]) then
          if (dy [i] <= n) then
            Insert (dy [i])
          else
            Delete (dy [i] - n);
      end;
    end;
  end;

  procedure Output;
  var
      i: LongInt;
  begin
      Assign (g, 'rect1.out');
    ReWrite (g);
      for i := 1 to MaxN do
             if (Area [i] > 0) then
          WriteLn (g, i, ' ', Area [i]);
    Close (g);
  end;

begin
  InPut;
  Solve;
  OutPut;
end.