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

Код:
type
        tymap   =       array [ 1 .. 16 , 1 .. 16 ] of byte ;
        tyblo   =       array [ 1 .. 4 , 1 .. 2 ] of byte ;
const
        pos     :       array [ 1 .. 7 , 1 .. 5 ] of byte = (
                                ( 1 , 0 , 0 , 0 , 0 ) ,
                                ( 2 , 3 , 0 , 0 , 0 ) ,
                                ( 4 , 5 , 0 , 0 , 0 ) ,
                                ( 6 , 7 , 8 , 9 , 0 ) ,
                                ( 10 , 11 , 12 , 13 , 0 ) ,
                                ( 14 , 15 , 16 , 17 , 0 ) ,
                                ( 18 , 19 , 0 , 0 , 0 )
                        ) ;
        b       :       array [ 1 .. 19 ] of tyblo = (
                        ( ( 1 , 1 ) , ( 1 , 2 ) , ( 2 , 1 ) , ( 2 , 2 ) ) , // 1
                        ( ( 1 , 1 ) , ( 1 , 2 ) , ( 2 , 2 ) , ( 2 , 3 ) ) , // 2
                        ( ( 1 , 2 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 3 , 1 ) ) ,
                        ( ( 1 , 2 ) , ( 1 , 3 ) , ( 2 , 1 ) , ( 2 , 2 ) ) , // 3
                        ( ( 1 , 1 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 3 , 2 ) ) ,
                        ( ( 1 , 1 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 2 , 3 ) ) , // 4
                        ( ( 1 , 1 ) , ( 1 , 2 ) , ( 2 , 1 ) , ( 3 , 1 ) ) ,
                        ( ( 1 , 1 ) , ( 1 , 2 ) , ( 1 , 3 ) , ( 2 , 3 ) ) ,
                        ( ( 1 , 2 ) , ( 2 , 2 ) , ( 3 , 1 ) , ( 3 , 2 ) ) ,
                        ( ( 1 , 3 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 2 , 3 ) ) , // 5
                        ( ( 1 , 1 ) , ( 2 , 1 ) , ( 3 , 1 ) , ( 3 , 2 ) ) ,
                        ( ( 1 , 1 ) , ( 1 , 2 ) , ( 1 , 3 ) , ( 2 , 1 ) ) ,
                        ( ( 1 , 1 ) , ( 1 , 2 ) , ( 2 , 2 ) , ( 2 , 3 ) ) ,
                        ( ( 1 , 2 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 2 , 3 ) ) , // 6
                        ( ( 1 , 1 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 3 , 1 ) ) ,
                        ( ( 1 , 1 ) , ( 1 , 2 ) , ( 1 , 3 ) , ( 2 , 2 ) ) ,
                        ( ( 1 , 2 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 3 , 2 ) ) ,
                        ( ( 1 , 1 ) , ( 1 , 2 ) , ( 1 , 3 ) , ( 1 , 4 ) ) , // 7
                        ( ( 1 , 1 ) , ( 2 , 1 ) , ( 3 , 1 ) , ( 4 , 1 ) )
                        );
var
        c       ,
        tot     ,
        w , h   :       longint ;
        f       :       array [ 1 .. 16 , 1 .. 16 ] of boolean ;
        r       ,
        num     ,
        a       ,
        map     :       tymap ;
        s       :       array [ 1 .. 1000 ] of tymap ;
        use     :       array [ 1 .. 50 ] of boolean ;
procedure init ;
var
        ch      :     char ;
        i , j   :     longint ;
begin
        fillchar ( map , sizeof ( map ) , 0 ) ;
        fillchar ( a , sizeof ( a ) , 0 ) ;
        fillchar ( num , sizeof ( num ) , 0 ) ;
        fillchar ( use , sizeof ( use ) , 0 ) ;
        for i := 1 to h do begin
                for j := 1 to w do begin
                        read ( ch ) ;
                        case ch of
                                '.' : map [ i , j ] := 2 ;
                                'x' : map [ i , j ] := 1 ;
                                'o' : map [ i , j ] := 0 ;
                        end ;
                end ;
                readln ;
                end ;
        tot := 0 ;
end ;

function equal ( n1 , n2 : longint ) : boolean ;
var
        i , j   :     longint ;
