Program Pz;
      { 3x3 }          {$X+}
Uses Crt , Dos;
                    { x -- 1   ;   o -- 0   ;  EMPTY  -- 10   }

Const
      Max = 3;
 CheckNum = 9;

 Var
   Field : Array [ 1 .. 3 , 1 .. 3 ] of byte;
            X , Y , Side , Sd , Sum , MaxSum : Byte;
                   SwX , SwY , SwapX , SwapY : Byte;
                                       Check : Boolean;
                                          Us : Char;


Procedure OutField;
 Var
  A , B : Byte;
 Begin
  ClrScr;
 For X := 1 to 2 do for Y := 1 to 5 do
  begin
   GoToXY ( X * 2 , Y );
   Write ( '█');
   GoToXY ( Y , X * 2 );
   Write ( '█' );
  end;
 For X := 1 to 3 do for Y := 1 to 3 do
   begin
     A := X * 2 - 1;
     B := Y * 2 - 1;
    GoToXY ( A , B );
     Case Field [ X , Y ] of
     10 : Write ( ' ' );
      1 : Write ( 'X' );
      0 : Write ( 'O' );
     end;
   end;
 End;

Procedure VerVic; Forward;

Procedure SetCell ( X , Y , Position : Byte );
  Begin
   If Field [ X , Y ] = 10 then begin
                   If Position = Side then Check := True;
                   Field [ X , Y ] := Position;
                                 end;
   OutField;
   VerVic;
  End;


Procedure Input ( Ps : Byte );
  Var X , Y : Byte;
 Begin
  Repeat
   WriteLn( ' Enter  X , Y !');
   ReadLn ( X , Y );
  Until ( X in [ 1 .. 3 ] ) and ( Y in [ 1 .. 3 ] );
  If Field [ X , Y ] = 10 then SetCell (  X , Y , Ps )
  else begin ClrScr; OutField; Input ( Ps ) end;
 End;

 Procedure InitField;
  Begin
    ClrScr;
   For X := 1 to 3 do for Y := 1 to 3 do Field [ X , Y ] := 10;
  End;

Procedure Contra;
 Begin
  Check := True;
  SetCell ( SwapX , SwapY , Side );
 End;

