Program
                     Kurs_check;
             Uses
                  Graph,Crt;
             Type
                  Position = record
                                x,y : integer;
                             end;
                  ChessType = (W,WD,B,BD,N,G);
                  DeskType  = array[-3..14,-3..14] of ChessType;

                  TPlayer = object
                    Start,Finish   : Position;
                    Color          : boolean;{.t. если белые}
                    Fight          : boolean;{.t. если нужно бить}
                    loose           : boolean;{.t. если проиграл}
                    procedure      Init (_Color : Boolean);
                  end;

                 TDesk = object
                    Desk        : DeskType;
                    sx,sy       : word;
                    procedure   Init;
                    procedure   Draw;
                    procedure   DrawFigure(x,y:Word;f:ChessType);
                    function    NoStep    (Player:TPlayer):boolean;
                    function    NoStep2    (Player:TPlayer):boolean;
                    function    MoveFrom  (Player:TPlayer):boolean;
                    function    MoveFrom2  (Player:TPlayer):boolean;
                    function    NoFight   (Player:TPlayer):boolean;
                    function    NoFight2   (Player:TPlayer):boolean;
                    function    can_move  (Player:TPlayer):boolean;
                    function    can_move2  (Player:TPlayer):boolean;
                    function    must_fight (Player:TPlayer):boolean;
                    function    must_fight2 (Player:TPlayer):boolean;
                    function    Analise   (var Player:TPlayer):boolean;
                    procedure   ScanDamk;

                  end;

                  TGame = object
                   Desk         : TDesk;
                   GameOver     : boolean;
                   procedure    Init;
                   procedure    Run;
                   procedure    Play (var Player : TPlayer);

                  end;
                  const sx=45;
                  DeskInit : DeskType = ((G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G),
                                         (G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G),
                                         (G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G),
                                         (G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G),
                                         (G,G,G,G,N,W,N,W,N,W,N,W,N,W,G,G,G,G),
                                         (G,G,G,G,W,N,W,N,W,N,W,N,W,N,G,G,G,G),
                                         (G,G,G,G,N,W,N,W,N,W,N,W,N,W,G,G,G,G),
                                         (G,G,G,G,W,N,W,N,W,N,W,N,W,N,G,G,G,G),
                                         (G,G,G,G,N,N,N,N,N,N,N,N,N,N,G,G,G,G),
                                         (G,G,G,G,N,N,N,N,N,N,N,N,N,N,G,G,G,G),
                                         (G,G,G,G,N,B,N,B,N,B,N,B,N,B,G,G,G,G),
                                         (G,G,G,G,B,N,B,N,B,N,B,N,B,N,G,G,G,G),
                                         (G,G,G,G,N,B,N,B,N,B,N,B,N,B,G,G,G,G),
                                         (G,G,G,G,B,N,B,N,B,N,B,N,B,N,G,G,G,G),
                                         (G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G),
                                         (G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G),
                                         (G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G),
                                         (G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G));
                     Var    Game : TGame;
                     Player1: TPlayer;
                    Player2: TPlayer;
                    ii,jj:integer;
                    kto : byte;
                    Checks:array[chesstype]of byte;

                    procedure Beep;
          {пищит}
             begin
                  {write(#7);}
             end;

                    procedure TGame.Init;
          {инициализация графики}
            var
               Gd,Gm : Integer;
            begin
               Gd := EGA;
               Gm := EGAhi;
               InitGraph(Gd,Gm,'');
               if GraphResult<> 0
                  then begin
                        writeln('Ошибка инициализации графики');
                        halt(0);
                       end;
               GameOver := False;
               Desk.Init;
            end;


          procedure TDesk.Init;
          {установка размера игрового поля и всех графических объектов кроме текста}
            begin
                 Desk:=DeskInit;
                 sx := 45;
            end;

           procedure TGame.Run;
          {выдача сообщений, инициализация игроков и запуск др. модулей}
            begin

                 Desk.Draw;
                 Player1.Init(True);
                 Player2.Init(False);
             repeat
             Desk.DrawFigure(30,30,W);
              if Desk.NoStep(Player1)
                   then
                    begin
                     Player1.loose:=True;
                     GameOver := True;
                    end;
                 play(player1);

             Desk.DrawFigure(30,30,B);
             readkey; if readkey='e' then exit;

                if Desk.NoStep2(Player2)
                   then
                    begin
                     Player2.loose:=True;
                     GameOver := True;
                    end;
                 play(player2);
             readkey; if readkey='e' then exit;
             until GameOver;
            end;

            function TDesk.NoStep;
          {возвращает .T. если у игрока (Color=.t. - W; Color=.f. - B) нет ходов}
          var
             p    : Position;
             f    : boolean;
          begin
               p := Player.Start;
               f := False;
               with Player.Start do
                for y:=1 to 10 do
                 for x:=1 to 10 do
                  f := f or can_move(Player) or must_fight(player);
               Player.Start := p;
               NoStep := not f;
          end;

          function TDesk.NoStep2;
          {возвращает .T. если у игрока (Color=.t. - W; Color=.f. - B) нет ходов}
          var
             p    : Position;
             f    : boolean;
          begin
               p := Player2.Start;
               f := False;
               with Player2.Start do
                for y:=1 to 10 do
                 for x:=1 to 10 do
                  f := f or can_move2(Player2) or must_fight2(player2); {nb}
               Player2.Start := p;
               NoStep2 := not f;
          end;

            procedure TDesk.Draw;{рисует доску и фигуры по данным массива фигур}
          var
             i,j   : byte;
             f     : boolean;
             ax,ay : word;
             dx,dy : word;
          begin
             f:=True;
             GetAspectRatio(ax,ay);
             SetWriteMode(CopyPut);
             SetLineStyle(0,0,1);
             sy := round(sx/ay*ax);

             dx := GetMaxX div 2 - 5 * sx;
             dy := GetMaxY div 2 - 5 * sy;
             SetWriteMode(CopyPut);
             for j:=0 to 9 do
              begin
               for i:=0 to 9 do
                begin
                 if f then SetFillStyle(1,15)
                      else SetFillStyle(1,22);
                 bar(i*sx+dx,j*sy+dy,(i+1)*sx+dx,(j+1)*sy+dy);
                 DrawFigure(i*sx+dx+sx div 2,j*sy+dy+sy div 2,Desk[j+1][i+1]);
                 f:= not f;
                end;
               f := not f;
              end;
          end;

          procedure TDesk.DrawFigure;
          {рисует шашаку используя передаваемые координаты и параметры -
           - цвет, дамка/не дамка}
          var
             rx,ry : word;
          begin
             rx := 2 * sx div 5;
             ry := 2 * sy div 5;

             SetWriteMode(CopyPut);
             SetLineStyle(0,0,1);

             case f of
              W,WD   : begin
                       SetFillStyle(1,15);
                       SetColor(15);
                       end;
              B,BD   : begin
                       SetFillStyle(1,0);
                       SetColor(0);
                       end;
             end;

             case f of
              W,B   : begin
                       FillEllipse(x,y,rx,ry);
                       SetColor(7);
                       Arc(x,y,45,225,rx+1);
                       Arc(x,y,45,225,2 * rx div 3 + 1);
                       Arc(x,y,45,225,rx div 3 + 1);
                       Arc(x,y,225,45,rx-1);
                       Arc(x,y,225,45,2 * rx div 3 - 1);
                       Arc(x,y,225,45,rx div 3 - 1);
                       SetColor(8);
                       Arc(x,y,45,225,rx-1);
                       Arc(x,y,45,225,2 * rx div 3 - 1);
                       Arc(x,y,45,225,rx div 3 - 1);
                       Arc(x,y,225,45,rx+1);
                       Arc(x,y,225,45,2 * rx div 3 + 1);
                       Arc(x,y,225,45,rx div 3 + 1);
                      end;
              WD,BD : begin
                       FillEllipse(x,y,rx,ry);
                       SetColor(7);
                       Arc(x,y,45,225,rx+1);
                       Arc(x,y,225,45,rx-2);
                       SetColor(8);
                       Arc(x,y,45,225,rx-2);
                       Arc(x,y,225,45,rx+1);
                      end;
             end;



          end;

           procedure TPlayer.Init;{инициализация игроков}
          begin
               loose := False;
               Fight:=False;
               Color:=_Color; {передается как параметр (T/F)}
               if Color
                  then
                   begin
                    Start.x:=5;  {нач установка курсора}
                    Start.y:=4;
                   end
                  else
                   begin
                    Start.x:=6;
                    Start.y:=7;
                   end
          end;
           procedure TGame.Play;
          {основная процедура игры. Осуществляет координацию модулей и движение курсора
          выполняется когда ход принадлежит человеку}
          procedure Select (p:position);{рисует курсор по передаваемым координатам}
          var
             dx,dy : word;
          begin
               SetWriteMode(XorPut);
               SetLineStyle(0,0,3);
               SetColor(15);

               with p, Desk do
                begin
                 x:=x-1;y:=y-1;
                 dx := GetMaxX div 2 - 5 * sx;
                 dy := GetMaxY div 2 - 5 * sy;
                 Graph.MoveTo(x*sx+dx,y*sy+dy);
                 LineTo((x+1)*sx+dx,y*sy+dy);
                 LineTo((x+1)*sx+dx,(y+1)*sy+dy);
                 LineTo(x*sx+dx,(y+1)*sy+dy);
                 LineTo(x*sx+dx,y*sy+dy);
                end;
          end;

           procedure Select1 (p:position);{рисует курсор по передаваемым координатам}
          var
             dx,dy : word;
          begin
               SetWriteMode(CopyPut);
               SetLineStyle(0,0,3);
               SetColor(3);

               with p, Desk do
                begin
                 x:=x-1;y:=y-1;
                 dx := GetMaxX div 2 - 5 * sx;
                 dy := GetMaxY div 2 - 5 * sy;
                 Graph.MoveTo(x*sx+dx,y*sy+dy);
                 LineTo((x+1)*sx+dx,y*sy+dy);
                 LineTo((x+1)*sx+dx,(y+1)*sy+dy);
                 LineTo(x*sx+dx,(y+1)*sy+dy);
                 LineTo(x*sx+dx,y*sy+dy);
                end;
          end;

          const
               SelectStart  = 1;
               SelectNext   = 2;

          var
               State : byte;
               P,Q   : Position;
               D     : DeskType;
               F     : Boolean;

          begin
                 { if GameOver then exit;}

                  with Player, Desk, P do
                   begin
                    P:=Start;
                    D := Desk;
                    F := Fight;
                    Q := P;
                    State := SelectStart;
                    Select(P);  {нарисовали курсор}

                    repeat

                    if keypressed
                       then
                        case readkey of
                         #0  : begin {обработка стрелок - перемещение курсора}
                                Select(P); {стерли курсор}
                                case readkey of
                                 'K' : x:=x-1;
                                 'M' : x:=x+1;
                                 'H' : y:=y-1;
                                 'P' : y:=y+1;
                                end;
                                if x<1 then x:=10;
                                if y<1 then y:=10;
                                if x>10 then x:=1;
                                if y>10 then y:=1;
                                Select(P); {нарисовали новый}
                               end;
                      ' ', #13 : case State of
                                SelectStart : begin
                              if Color then
                                           begin
                                               Start := P;
                                               if MoveFrom (Player)
                                                 then
                                                  begin
                                                   Fight:=False;
                                                   State:=SelectNext;
                                                   Select1(P);
                                                   Q:=P
                                                  end
                                               else Beep;
                                           end
                                               else
                                                begin
                                                Start := P;
 { !!!!!!!!!!!!!!!!!!!!!!!!!!!!!проблема!!!!!!} if MoveFrom2 (Player)
                                                 then
                                                  begin
                                                   Fight:=False;
                                                   State:=SelectNext;
                                                   Select1(P);
                                                   Q:=P
                                                  end
                                               else Beep;
                                               end;
                                               end;

                                SelectNext : begin
                                              Finish := P;
                                           if Color then
                                           begin
                                              if Analise (Player)
                                                 then
                                                  if Fight
                                                     then
                                                      begin
                                                       Start := Finish;
                                                       if must_fight(Player)
                                                          then Select(P)
                                                          else break
                                                      end
                                                     else break
                                                 else Beep;
                                           end else
                                           begin
                                              if Analise (Player)
                                                 then
                                                  if Fight
                                                     then
                                                      begin
                                                       Start := Finish;
                                                       if must_fight2(Player)
                                                          then Select(P)
                                                          else break
                                                      end
                                                     else break
                                                 else Beep;
                                           end;
                                             end;
                               end;
                        'Q','q' : begin
                                State := SelectStart;
                                Fight := F;
                                Desk := D;
                                P := Q;
                                Draw;
                                Select(P);
                               end;
                           #27  : begin
                                   GameOver := True;
                                   break;
                                  end;
                        end;
                    until False;
                    Fight := False;
                    ScanDamk;{count; nowin; }
                   end;
          end;

          function TDesk.MoveFrom;{проверяет возможность хода из данной клетки}
          begin
               if NoFight(Player) then MoveFrom := can_move(Player)
                                  else MoveFrom := must_fight(Player)
          end;

           function TDesk.MoveFrom2;{проверяет возможность хода из данной клетки}
          begin
               if NoFight2(Player2) then MoveFrom2 := can_move2(Player2)
                                  else MoveFrom2 := must_fight2(Player2)
          end;

          function TDesk.NoFight;
          {возвращает .t. если бить нечего}
          var
             f    : boolean;
          begin
               f := False;
               with Player.Start do
                for y:=1 to 10 do
                 for x:=1 to 10 do
                  f := f or must_fight(Player);
               NoFight := not f;
          end;

          function TDesk.NoFight2;
          {возвращает .t. если бить нечего}
          var
             f    : boolean;
          begin
               f := False;
               with Player2.Start do
                for y:=1 to 10 do
                 for x:=1 to 10 do
                  f := f or must_fight2(Player2);
               NoFight2 := not f;
          end;

          function TDesk.can_move;
          {возвращает .t. если в текущей клетке есть шашка и ею можно походить}
          var
             f : boolean;
          begin
               with Player, Start do
                if Color
                   then
                    case Desk[y][x] of
                     W   : f := (Desk[y+1][x+1] = N) or (Desk[y+1][x-1] = N);
                     WD  : f := (Desk[y+1][x+1] = N) or (Desk[y+1][x-1] = N) or
                                (Desk[y-1][x+1] = N) or (Desk[y-1][x-1] = N)
                     else f := False

                    end;
               can_move := f;
          end;

           function TDesk.can_move2;
          {возвращает .t. если в текущей клетке есть шашка и ею можно походить}
          var
             f : boolean;
          begin
               with Player2, Start do
                    case Desk[y][x] of
                     B   : f := (Desk[y-1][x+1] = N) or (Desk[y-1][x-1] = N);
                     BD  : f := (Desk[y+1][x+1] = N) or (Desk[y+1][x-1] = N) or
                                (Desk[y-1][x+1] = N) or (Desk[y-1][x-1] = N)
                     else f := False
                    end;
               can_move2 := f;
          end;

          function TDesk.must_fight;
          {возвращает .t. если в текущей позиции есть фишка и она должна что - то бить}
          var
             f       : boolean;
             i       : integer;
          begin
               with Player, Start do
                if Color
                   then
                    case Desk[y][x] of
                     W   : f := ((Desk[y+2][x+2] = N) and (Desk[y+1][x+1] in [B,BD])) or
                                ((Desk[y+2][x-2] = N) and (Desk[y+1][x-1] in [B,BD])) or
                                ((Desk[y-2][x-2] = N) and (Desk[y-1][x-1] in [B,BD])) or
                                ((Desk[y-2][x+2] = N) and (Desk[y-1][x+1] in [B,BD]));
                     WD  : begin
                            i:=1;
                            while Desk[y+i][x+i] = N do inc (i);
          {ищем ближайшую шашку в этом направлении}
                            f:=(Desk[y+i][x+i] in [B,BD]) and (Desk[y+i+1][x+i+1] = N);
          {если эта шашка черных и за ней нет ничего - надо бить (f=.t.)}
                            i:=1;
                            while Desk[y-i][x+i] = N do inc (i);
                            f:=f or (Desk[y-i][x+i] in [B,BD]) and (Desk[y-i-1][x+i+1] = N);

                            i:=1;
                            while Desk[y-i][x-i] = N do inc(i);
                            f:=f or (Desk[y-i][x-i] in [B,BD]) and (Desk[y-i-1][x-i-1] = N);

                            i:=1;
                            while Desk[y+i][x-i] = N do inc(i);
                            f:=f or (Desk[y+i][x-i] in [B,BD]) and (Desk[y+i+1][x-i-1] = N);
                           end;
                     else f:= False;

                    end;
               must_fight := f;
          end;

          function TDesk.must_fight2;
          {возвращает .t. если в текущей позиции есть фишка и она должна что - то бить}
          var
             f       : boolean;
             i       : integer;
          begin
               with Player2, Start do
                    case Desk[y][x] of
                     B   : f := ((Desk[y+2][x+2] = N) and (Desk[y+1][x+1] in [W,WD])) or
                                ((Desk[y+2][x-2] = N) and (Desk[y+1][x-1] in [W,WD])) or
                                ((Desk[y-2][x-2] = N) and (Desk[y-1][x-1] in [W,WD])) or
                                ((Desk[y-2][x+2] = N) and (Desk[y-1][x+1] in [W,WD]));
                     BD  : begin
                            i:=1;
                            while Desk[y+i][x+i] = N do inc (i);
                            f:=(Desk[y+i][x+i] in [W,WD]) and (Desk[y+i+1][x+i+1] = N);

                            i:=1;
                            while Desk[y-i][x+i] = N do inc (i);
                            f:=f or (Desk[y-i][x+i] in [W,WD]) and (Desk[y-i-1][x+i+1] = N);

                            i:=1;
                            while Desk[y-i][x-i] = N do inc(i);
                            f:=f or (Desk[y-i][x-i] in [W,WD]) and (Desk[y-i-1][x-i-1] = N);

                            i:=1;
                            while Desk[y+i][x-i] = N do inc(i);
                            f:=f or (Desk[y+i][x-i] in [W,WD]) and (Desk[y+i+1][x-i-1] = N);
                           end
                     else f := False
                    end;
               must_fight2 := f;
          end;

          function TDesk.Analise;
          {возвращает .f. если введенный ход не соответствует правилам игры
           использует нач. и кон. коорд. положения курсора, а так же
           расположение шашек на доске}
          var
             f,f_                  : boolean;
             dx,dy,ix,iy,x,y,cw,cb : Integer;
          begin
             with Player do
              if Color
                 then
                  begin
                   case Desk[Start.y][Start.x] of
                    W   : begin
                           if Fight then f := False else
                           f := (Finish.y-Start.y=1) and
                                 (abs(Finish.x-Start.x)=1) and
                                 (Desk[Finish.y][Finish.x] = N);
                           x := (Start.x+Finish.x) div 2;
                           y := (Start.y+Finish.y) div 2;
                           Fight := (abs(Finish.y-Start.y)=2) and
                                    (abs(Finish.x-Start.x)=2) and
                                    (Desk[Finish.y][Finish.x]=N) and
                                    (Desk[y][x] in [B,BD]);
                          end;
                    WD  : begin
                           if Finish.x>Start.x then dx := 1
                                               else dx := -1;
                           if Finish.y>Start.y then dy := 1
                                               else dy := -1;
                           ix:=Start.x+dx;
                           iy:=Start.y+dy;
                           f_ := (abs(Finish.x-Start.x) = abs(Finish.y-Start.y)) and
                                 (Desk[Finish.y][Finish.x]=N);
                           cw:=0;
                           cb:=0;
                           if f_ then repeat
                             if Desk[iy][ix] in [W,WD] then inc(cw);
                             if Desk[iy][ix] in [B,BD]
                                then
                                 begin
                                  inc(cb);
                                  x:=ix;
                                  y:=iy;
                                 end;
                             if (ix=Finish.x) or (iy=Finish.y) then break;
                             ix :=ix + dx;
                             iy :=iy + dy;
                           until (ix=Finish.x) or (iy=Finish.y);
                           if Fight then f := false
                                    else f := (cb=0) and (cw=0) and f_;
                           Fight := (cb=1) and (cw=0) and f_;
                          end
                    else f := False
                   end;
                   if f or Fight
                      then begin
                            Desk[Finish.y][Finish.x]:=Desk[Start.y][Start.x];
                            Desk[Start.y][Start.x] := N;
                            if (Finish.y = 10)
                               then Desk[Finish.y][Finish.x]:=WD;
                            if Fight then Desk[y][x]:=N;
                            Draw;
                           end
                  end
                 else
                  begin
                   case Desk[Start.y][Start.x] of
                    B   : begin
                           if Fight then f := False else
                           f := (Start.y-Finish.y=1) and
                               (abs(Finish.x-Start.x)=1) and
                               (Desk[Finish.y][Finish.x] = N);
                           x := (Start.x+Finish.x) div 2;
                           y := (Start.y+Finish.y) div 2;
                           Fight := (abs(Finish.y-Start.y)=2) and
                                    (abs(Finish.x-Start.x)=2) and
                                    (Desk[Finish.y][Finish.x]=N) and
                                    (Desk[y][x] in [W,WD]);
                          end;
                    BD  : begin
                           if Finish.x>Start.x then dx := 1
                                               else dx := -1;
                           if Finish.y>Start.y then dy := 1
                                               else dy := -1;
                           ix:=Start.x+dx;
                           iy:=Start.y+dy;
                           f_ := (abs(Finish.x-Start.x) = abs(Finish.y-Start.y)) and
                                 (Desk[Finish.y][Finish.x]=N);
                           cw:=0;
                           cb:=0;
                           if f_ then repeat
                             if Desk[iy][ix] in [B,BD] then inc(cb);
                             if Desk[iy][ix] in [W,WD]
                                then
                                 begin
                                  inc(cw);
                                  x:=ix;
                                  y:=iy;
                                 end;
                             if (ix=Finish.x) or (iy=Finish.y) then break;
                             ix :=ix + dx;
                             iy :=iy + dy;
                           until (ix=Finish.x) or (iy=Finish.y);
                           if Fight then f := false
                                    else f:= (cb=0) and (cw=0) and f_;
                           Fight := (cw=1) and (cb=0) and f_;
                          end
                    else f := False
                   end;
                   if f or Fight
                      then begin
                            Desk[Finish.y][Finish.x]:=Desk[Start.y][Start.x];
                            Desk[Start.y][Start.x] := N;
                            if (Finish.y = 1)
                               then Desk[Finish.y][Finish.x]:=BD;
                            if Fight then Desk[y][x]:=N;
                            Draw;
                           end;
                  end;
                Analise := f or Player.Fight;
          end;

           procedure Tdesk.ScanDamk;
          {превращает шашку в дамку если она достигла нужной позиции}
            var
               i : byte;
            begin
               for i := 1 to 10 do
                begin
                 if Desk[1,i] = B then Desk[1,i] := BD;
                 if Desk[10,i] = W then Desk[10,i] := WD;
                end;
            end;


  BEGIN
                 Game.Init;
                 Game.Run;
  END.