В шашечном эндшпиле остались белая дамка и две чёрных пешки, позиции которых известны. Ход белых. Сможет ли дамка срубить одну или сразу обе пешки.

Вся суть задачи - как закодировать поля шахматной доски и как проверять, находится ли шашки на одной диагонали (ведь в шашках все ходы делаются по диагонали, как мы помним). Думаю, удобнее всего будет сделать так, как на рисунке:

Кстати, изобразить такую доску быстрей всего в Excel формулой

=ЕСЛИ(ОСТАТ(B$10+$A2;2)=0;B$10*10+$A2;"")

- если доска (левый верхний угол доски) "начинается" с ячейки рабочего листа B2.

Алгоритмически решение несложно:

Пешка рубится, если она
 (Не на краю доски) И (Не рядом с другой пешкой) И
   ((На одной диагонали с дамкой) ИЛИ 
    (точка пересечения с диагональю другой пешки лежит по другую сторону от этой пешки, чем дамка;
     при этом другая пешка рубится напрямую))
Иначе не рубится

Функция ReadXY позволяет ввести допустимые координаты дамки и шашек, OnDiag проверяет, стоят ли 2 шашки на одной диагонали (в том числе, являются ли соседями), а CrossDiag вместе с DifferentSides отслеживают ходы "углом", когда дамка рубит сразу две шашки одним ходом. Можно, конечно, код оптимизировать, но здесь ставилась задача решить возможно быстрей и наглядней.

procedure Error (msg:string);
begin
 writeln;
 writeln (msg);
 write ('Нажмите ENTER для выхода из программы');
 reset (input); readln; halt;
end;

procedure ReadXY (msg:string; var x,y:integer);
var n:integer;
begin
 repeat
  writeln;
  write (msg);
  {$I-}read(n);{$I+}
  if (IoResult<>0) or (n<11) or (n>88) then begin
   writeln ('Недопустимый ввод! Введите координату клетки от 11 до 88');
   continue;
  end;
  x := n div 10;
  y := n mod 10;
  if (x>8) or (y>8) then begin
   writeln ('Ни одна из координат не может быть больше 8');
   continue;
  end;
  if (x+y) mod 2 = 1 then begin
   writeln ('Вы ввели координаты белой клетки, допустимы только черные');
   continue;
  end;
  break;
 until false;
end;

function OnEdge (x,y:integer):boolean;
begin
 if (x=1) or (x=8) or (y=1) or (y=8) then OnEdge:=true
 else OnEdge:=false;
end;

function Coord (x,y:integer):integer;
begin
 Coord:=x*10+y;
end;

function OnDiag (x1,y1,x2,y2:integer):integer;
 {Если шашки на одной диагонали, вернет расстояние в клетках
  между ними, иначе 0}
var n:integer;
begin
 n:=abs(Coord(x1,y1)-Coord(x2,y2));
 if n mod 11=0 then OnDiag:=n div 11
 else if n mod 9=0 then OnDiag:=n div 9
 else OnDiag:=0;
end;

function DifferentSides(x1,y1,x0,y0,x2,y2:integer):boolean;
{истина, если (x0,y0) лежит между остальными 2 точками}
var n1,n0,n2:integer;
begin
 n1:=Coord (x1,y1); n2:=Coord (x2,y2); n0:=Coord (x0,y0);
 if (n1<n0) and (n0<n2) or (n2<n0) and (n0<n1) then DifferentSides:=true
 else DifferentSides:=false;
end;

function CrossDiag(x1,y1,x2,y2,x0,y0:integer):boolean;
{Ищем точки пересечения (x,y) диагоналей шашек перебором -
 для точки пересечения характерно то, что она принадлежит
 диагоналям обеих шашек}
var x,y,k:integer;
begin
 if (OnDiag(x1,y1,x2,y2)>0) then begin
  {На одной диагноали не надо искать}
  CrossDiag:=false;
  Exit;
 end;
 x:=1; k:=0;
 while x<9 do begin
  if x mod 2=1 then y:=1 else y:=2;
  while y<9 do begin {Перебор всех черных клеток доски}
   if (OnDiag (x,y,x1,y1)>0) and (OnDiag (x,y,x2,y2)>0) then begin
    if DifferentSides(x,y,x1,y1,x0,y0)=true then begin
     CrossDiag:=true;
     Exit;
    end;
    inc(k);
    if k=2 then break; {Всего не более 2 точек пересечения}
   end;
   inc (y,2);
  end;
  inc(x);
 end;
 CrossDiag:=false;
end;

var x0,y0,x1,y1,x2,y2:integer;
    is1,is2:boolean;

begin
 {Вводим и проверяем координаты}
 ReadXY ('Координаты дамки: ',x0,y0);
 ReadXY ('Координаты 1-й шашки: ',x1,y1);
 ReadXY ('Координаты 2-й шашки: ',x2,y2);
 if (Coord(x0,y0)=Coord(x1,y1)) or (Coord(x0,y0)=Coord(x2,y2)) or
    (Coord(x1,y1)=Coord(x2,y2)) then
  Error ('Все 3 клетки должны быть разными!');
 is1:=(OnEdge(x1,y1)=false) and (OnDiag (x1,y1,x2,y2)<>1) and
      (OnDiag(x1,y1,x0,y0)>0);
 is2:=(OnEdge(x2,y2)=false) and (OnDiag (x1,y1,x2,y2)<>1) and
      (OnDiag(x2,y2,x0,y0)>0);
 write ('Шашка 1 ');
 if is1=true then writeln (' рубится напрямую')
 else if (is2=true) and (CrossDiag(x2,y2,x1,y1,x0,y0)=true)
  and (OnEdge(x1,y1)=false) then writeln (' рубится после второй')
 else writeln (' НЕ рубится');
 write ('Шашка 2 ');
 if is2=true then writeln (' рубится напрямую')
 else if (is1=true) and (CrossDiag(x1,y1,x2,y2,x0,y0)=true)
  and (OnEdge(x2,y2)=false) then writeln (' рубится после первой')
 else writeln (' НЕ рубится');
 writeln;
 write ('ENTER для выхода');
 reset (input); readln;
end.

гостевая; E-mail