Procedure FullVictory;
 Var S : Char;
 Begin
  If Sd = 0 then S := 'o'
            else S := 'x';
  WriteLn( #10'  Victory !  -- ' , S );
  ReadKey;
  Halt;
 End;

Procedure VVictory ( Sd : Byte );
 Begin
  Pz.Sd := Sd;
  VerVic;
   For X := 1 to 3 do
    begin
     Sum := 0;
      For Y := 1 to 3 do
       begin
        Inc ( Sum , Field [ X , Y ] );
        If Field [ X , Y ] = 10 then begin SwapX := X; SwapY := Y; end;
       end;
         If Sum = Sd * 3 then FullVictory;
         If Sum = Sd * 2 + 10 then
                                    Contra;
    end;

   For Y := 1 to 3 do
    begin
     Sum := 0;
      For X := 1 to 3 do
       begin
        Inc ( Sum , Field [ X , Y ] );
        If Field [ X , Y ] = 10 then begin SwapX := X; SwapY := Y; end;
       end;
         If Sum = Sd * 3 then FullVictory;
         If Sum = Sd * 2 + 10 then Contra;
    end;

     Sum := 0;
    For X := 1 to 3 do
     begin
         Inc ( Sum , Field [ X , X ] );
         If Field [ X , X ] = 10 then begin SwapX := X; SwapY := X; end;
        end;
          If Sum = Sd * 3 then FullVictory;
          If Sum = Sd * 2 + 10 then Contra;

     Sum := 0;
    For X := 1 to 3 do
     begin
         Inc ( Sum , Field [ X , 4 - X ] );
     If Field [ X , 4 - X ] = 10 then begin SwapX := X; SwapY := 4 - X; end;
        end;
          If Sum = Sd * 3 then FullVictory;
          If Sum = Sd * 2 + 10 then Contra;

 End;

Procedure SubFind;
 Begin
  If Sum = Sd * 3 then FullVictory;
         {If Sum > MaxSum then begin
                               MaxSum := Sum;
                                SwX := SwapX;
                                SwY := SwapY;
                               end;}
  End;

Procedure VerVic;
 Begin
  For X := 1 to 3 do
    begin
     Sum := 0;
      For Y := 1 to 3 do Inc ( Sum , Field [ X , Y ] );
        SubFind;
    end;

   For Y := 1 to 3 do
    begin
     Sum := 0;
      For X := 1 to 3 do Inc ( Sum , Field [ X , Y ] );
        SubFind;
    end;

     Sum := 0;
    For X := 1 to 3 do Inc ( Sum , Field [ X , X ] );
         SubFind;

     Sum := 0;
    For X := 1 to 3 do Inc ( Sum , Field [ X , 4 - X ] );
    SubFind
 End;

Procedure Niht;
 Begin
  WriteLn ( 'Niht!!!');
  Halt;
 End;


Procedure PlGame;
 Begin
      Check := False;
      SetCell ( 1 , 1 , 1 );
     Input ( 0 );
       If  ( Field [ 2 , 1 ] = 10 )
       and ( Field [ 3 , 1 ] = 10 ) then SetCell ( 3 , 1 , 1 )
                                    else SetCell ( 1 , 3 , 1 );
     Input ( 0 );
     Check := False;
     VVictory ( 1 );
     If not Check then
     VVictory (  0  );
     If not Check then
        If Field [ 3 , 3 ] = 0 then
            If Field [ 2 , 1 ] = 0 then SetCell ( 1 , 3 , 1 )
                                   else SetCell ( 3 , 1 , 1 )
                               else
     If Field [ 2 , 2 ] = 10 then
     SetCell ( 2 , 2 , 1 );
     Input ( 0 );
     Check := False;
     Repeat
      VVictory ( 1 );
      If not Check then VVictory ( 0 );
      Input ( 0 );
     Until False;
 End;

Procedure ZrGame;
 Begin
  Input ( 1 );
   If Field [ 2 , 2 ] = 10 then
    begin   { Х не в центре }
     SetCell ( 2 , 2 , 0 );
     Input ( 1 );
     Check := False;
     VVictory ( 1 );
    If ( not Check ) and ( Field [ 3 , 2 ] = 10 ) then SetCell ( 1 , 2 , 0 );
    If ( not Check ) and ( Field [ 2 , 3 ] = 10 ) then SetCell ( 2 , 1 , 0 );
    If ( not Check ) and ( Field [ 2 , 1 ] = 10 ) then SetCell ( 2 , 3 , 0 );
    If ( not Check ) and ( Field [ 3 , 3 ] = 10 ) then SetCell ( 1 , 1 , 0 );
{    If not Check then SetCell ( 3 , 1 , 0 );                          }
     Input ( 1 );
    Check := False;
    VVictory ( 0 );
    If not Check then VVictory ( 1 );
    If not Check then SetCell ( 3 , 1 , 0 );
    If ( not Check ) and ( Field [ 3 , 1 ] = 10 ) then SetCell ( 1 , 3 , 0 );
    If ( not Check ) and ( Field [ 1 , 1 ] = 10 ) then SetCell ( 3 , 3 , 0 );
    If ( not Check ) and ( Field [ 3 , 3 ] = 10 ) then SetCell ( 1 , 1 , 0 );
    If ( not Check ) and ( Field [ 2 , 1 ] = 10 ) then SetCell ( 2 , 3 , 0 );
    Input ( 1 );
    Check := False;
    VVictory ( 0 );
    If not Check then VVictory ( 1 );
    If not Check then SetCell ( 1 , 2 , 0);
    If not Check then SetCell ( 3 , 2 , 0);
    If not Check then SetCell ( 2 , 1 , 0);
    If not Check then SetCell ( 2 , 3 , 0);
    end
                           else { X B центре }
                            begin
                             SetCell ( 1 , 1 , 0 );
                             Input ( 1 );
                             Check := False;
                              VVictory ( 1 );
                             If not Check then
                              begin
                               SetCell ( 3 , 1 , 0 );
                               Input ( 1 );
                               Check := False;
                               VVictory ( 0 );
                              If not Check then VVictory ( 1 );
                               Input ( 1 );
                               Check := False;
                               VVictory ( 1 );
                              If not Check then SetCell ( 1 , 2 , 0 );
                              end
      else
       begin
        Input ( 1 );
        Check := False;
        VVictory ( 0 );
        If not Check then
         VVictory ( 1 );
        If not Check then SetCell ( 1 , 3 , 0 );
         Input ( 1 );
         Check := False;
        VVictory ( 0 );
        If not Check then VVictory ( 1 );
        If not Check then SetCell ( 3 , 2 , 0 );
       end;
                             end;
 End;

Procedure Game;
 Begin
  If Side = 0 then ZrGame
              else PlGame;
 End;

Begin
Repeat
 ClrScr;
 WriteLn( 'What side do you wish to play?  x - 1    , o - 0 .');
 Us := ReadKey;
Until Us in [ '0'  .. '1' ];
If Us = '0' then Side := 1
            else Side := 0;
InitField;
OutField;
Game;
ReadKey;
End.