TicTacToePascal

program Tictactoe;

type
    TState = char;  {'X', 'O', arba ' '}
    TPosition = (A1, A2, A3, B1, B2, B3, C1, C2, C3);
    TGame = array[TPosition] of TState;
    TLines = array[1..8, 1..3] of TPosition;

const
    Lines: TLines = (
      {eilutes}
        (A1, A2, A3),
        (B1, B2, B3),
        (C1, C2, C3),
      {stulpeliai}
        (A1, B1, C1),
        (A2, B2, C2),
        (A3, B3, C3),
      {istrizaines}
        (A1, B2, C3),
        (C1, B2, A3)
    );

    BlankGame: TGame = (
        ' ', ' ', ' ',
        ' ', ' ', ' ',
        ' ', ' ', ' '
    );

var
    Game: TGame;
    Win: boolean;
    PlayAgain: char;

procedure ShowGame;
begin
    writeln;
    writeln('    1   2   3');
    writeln;
    writeln('A   ', Game[A1], ' | ', Game[A2], ' | ', Game[A3]);
    writeln('   ---+---+---');
    writeln('B   ', Game[B1], ' | ', Game[B2], ' | ', Game[B3]);
    writeln('   ---+---+---');
    writeln('C   ', Game[C1], ' | ', Game[C2], ' | ', Game[C3]);
    writeln;
end;

function FindTwo(SS: char): boolean;
var
    I, J, Cnt, Spc: integer;
    S: char;
begin
    FindTwo:= true;
    for I:= 1 to 8 do
        begin
             Cnt:= 0;
             Spc:= 0;
             for J:= 1 to 3 do
                 begin
                      S:= Game[Lines[I,J]];
                      if S = SS then inc(Cnt);
                      if S = ' ' then Spc:= J;
                 end;
        if (Cnt = 2) and (Spc > 0) then
           begin
                Game[Lines[I,Spc]]:= 'X';
                exit;
           end;
        end;
    FindTwo:= false;
end;

procedure MakeMoveForX;
begin
    {Truksta 1 X}
    if      FindTwo('X') then Win:= true
    {Truksta 1 O}
    else if FindTwo('O') then
    {Centras}
    else if Game[B2] = ' ' then Game[B2]:= 'X'
    {Kampai}
    else if Game[A1] = ' ' then Game[A1]:= 'X'
    else if Game[A3] = ' ' then Game[A3]:= 'X'
    else if Game[C1] = ' ' then Game[C1]:= 'X'
    else if Game[C3] = ' ' then Game[C3]:= 'X'
    {Like}
    else if Game[A2] = ' ' then Game[A2]:= 'X'
    else if Game[B1] = ' ' then Game[B1]:= 'X'
    else if Game[B3] = ' ' then Game[B3]:= 'X'
    else if Game[C2] = ' ' then Game[C2]:= 'X';
end;

procedure GetMoveForO;
var
    Code: string[2];
    P, D, M: integer;
    Good: boolean;

const
    CodeList = 'A1 A2 A3 B1 B2 B3 C1 C2 C3';

begin
    repeat
        write('Your move? [A1..C3]: ');
        readln(Code);
        Code[1]:= UpCase(Code[1]);
        P:= Pos(Code, CodeList);
        D:= P div 3;
        M:= P mod 3;
        Good:= (P > 0) and (M = 1);
        if Good and (Game[TPosition(D)] <> ' ') then Good:= false;
    until Good;
    Game[TPosition(D)]:= 'O';
end;

procedure PlayGame(N: integer);
var
    Move: integer;

begin
    Game:= BlankGame;
    Win:= false;
    ShowGame;

    for Move:= 1 to 9 do begin
        if (Move mod 2) = N then
           begin
                writeln('My move:');
                MakeMoveForX;
           end
        else  GetMoveForO;
        ShowGame;
        if Win then begin
            writeln('Game over.  I won.');
            break;
        end;
    end;

    if not Win then writeln('Game over.  Nobody won.');

    write('Play again? [Y/N]: ');
    readln(PlayAgain);
    PlayAgain:= UpCase(PlayAgain);
end;

var
    Turn: integer;

begin
    Turn:= 1;
    repeat
        PlayGame(Turn);
        Turn:= 1 - Turn;
    until PlayAgain = 'N';
end.