http://acm.pku.edu.cn/JudgeOnline/problem?id=1066

http://acm.pku.edu.cn/JudgeOnline/images/1066/t1.jpg

Код:
program PKU1066;
const maxn = 200;
  maxm = 100000;
  error = 1e-7;

type integer = longint;
     node = array[1 .. 2] of double;
     arr = array[1 .. maxm] of integer;

var g, q, c, l, r, dep, tow, next, pre, start: arr;
    w: array[1 .. maxm] of boolean;
    d: array[1 .. maxm] of double;
    h: array[0 .. 100, 0 .. 100] of integer;
    ver: array[1 .. maxm] of node;
    a: array[1 .. maxn, 1 .. 2] of integer;
    n, m, len, tot, inside, outside, totnode: integer;
    treasure: node;

function same(i, j: double): boolean;
begin
  same := abs(i - j) < error;
end;

function find(x, y: double): integer;
var u, v, tmp: integer;
begin
  u := trunc(x); v := trunc(y);
  tmp := h[u, v];
  while tmp <> 0 do begin
    if same(ver[tmp, 1], x) and same(ver[tmp, 2], y) then begin
      find := tmp;
      exit;
    end;
    tmp := pre[tmp];
  end;
  totnode := totnode + 1;
  ver[totnode, 1] := x; ver[totnode, 2] := y;
  pre[totnode] := h[u, v];
  h[u, v] := totnode; find := totnode;
end;

procedure updata;
var i, p, q, u, v, x0, y0, x1, y1: integer;
begin
  fillchar(g, sizeof(g), 0);
  fillchar(h, sizeof(h), 0);
  read(n); totnode := 0;
  for i := 1 to n do begin
    read(x0, y0, x1, y1);
    u := find(x0, y0);
    v := find(x1, y1);
    a[i, 1] := u; a[i, 2] := v;
  end;
  u := find(0, 0); v := find(100, 0);
  p := find(100, 100); q := find(0, 100);
  a[n + 1, 1] := u; a[n + 1, 2] := v;
  a[n + 2, 1] := v; a[n + 2, 2] := p;
  a[n + 3, 1] := p; a[n + 3, 2] := q;
  a[n + 4, 1] := q; a[n + 4, 2] := u;
  n := n + 4;
  readln(treasure[1], treasure[2]);
end;

function area(var i, j, k: node): double;
begin
  area := (j[1] - i[1]) * (k[2] - i[2]) - (j[2] - i[2]) * (k[1] - i[1]);
end;

var k1, k2, k3, k4: double;

procedure check(i, j: integer);
var x0, y0: double;
    k: integer;
begin
  k1 := area(ver[a[i, 1]], ver[a[i, 2]], ver[a[j, 1]]);
  k2 := area(ver[a[i, 1]], ver[a[i, 2]], ver[a[j, 2]]);
  k3 := area(ver[a[j, 1]], ver[a[j, 2]], ver[a[i, 1]]);
  k4 := area(ver[a[j, 1]], ver[a[j, 2]], ver[a[i, 2]]);
  if (k1 * k2 <= error) and (k3 * k4 <= error) then begin
    x0 := (ver[a[j, 1], 1] * k2 - ver[a[j, 2], 1] * k1) / (k2 - k1);
    y0 := (ver[a[j, 1], 2] * k2 - ver[a[j, 2], 2] * k1) / (k2 - k1);
    k := find(x0, y0);
    len := len + 1; c[len] := k;
  end;
end;

procedure insert(u, v: integer);
begin
  tot := tot + 1;
  tow[tot] := v; next[tot] := g[u];
  g[u] := tot;
end;

var temp: integer;
    temp2: double;

procedure swap(var i, j: integer);
begin
  temp := i; i := j; j := temp;
end;

procedure swapreal(var i, j: double);
begin
  temp2 := i; i := j; j := temp2;
end;

function compare(i, j: integer): boolean;
begin
  compare := (ver[i, 1] < ver[j, 1] - error) or same(ver[i, 1], ver[j, 1]) and (ver[i, 2] < ver[j, 2] - error);
end;

