Program Game;
uses crt;
Type  TCellNumber=0..8;
      TLabel=(cross,null,empty);
      TCells=record
      x,y:byte;
      CellLabel:TLabel
end;
Const Angle:set of TCellNumber=[0,2,4,6];
Var Field:TField=array[TCellNumber] of TCells;
    Turn,
    OldTurn:TCellNumber;
    i:TCellNumber;
{-----------------------------------------------------------------------}
Function Next(i,k:TCellNumber);TCellNumber;
{$R-}
begin
     i:=i+k;
     Next:=i mod 8;
     {$R-}
end;
{-----------------------------------------------------------------------}
Procedure DrawField;
Var i:TCellNumber;
begin
     ClrScr;
     Window(20,10,34,17);
     TextBackGround(0);
     GoToXY(1,1):Write('|----|----|----|');
     GoToXY(1,2):Write('|    |    |    |');
     GoToXY(1,3):Write('|----|----|----|');
     GoToXY(1,4):Write('|    |    |    |');
     GoToXY(1,5):Write('|----|----|----|');
     GoToXY(1,6):Write('|    |    |    |');
     GoToXY(1,7):Write('|____|____|____|');
     for i:=0 to 8 do with Field[i] do begin
         GoToXY(X-1,Y);
         case CellLabel of
              cross:write('-+-');
              null:write('0')
         end
     end
end;
{-----------------------------------------------------------------------}
Procedure SetCross(Cell:TCellNumber);
begin
     Field[Cell].CellLabel:=Cross;
     DrawField
end;
{-----------------------------------------------------------------------}
Procedure Victory;
begin
     Window(1,1,20,20);
     Write('Победа компьютера!')
end;
{-----------------------------------------------------------------------}
Procedure Draw;
begin
     Window(1,1,20,20);
     Write('Ничья!')
end;
{-----------------------------------------------------------------------}
Procedure Dialog;
const Up='H';
      Down='P';
      Right='M';
      Left='K';
Var   Key:char;
      CurrentCell:TCellNumber;
{-----------------------------------------------------------------------}
Procedure DrawBorder;
begin
     TextBackGround(Red);
     with Field[CurrentCell] do begin
          GoToXY(X-2,Y-1);Write('|--|');
          GoToXY(X-2,Y);Write('|');
          GoToXY(X+2,Y);Write('|');
          GoToXY(X-2,Y+1);Write('|__|');
     end;
     TextBackGround(Black)
end;
{-----------------------------------------------------------------------}
Procedure MySound;
begin
     Sound(1000);
     Delay(300);
     NoSound
end;
{-----------------------------------------------------------------------}
begin
     CurrentCell:=8;
     DrawField;
     DrawBorder;
     OldTurn:=Turn;
     repeat
           Key:=ReadKey;
           case Key of
                Up:case CurrentCell of
                        0..2:MySound;
                        3,4:CurrentCell:=CurrentCell-1;
                        5:CurrentCell:=8;
                        6:CurrentCell:=7;
                        7:CurrentCell:=0;
                        8:CurrentCell:=1
                   end;
                Down:case CurrentCell of
                        4..6:MySound;
                        2,3:CurrentCell:=CurrentCell+1;
                        0:CurrentCell:=7;
                        1:CurrentCell:=8;
                        7:CurrentCell:=6;
                        8:CurrentCell:=5
                     end;
                Right:case CurrentCell of
                        2..4:MySound;
                        0,1:CurrentCell:=CurrentCell+1;
                        5,6:CurrentCell:=CurrentCell-1;
                        7:CurrentCell:=8;
                        8:CurrentCell:=3;
                        7:CurrentCell:=0;
                        8:CurrentCell:=1
                      end;
                Left:case CurrentCell of
                        0,6,7:MySound;
                        1,2,8:CurrentCell:=CurrentCell-1;
                        4,5:CurrentCell:=CurrentCell+1;
                        3:CurrentCell:=8;
                      end
           end;
           DrawField;
           DrawBorder;
     until Key=#13 and Field[CurrentCell].CellLabel=empty;
     Field[CurrentCell].CellLabel:=null;
     DrawField;
     Turn:=CurrentCell
end;
{-----------------------------------------------------------------------}
begin
     for i:=0 to8 do with Field[i] do begin
         CellLabel:=empty;
         case i of
              0:begin x:=3;y:=2 end;
              1:begin x:=7;y:=2 end;
              2:begin x:=11;y:=2 end;
              3:begin x:=11;y:=4 end;
              4:begin x:=11;y:=6 end;
              5:begin x:=7;y:=6 end;
              6:begin x:=3;y:=6 end;
              7:begin x:=3;y:=4 end;
              8:begin x:=7;y:=4 end;
         end
     end;
     SetCross(8);
     Dialog;
     if Turn in Angle then
        begin
             SetCross(Next(Turn,2));
             Dialog;
             if Turn<>Next(OldTurn,6)
                then begin
                     SetCross(Next(OldTurn,6));
                     Victory
                end;
             else begin
                  SetCross(Next(Turn,1));
                  Dialog;
                  if Turn<>Next(OldTurn,5)
                     then begin
                          SetCross(Next(OldTurn,5));
                          Victory
                     end
                  else begin
                       SetCross(Next(Turn,2));
                       Dialog;
                       if Turn<>Next(OldTurn,6)
                          then begin
                               SetCross(Next(OldTurn,6));
                               Victory
                          end
                       else begin
                            SetCross(Next(Turn,3));
                            Draw
                       end
                  end
             end
             SetCross(Next(Turn,3));
             Dialog;
             if Turn<>Next(OldTurn,7)
                then begin
                     SetCross(Next(OldTurn,7));
                     Victory
                end
             else begin
                  SetCross(Next(Turn,2));
                  Dialog;
                  if Turn<>Next(OldTurn,3)
                     then begin
                          SetCross(Next(OldTurn,3));
                          Victory
                     end
                  else begin
                       SetCross(Next(Turn,5));
                       Victory
                  end
             end
        end;
     Readln
end.



