(*

Citta' sotterranea (IOI 1999)
Copyright (C) 2000 Paolo Boldi

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

*)

program Ioi9913;

{$R+}

(******** INTERAZIONE *)
uses undertpu;

procedure init(i: integer);
(* Crea il file place.txt a partire dal file under<i>.xy e copia under<i>.inp
   in under.inp; sulla seconda riga del file place.txt si trova il valore
   di M *)
var s: string;
    f,fout: text;
    c: char;
    x,y,M: integer;
begin
     str(i,s);
     assign(f,'under'+s+'.xy');
     reset(f);
     read(f,c,c);
     read(f,x);
     read(f,c,c,c,c);
     read(f,y);
     read(f,c,c,c);
     read(f,M);
     assign(fout,'place.txt');
     rewrite(fout);
     writeln(fout,x,' ',y);
     writeln(fout,M);
     close(f);
     close(fout);
     assign(fout,'under.inp');
     assign(f,'under'+s+'.inp');
     reset(f);
     rewrite(fout);
     while (not eof(f)) do
           begin
                read(f,c);
                write(fout,c);
           end;
     close(f);
     close(fout)
end;

(****************)

const maxx=100;
      maxy=100;
      maxcand=maxx*maxy-2*maxx-2*maxy+4; (* Numero massimo candidate *)
type
    direzione=(nord,sud,est,ovest);
    ardi=array [direzione] of integer;
    sdir=set of direzione;

const
     DEBUG=true;
     xdir: array [direzione] of integer=(0,0,-1,1);
     ydir: array [direzione] of integer=(1,-1,0,0);
     opposto: array [direzione] of direzione=(sud,nord,ovest,est);
     car: array [direzione] of char=('N','S','W','E');

var
   finx,finy: integer;
   mappa: array [1..maxx,1..maxy] of char;
   ncand: word;                           (* Numero candidate *)
   candidate: array [1..maxcand] of record
                    x,y: integer
              end;
   dx,dy: integer; (* Spostamento rispetto alla posizione iniziale *)
   deciso: boolean; (* Ricerca finita? *)

(*****)

(* Alberi di ricerca *)

type albero=^nodo;
     nodo=record
                x,y: integer;
                ncand: word;
                sx,dx: albero
          end;

var t: albero;

function loopcheck: boolean;
(* Cerca nell'albero t la coppia (dx,dy). Se la trova, e il valore associato
   Š ncand, restituisce true: significa che ci siamo gi… trovati in quella
   posizione con lo stesso numero (e quindi: lo stesso insieme di candidati).
   In caso contrario: se la trova, ma il numero associato Š diverso, lo
   modifica; se non la trova, crea un nodo.
   ASSUME che t non sia vuoto *)
var padre,corr,n: albero;
    parte: (sinistra,destra);
begin
     corr:=t; padre:=nil;
     while (corr<>nil) and ((corr^.x<>dx) or (corr^.y<>dy)) do
           begin
                padre:=corr;
                if (corr^.x<dx) or ((corr^.x=dx) and (corr^.y<dy)) then
                   begin
                        corr:=corr^.sx;
                        parte:=sinistra
                   end
                else
                    begin
                         corr:=corr^.dx;
                         parte:=destra
                    end
           end;
     if (corr<>nil) then
        if (corr^.ncand<>ncand) then
           begin
                corr^.ncand:=ncand;
                loopcheck:=false
           end
        else
            loopcheck:=true
     else
         begin
              loopcheck:=false;
              new(n);
              n^.x:=dx; n^.y:=dy; n^.ncand:=ncand;
              n^.sx:=nil; n^.dx:=nil;
              if (parte=sinistra) then padre^.sx:=n
              else padre^.dx:=n
         end
end;


function guarda(dir: direzione): boolean;
(* Come look *)
var c: char;
begin
     c:=look(car[dir]);
     guarda:=(c='W');
     if (DEBUG) then
        begin
             writeln('Guardo in direzione ',car[dir],': ',c);
             readln
        end
end;

procedure finito(x,y: integer);
(* Come finish *)
begin
     finish(x,y);
     if (DEBUG) then
        begin
             writeln('Finito: ',x,',',y);
             readln
        end
end;

procedure muovi(dir: direzione);
begin
     move(car[dir]);
     if (DEBUG) then
        begin
             writeln('Muovo in direzione ',car[dir]);
             readln
        end
end;

(*****)