procedure sortv(ll, rr: integer);
var i, j, mid: integer;
begin
  i := ll; j := rr; mid := c[(ll + rr) shr 1];
  while i <= j do begin
    while compare(c[i], mid) do i := i + 1;
    while compare(mid, c[j]) do j := j - 1;
    if i <= j then begin
      swap(c[i], c[j]);
      i := i + 1; j := j - 1;
    end;
  end;
  if i < rr then sortv(i, rr);
  if ll < j then sortv(ll, j);
end;

procedure sorte(ll, rr: integer);
var i, j: integer;
    mid: double;
begin
  i := ll; j := rr; mid := d[(ll + rr) shr 1];
  while i <= j do begin
    while d[i] < mid - error do i := i + 1;
    while d[j] > mid + error do j := j - 1;
    if i <= j then begin
      swap(c[i], c[j]); swapreal(d[i], d[j]);
      i := i + 1; j := j - 1;
    end;
  end;
  if i < rr then sorte(i, rr);
  if ll < j then sorte(ll, j);
end;

function calc(var p, q: node): double;
var x0, y0: double;
begin
  x0 := q[1] - p[1]; y0 := q[2] - p[2];
  if same(x0, 0) then
    if y0 > 0 then calc := pi / 2
      else calc := pi * 3 / 2
  else begin
    temp2 := arctan(y0 / x0);
    if x0 < 0 then temp2 := temp2 + pi;
    if temp2 < 0 then temp2 := temp2 + pi * 2;
    if temp2 >= 2 * pi then temp2 := temp2 - pi * 2;
    calc := temp2;
  end;
end;

procedure prepare;
var i, j, now, tmp: integer;
begin
  tot := 0;
  for i := 1 to n do begin
    len := 0;
    for j := 1 to n do if i <> j then
      check(i, j);
    if len > 1 then sortv(1, len);
    now := c[1];
    for j := 2 to len do if c[j] <> now then begin
      insert(now, c[j]);
      insert(c[j], now);
      now := c[j];
    end;
  end;
  now := 1;
  for i := 1 to totnode do begin
    tmp := g[i]; start[i] := now;
    while tmp <> 0 do begin
      c[now] := tow[tmp];
      d[now] := calc(ver[i], ver[tow[tmp]]);
      now := now + 1;
      tmp := next[tmp];
    end;
    sorte(start[i], now - 1);
  end; start[totnode + 1] := now;
end;

procedure bfs;
var open, closed, tmp, u, v: integer;
begin
  fillchar(dep, sizeof(dep), 0);
  open := 0; closed := 1;
  q[1] := outside; dep[outside] := 1;
  while (open < closed) and (dep[inside] = 0) do begin
    open := open + 1; u := q[open];
    tmp := g[u];
    while tmp <> 0 do begin
      v := tow[tmp];
      if dep[v] = 0 then begin
        dep[v] := dep[u] + 1;
        closed := closed + 1;
        q[closed] := v;
      end;
      tmp := next[tmp];
    end;
  end;
  writeln('Number of doors = ', dep[inside] - 1);
end;

procedure main;
var i, j, u, v, k: integer;
begin
  fillchar(g, sizeof(g), 0);
  fillchar(l, sizeof(l), 0);
  fillchar(r, sizeof(r), 0);
  fillchar(w, sizeof(w), true);
  m := 0; tot := 0;
  for i := 1 to totnode do begin
    for j := start[i] to start[i + 1] - 1 do if l[j] = 0 then begin
      m := m + 1; l[j] := m;
      u := i; v := c[j];
      repeat
        if area(ver[u], ver[v], treasure) < error then w[m] := false;
        for k := start[v] to start[v + 1] - 1 do if c[k] = u then break;
        r[k] := m; k := k - 1;
        if k < start[v] then k := start[v + 1] - 1;
        if l[k] = 0 then l[k] := m else break;
        u := v; v := c[k];
      until false;
    end;
  end;
  u := find(0, 0);
  for k := start[u] to start[u + 1] - 1 do if ver[c[k], 2] = 0 then break;
  outside := r[k];
  for k := 1 to m do if w[k] and (k <> outside) then inside := k;
  for k := 1 to start[totnode] - 1 do begin
    insert(l[k], r[k]);
    insert(r[k], l[k]);
  end;
  bfs;
end;

begin
  updata;
  prepare;
  main;
end.