(*** PICTURE - PASCAL version 1 ps@di.fct.unl.pt ***) program Picture (output); const maxRect = 5000; maxEdges = 10000; { 2*maxRect } XX = false; YY = true; type RectList = array[1..maxRect] of boolean; Items = record value: integer; first: boolean; nR: 1..maxRect end; EdgeList = array[boolean, 1..maxEdges] of Items; var f, g: text; Edge: EdgeList; MarkRect: RectList; NRect: integer; Perimeter: longint; procedure Abort (n: integer); begin case n of 1: writeln('*** Empty File ***'); 2: writeln('*** Too many pictures ***') end; Halt end; procedure ReadFile; var i: integer; axes: boolean; begin if eof(f) then Abort(1); readln(f, NRect); if NRect > maxRect then Abort(2); for i := 1 to NRect do begin MarkRect[i] := false; read(f, Edge[XX, 2 * i - 1].value, Edge[YY, 2 * i - 1].value); readln(f, Edge[XX, 2 * i].value, Edge[YY, 2 * i].value); for axes := XX to YY do begin Edge[axes, 2 * i - 1].first := true; Edge[axes, 2 * i - 1].nR := i; Edge[axes, 2 * i].first := false; Edge[axes, 2 * i].nR := i end end; end; procedure SortEdges (axes: boolean); var aux: Items; swap: boolean; i, j: integer; begin swap := true; i := 1; j := 0; while swap do begin swap := false; for i := 2 to 2 * NRect - j do if Edge[axes, i].value < Edge[axes, i - 1].value then begin aux := Edge[axes, i - 1]; Edge[axes, i - 1] := Edge[axes, i]; Edge[axes, i] := aux; swap := true end; j := j + 1 end end; procedure ScanRect (axes: boolean); { only if NRect>0 } var i, scanLine, nextScanLine: integer; procedure ScanBetween (axes: boolean; sline, nsline: integer); var i, TotalRect, OldTotalRect, previous: integer; start: boolean; begin TotalRect := 0; OldTotalRect := 0; start := true; for i := 1 to NRect * 2 do if MarkRect[Edge[axes, i].nR] then begin if Edge[axes, i].first then TotalRect := TotalRect + 1 else TotalRect := TotalRect - 1; if (OldTotalRect = 1) and (TotalRect = 0) then Perimeter := Perimeter + (nsline - sline) else if (OldTotalRect = 0) and (TotalRect = 1) then if start then Perimeter := Perimeter + (nsline - sline) else if Edge[axes, i].value = previous then Perimeter := Perimeter - (nsline - sline) else Perimeter := Perimeter + (nsline - sline); previous := Edge[axes, i].value; start := false; OldTotalRect := TotalRect end end; begin i := 1; nextScanLine := Edge[axes, i].value; while i < NRect * 2 do begin scanLine := nextScanLine; MarkRect[Edge[axes, i].nR] := Edge[axes, i].first; while Edge[axes, i].value = Edge[axes, i + 1].value do begin i := i + 1; MarkRect[Edge[axes, i].nR] := Edge[axes, i].first end; nextScanLine := Edge[axes, i + 1].value; if nextScanLine > scanLine then ScanBetween(not axes, scanLine, nextScanLine); i := i + 1 end end; procedure ClearMarks; var i: integer; begin for i := 1 to NRect do MarkRect[i] := false end; begin (* MAIN *) assign(f, 'PICTURE.IN'); reset(f); ReadFile; close(f); Perimeter := 0; if NRect > 0 then begin SortEdges(XX); SortEdges(YY); ScanRect(XX); ClearMarks; ScanRect(YY) end; assign(g, 'PICTURE.OUT'); rewrite(g); writeln(g, Perimeter : 1); close(g); writeln; writeln('Perimeter=', Perimeter : 1) end.