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

Const
      Max = 4;
 CheckNum = 9;

 Var
   Field : Array [ 1 .. 4 , 1 .. 4 ] 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 4 do for Y := 1 to 4 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 .. 4 ] ) and ( Y in [ 1 .. 4 ] );
  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 4 do for Y := 1 to 4 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 4 do
    begin
     Sum := 0;
      For Y := 1 to 4 do
       begin
        Inc ( Sum , Field [ X , Y ] );
        If Field [ X , Y ] = 10 then begin SwapX := X; SwapY := Y; end;
       end;
         If Sum = Sd * 4 then FullVictory;
         If Sum = Sd * 3 + 10 then
                                    Contra;
    end;

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

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

     Sum := 0;
    For X := 1 to 4 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 * 4 then FullVictory;
          If Sum = Sd * 3 + 10 then Contra;

 End;




Procedure PlGame;
 Begin
      Check := False;
      SetCell ( 1 , 1 , 1 );
     Input ( 0 );
       If  ( Field [ 2

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.