procedure leggimappa;
(* Legge la mappa (file under.inp) nell'array mappa; inoltre dispone
   tutte le celle libere nell'array candidate *)
var f: text;
    x,y: integer;
begin
     assign(f,'under.inp');
     reset(f);
     readln(f,finx,finy);
     ncand:=0;
     for y:=finy downto 1 do
         begin
              for x:=1 to finx do
                  begin
                       read(f,mappa[x,y]);
                       if (mappa[x,y]='O') then
                          begin
                               inc(ncand);
                               candidate[ncand].x:=x;
                               candidate[ncand].y:=y
                          end
                  end;
              readln(f)
         end;
     close(f)
end;

procedure scrivimappa;
(* Stampa su standard output la mappa, indicando con W i muri, con uno spazio
   le celle libere e con un ? le celle candidate *)
var x,y: byte;
    i: word;
    cand: boolean;
begin
     writeln(ncand); exit;
     writeln;
     for y:=finy downto 1 do
         begin
              for x:=1 to finx do
                  if (mappa[x,y]='W') then write('W')
                  else
                      begin
                           cand:=false;
                           for i:=1 to ncand do
                               if (candidate[i].x=x) and (candidate[i].y=y) then
                                  begin
                                       cand:=true;
                                       break
                                  end;
                           if (cand) then write('?') else write(' ')
                      end;
              writeln
         end;
     readln
end;

procedure muri(var n: ardi);
(* Per ogni direzione, dice quante candidate hanno un muro in quella direzione *)
var d: direzione;
    c: word;
begin
     for d:=nord to ovest do n[d]:=0;
     for c:=1 to ncand do
         for d:=nord to ovest do
             if (mappa[candidate[c].x+xdir[d],candidate[c].y+ydir[d]]='W') then
                inc(n[d]);
end;

procedure screma(d: direzione; muro: boolean);
(* Screma l'array candidate, tenendo solo quelle che in direzione d hanno
   o non hanno un muro, a seconda del booleano muro *)
var nncand,i: word;
begin
     nncand:=0;
     for i:=1 to ncand do
         begin
              if ((mappa[candidate[i].x+xdir[d],candidate[i].y+ydir[d]]='W')=muro) then
                 begin
                      inc(nncand);
                      candidate[nncand]:=candidate[i]
                 end
         end;
     ncand:=nncand;
     if (DEBUG) then
        scrivimappa;
end;

function decidi(var dir: direzione; var s: sdir): boolean;
(* Se restituisce true, significa che Š possibile scremare le candidate solo
   sulla base dei muri adiacenti: in tal caso, restituisce in dir la direzione
   in cui Š opportuno guardare. Se restituisce false, vuol dire che bisogna
   spostarsi per effettuare una scrematura: in tal caso, in s si trova
   l'insieme delle direzioni in cui ci si pu• spostare *)
var n: ardi;
    d,dmin: direzione;
    min: word;
begin
     muri(n);
     min:=high(word);
     s:=[];
     for d:=nord to ovest do
         begin
              if (n[d]=0) then s:=s+[d];
              if (abs(n[d]-ncand div 2)<min) then
                 begin
                      min:=abs(n[d]-ncand div 2);
                      dmin:=d
                 end
         end;
     if (n[dmin]=0) or (n[dmin]=ncand) then
        decidi:=false
     else
         begin
              dir:=dmin;
              decidi:=true
         end
end;

procedure cerca(prov: direzione; primo: boolean);
(* Se c'Š una sola candidata, la emette in output (con lo spiazzamento
   dx,dy) e pone deciso=true, in modo da uscire dalla ricerca.
   Altrimenti, finch‚ pu• screma le candidate solo sulla base dei muri
   adiacenti. Quando ci• non Š pi— possibile, si sposta in una delle
   direzioni possibili (evitando quella di provenienza, prov, se primo
   Š false) e ripete *)
label fine;
var dir: direzione;
    s: sdir;
    i: word;
begin
     if (deciso) then exit;
     fine:
     if (ncand=1) then
        begin
             deciso:=true;
             finito(candidate[1].x-dx,candidate[1].y-dy)
        end
     else
         begin
              while (decidi(dir,s)) and (ncand>1) do
                    screma(dir,guarda(dir));
              if (ncand=1) then goto fine;
              if (loopcheck) then
                 begin
                      if (DEBUG) then
                         writeln('Evito il ciclo!');
                      exit
                 end;
              for dir:=nord to ovest do
                  if (dir in s) and (primo or (dir<>prov)) then
                     begin
                          dx:=dx+xdir[dir];
                          dy:=dy+ydir[dir];
                          muovi(dir);
                          for i:=1 to ncand do
                              begin
                                   candidate[i].x:=candidate[i].x+xdir[dir];
                                   candidate[i].y:=candidate[i].y+ydir[dir]
                              end;
                          cerca(opposto[dir],false);
                          if (deciso) then exit;
                          dx:=dx-xdir[dir];
                          dy:=dy-ydir[dir];
                          muovi(opposto[dir]);
                          for i:=1 to ncand do
                              begin
                                   candidate[i].x:=candidate[i].x-xdir[dir];
                                   candidate[i].y:=candidate[i].y-ydir[dir]
                              end
                     end
         end
end;

begin
     init(8);
     dx:=0; dy:=0;
     deciso:=false;

     leggimappa;
     (* Crea la radice dell'albero *)
     new(t); t^.x:=0; t^.y:=0; t^.sx:=nil; t^.dx:=nil; t^.ncand:=ncand;
     start;
     cerca(nord,true);
end.