begin
        equal := false;
        for i := 1 to h do
                for j := 1 to w do
                        if s [ n1 ] [ i ] [ j ] <> s [ n2 ] [ i ] [ j ] then exit ;
        equal := true ;
end ;

procedure save ;
var
        i    :       longint ;
begin
        inc ( tot ) ;
        s [ tot ] := a ;
        for i := 1 to tot - 1 do
                if equal ( i , tot ) then
                        begin
                                dec ( tot ) ;
                                exit ;
                        end ;
end ;

function over : boolean ;
var
        i , j   :       longint ;
begin
        over := false ;
        for i := 1 to h do
                for j := 1 to w do
                        if ( a [ i ] [ j ] = 0 ) and ( map [ i ] [ j ] = 1 ) then exit ;
        over := true ;
end ;

procedure get ( ship , rank :   longint ) ;
var
        i , j   :       longint ;
        function ok : boolean ;
        var
                xx , yy ,
                p       :       longint ;
        begin
                ok := false ;
                for p := 1 to 4 do begin
                        xx := i + b [ pos [ ship ] [ rank ] ] [ p ] [ 1 ] - 1 ;
                        yy := j + b [ pos [ ship ] [ rank ] ] [ p ] [ 2 ] - 1 ;
                        if ( xx > h ) or ( yy > w ) or ( a [ xx ] [ yy ] > 0 ) or ( map [ xx , yy ] = 0 ) then exit ;
                end ;
                ok := true ;
        end ;
        procedure putinto ;
        var
                p       :       longint ;
        begin
                for p := 1 to 4 do begin
                        a [ i + b [ pos [ ship ] [ rank ] ] [ p ] [ 1 ] - 1 ] [ j + b [ pos [ ship ] [ rank ] ] [ p ] [ 2 ] - 1 ] := 1 ;
                end ;
        end ;
        procedure takeout ;
        var
                p       :       longint ;
        begin
                for p := 1 to 4 do begin
                        a [ i + b [ pos [ ship ] [ rank ] ] [ p ] [ 1 ] - 1 ] [ j + b [ pos [ ship ] [ rank ] ] [ p ] [ 2 ] - 1 ] := 0 ;
                end ;
        end ;

begin
        if ship > 7 then begin
                if over then begin
                save ;
                end ;
                exit ;
        end ;
        if pos [ ship ] [ rank ] = 0 then begin
                exit ;
        end ;
        for i := 1 to h do
                for j := 1 to w do
                        if ok then begin
                                putinto ;
                                get ( ship + 1 , 1 ) ;
                                takeout ;
                                if tot >= 33 then exit ;
                        end ;
        get ( ship , rank + 1 ) ;
end ;

procedure count ;
var
        i , j , k :     longint ;
begin
        fillchar ( num , sizeof ( num ) , 0 ) ;
        for k := 1 to tot do
                if not use [ k ] then begin
                for i := 1 to h do
                        for j := 1 to w do
                                if map [ i , j ] = 2 then
                                if s [ k ] [ i ] [ j ] = 0 then begin
                                inc ( num [ i , j ] ) ;
                                r [ i , j ] := k ;
                                end ;
                end ;
end ;

function canguess :     boolean ;
var
        find    :       boolean ;
        n       ,
        i , j   :      longint ;
begin
        n       := tot ;
        find    := true ;
        fillchar ( f , sizeof ( f ) , 0 ) ;
        while find do
                begin
                        if n = 1 then break ;
                        count ;
                        find := false ;
                        for i := 1 to h do begin
                                for j := 1 to w do
                                if ( not f [ i , j ] ) and ( num [ i , j ] = 1 ) and ( not use [ r [ i , j ] ] ) then begin
                                        find := true ;
                                        use [ r [ i ] [ j ] ] := true ;
                                        f [ i , j ] := true ;
                                        dec ( n ) ;
                                        break ;
                                end ;
                                if find then break ;
                        end ;


                end ;
        if n = 1 then canguess := true
                else canguess := false ;
end ;

begin
        c       := 0 ;
        readln ( h , w ) ;
        while h + w <> 0 do begin
                init ;
                inc ( c ) ;
                get ( 1 , 1 ) ;
                writeln ( 'Game #' , c ) ;
                if tot >= 33 then writeln ( 'no.' )
                else
                        if canguess then  writeln ( 'yes.' )
                        else writeln ( 'no.' ) ;
                readln ;
                readln ( h , w ) ;
                writeln ;
        end ;
end.