Крестики-нолики (2 уровень)

Условие:
Игра в крестики-нолики ведётся на квадратном поле 3х3. Играют двое. Начинают "крестики". Каждый из игроков, поочерёдно, ставит свой значок, крестик или нолик, на свободную клетку. Выигрывает тот, кто первым поставит три своих значка вряд по вертикали, горизонтали или диагонали.
Задаётся последовательность ходов. Определить, кто выиграл, "крестики" или "нолики"?

Технические условия:
Последовательность ходов задаётся 9-значным числом. Цифра числа обозначает номер клетки хода, а порядковый номер цифры - номер хода. Клетки пронумерованы, как показано на рисунке
:

7

8

9

4

5

6

1

2

3

 

В примере приведён один из вариантов. Очевидно, что последние два хода лишние, но они нужны для девятизначности кода позиции. Написать программу, которая читает файл INPUT.TXT, содержащий одну строку - последовательность ходов и выводит в текстовый файл OUTPUT.TXT символ "X" (большая латинская буква), если выиграли "крестики", символ "0" (цифра), если выиграли "нолики" или слово "DRAW" (ничья по-английски), если игра закончилась вничью. Правильность кода позиции проверять не надо.

Пример:

X

0

X

0

X

0

X

0

X

 

INPUT.TXT
123456789
OUTPUT.TXT
X


Решение:
var
str:string;f:text;A:array [1..9] of String;i:integer;

function winner:string;
begin
if (A[1]=A[2]) and (A[2]=A[3]) then begin Winner:=A[1];exit;end;
if (A[4]=A[5]) and (A[5]=A[6]) then begin Winner:=A[4];exit;end;
if (A[7]=A[8]) and (A[8]=A[9]) then begin Winner:=A[7];exit;end;
if (A[1]=A[4]) and (A[4]=A[7]) then begin Winner:=A[1];exit;end;
if (A[2]=A[5]) and (A[5]=A[8]) then begin Winner:=A[2];exit;end;
if (A[3]=A[6]) and (A[6]=A[9]) then begin Winner:=A[3];exit;end;
if (A[1]=A[5]) and (A[5]=A[9]) then begin Winner:=A[1];exit;end;
if (A[3]=A[5]) and (A[5]=A[7]) then begin Winner:=A[3];exit;end;
Winner:='DRAW';
end;

begin
assign(f,'input.txt');
reset(f);
readln(f,str);
close(f);
for i:=1 to 9 do begin
if (i mod 2)=0 then begin
case Str[i] of
'1':A[1]:='0';
'2':A[2]:='0';
'3':A[3]:='0';
'4':A[4]:='0';
'5':A[5]:='0';
'6':A[6]:='0';
'7':A[7]:='0';
'8':A[8]:='0';
'9':A[9]:='0';end;end else begin
case Str[i] of
'1':A[1]:='X';
'2':A[2]:='X';
'3':A[3]:='X';
'4':A[4]:='X';
'5':A[5]:='X';
'6':A[6]:='X';
'7':A[7]:='X';
'8':A[8]:='X';
'9':A[9]:='X';END;end;
if (i=9) and (Winner='DRAW') then begin
assign(f,'Output.txt');
rewrite(f);
writeln(f,'DRAW');close(f);end;
if Winner='X' then begin
assign(f,'Output.txt');
rewrite(f);
writeln(f,'X');close(f);Exit;end;
if Winner='0' then begin
assign(f,'Output.txt');
rewrite(f);
writeln(f,'0');close(f);Exit;end;
end;
end.