whi i got WA. it is simple
const fi = '1195.inp';
max = 3;
so = 8;
line :array[1..so,1..3,1..2] of byte
=( ( (1,1), (1,2), (1,3) ),
( (2,1), (2,2), (2,3) ),
( (3,1), (3,2), (3,3) ),
( (1,1), (2,1), (3,1) ),
( (1,2), (2,2), (3,2) ),
( (1,3), (2,3), (3,3) ),
( (1,1), (2,2), (3,3) ),
( (1,3), (2,2), (3,1) ) );
var a,b :array[1..3,1..3] of char;
kq :byte;
procedure input;
var f :text;
i,j :byte;
st :string;
begin
{assign(f, fi); reset(f);}
for i := 1 to 3 do
begin
readln({f}, st);
while st[1] = ' ' do delete(st,1,1);
while st[ length(st) ] = ' ' do delete(st, length(st), 1);
for j := 1 to 3 do a[i,j] := st[j];
end;
{close(f);}
end;
procedure out;
begin
case kq of
0 : writeln('Draw');
1 : writeln('Crosses win');
2 : writeln('Ouths win');
end;
end;
function thang :boolean;
var i,j :byte;
c :char;
ok :boolean;
begin
thang := true;
for i := 1 to so do
begin
ok := true;
c := b[ line[i,1,1], line[i,1,2] ];
if c = '#' then ok := false;
for j := 1 to 3 do
if b[ line[i,j,1], line[i,j,2] ] <> c
then ok := false;
if ok then exit;
end;
thang := false;
end;
function cross :boolean;
var i,j :byte;
begin
cross := true;
for i := 1 to 3 do
for j := 1 to 3 do
if a[i,j] = '#' then
begin
b := a;
b[i,j] := 'X';
if thang then
begin kq := 1;
exit;
end;
end;
cross := false;
end;
procedure outh;
var i,j,u,v :byte;
ok :boolean;
begin
for i := 1 to 3 do
for j := 1 to 3 do
if a[i,j] = '#' then
begin
b := a; b[i,j] := 'X';
ok := false;
for u := 1 to 3 do
for v := 1 to 3 do
if b[u,v] = '#' then
begin
b[u,v] := 'O';
if thang then ok := true;
b[u,v] := '#';
end;
if not ok then exit;
end;
kq := 2;
end;
procedure solve;
begin
kq := 0;
if cross then exit;
outh;
end;
begin
input;
solve;
out;
end.