unit DraughtLogic;

(**************************
 ** GetMovesWhite - получить список всех ходов за белых
 ** GetMovesBlack - получить список всех ходов за черных
 ** GetLastMove - ? забыл :(
 ** Estimate - оценка позиции
 ** SelectMove - выбор хода (Buffer --- размер буфера (от 30 до 60, чем больше тем сильнее))
 ** 
 ** Поле задается: 
 **   первые 32 элемента массива --- шашки (brWhiteSingle; brWhiteMam; brBlackSingle; brBlackMam; или нуль
 **   32 элемент - счетчик ходов только дамками
 **   33 элемент - кто ходит
 ** 
 ** (С) Mystic, 2002. 
 **   Этот алгоритм реализован в программе http://www.listsoft.ru/program.php?id=13904&allowunchecked=yes
 **   Разрешается использовать в некоммерческих целях со ссылкой на автора.
**************************)

interface

type
  PBoard = ^TBoard;
  TBoard = array [0..63] of ShortInt;
  TDirection = (drLeftUp, drRightUp, drLeftDown, drRightDown);
  TDirectionTable = array [TDirection, 0..31] of Integer;

var
  StartBoard: TBoard;
  DirectionTable: TDirectionTable;
  Buffer: array[0..1023] of TBoard;
  Dead: array[0..31] of ShortInt;
  DeadCount: Integer;
  MoveWriter: Integer;

const
  brWhiteDead = -10;
  brWhiteSingle = 20;
  brWhiteMam = 70;
  brBlackDead = 10;
  brBlackSingle = -20;
  brBlackMam = -70;

  WhiteMamLine = 28;
  BlackMamLine = 3;

  ActiveWhite = 1;
  ActiveBlack = 0;

  WasTake = ShortInt(':');
  WasNotTake = ShortInt('-');

  OrtDirection1: array [TDirection] of TDirection = (drRightUp, drLeftUp, drLeftUp, drRightUp);
  OrtDirection2: array [TDirection] of TDirection = (drLeftDown, drRightDown, drRightDown, drLeftDown);

function GetMovesWhite(N: Integer; var Board: TBoard): Integer;
function GetMovesBlack(N: Integer; var Board: TBoard): Integer;
function GetLastMove(Board: TBoard): string;
function Estimate(const Board: TBoard): Integer;
function SelectMove(var Board: TBoard; MaxBufLen: Integer; var CurrentEstimate: Integer): Integer;

implementation

type
  TSingleMoveRec = record
    PointFrom: Integer;
    PointTo: Integer;
    Counter: ShortInt;
    WhatPut: ShortInt;
  end;




// Beta tested 19.05.2002
function GetLastMove(Board: TBoard): string;
var
  I, J: Integer;
begin
  Result := '';
  I := 36;
  while Board[I] <> -1 do
  begin
    J := 2 * Board[I];
    if (J xor (J div 8)) and $01 <> 0 then J := J + 1;
    Result := Result + Char(J mod 8 + Byte('a'));
    Result := Result + Char(J div 8 + Byte('1'));
    Result := Result + Char(Board[63]);
    I := I + 1;
  end;
  SetLength(Result, Length(Result)-1);
end;




// Beta tested 19.05.2002
function RecurseMamTakeWhite(var N: Integer; Cell : Integer; Direction: TDirection; var Board: TBoard): Integer;
var
  OrtDirection: TDirection;
  NN: Integer;
  I, J, NextI, NextNextI: Integer;
  SaveDead: ShortInt;
begin
  Result := 0;

  I := Cell;
  repeat
    OrtDirection := OrtDirection1[Direction];
    NextI := I;
    repeat
      NextI := DirectionTable[OrtDirection, NextI];
      if NextI = -1 then Break;
      if Board[NextI] <> 0 then Break;
    until False;
    if (NextI <> -1) and (Board[NextI] < 0) then
    begin
      NextNextI := DirectionTable[OrtDirection, NextI];
      if (NextNextI <> -1) and (Board[NextNextI] = 0) then
      begin
        Dead[DeadCount] := NextI;
        SaveDead := Board[NextI];
        Board[NextI] := brBlackDead;
        DeadCount := DeadCount + 1;
        Board[MoveWriter] := I;
        MoveWriter := MoveWriter + 1;
        Result := Result + RecurseMamTakeWhite(N, NextNextI, OrtDirection, Board);
        Board[NextI] := SaveDead;
        MoveWriter := MoveWriter - 1;
        DeadCount := DeadCount - 1;
      end;
    end;

    OrtDirection := OrtDirection2[Direction];
    NextI := I;
    repeat
      NextI := DirectionTable[OrtDirection, NextI];
      if NextI = -1 then Break;
      if Board[NextI] <> 0 then Break;
    until False;
    if (NextI <> -1) and (Board[NextI] < 0) then
    begin
      NextNextI := DirectionTable[OrtDirection, NextI];
      if (NextNextI <> -1) and (Board[NextNextI] = 0) then
      begin
        Dead[DeadCount] := NextI;
        SaveDead := Board[NextI];
        Board[NextI] := brBlackDead;
        DeadCount := DeadCount + 1;
        Board[MoveWriter] := I;
        MoveWriter := MoveWriter + 1;
        Result := Result + RecurseMamTakeWhite(N, NextNextI, OrtDirection, Board);
        Board[NextI] := SaveDead;
        MoveWriter := MoveWriter - 1;
        DeadCount := DeadCount - 1;
      end;
    end;

    I := DirectionTable[Direction, I];
    if I = -1 then Break;
    if Board[I] > 0 then Break;
    if Board[I] < 0 then
    begin
      NextI := DirectionTable[Direction, I];
      if NextI = -1 then Break;
      if Board[NextI] = 0 then
      begin
        Dead[DeadCount] := I;
        SaveDead := Board[I];
        Board[I] := brBlackDead;
        DeadCount := DeadCount + 1;
        Board[MoveWriter] := Cell;
        MoveWriter := MoveWriter + 1;
        Result := Result + RecurseMamTakeWhite(N, NextI, Direction, Board);
        Board[I] := SaveDead;
        MoveWriter := MoveWriter - 1;
        DeadCount := DeadCount - 1;
      end;
      Break;
    end;
  until False;

  if Result = 0 then
  begin
    Buffer[N] := Board;
    for J := 0 to DeadCount-1 do
      Buffer[N, Dead[J]] := 0;
    Buffer[N, 32] := 0;
    Buffer[N, 33] := ActiveBlack;
    Buffer[N, 63] := WasTake;
    Buffer[N, MoveWriter+1] := -1;
    NN := N + 1;
    Result := 1;
    NextI := DirectionTable[Direction, Cell];
    repeat
      if NextI = -1 then Break;
      if Board[NextI] <> 0 then Break;
      Buffer[NN] := Buffer[N];
      Buffer[NN, NextI] := brWhiteMam;
      Buffer[NN, MoveWriter] := NextI;
      NN := NN + 1;
      Result := Result + 1;
      NextI := DirectionTable[Direction, NextI];
    until False;
    Buffer[N, Cell] := brWhiteMam;
    Buffer[N, MoveWriter] := Cell;
    N := NN;
  end;
end;



// Beta tested 20.05.2002
function RecurseSingleTakeWhite(var N: Integer; Cell : Integer; Direction: TDirection; var Board: TBoard): Integer;
var
  OrtDirection: TDirection;
  NExtI, NExtNextI: Integer;
  SaveDead: ShortInt;
  J: Integer;
begin
  Result := 0;

  OrtDirection := OrtDirection1[Direction];
  NextI := DirectionTable[OrtDirection, Cell];
  if (NextI <> -1) and (Board[NextI] < 0) then
  begin
    NextNextI := DirectionTable[OrtDirection, NextI];
    if (NextNextI <> -1) and (Board[NextNextI] = 0) then
    begin
      Dead[DeadCount] := NextI;
      DeadCount := DeadCount + 1;
      SaveDead := Board[NextI];
      Board[NextI] := brBlackDead;
      Board[MoveWriter] := Cell;
      MoveWriter := MoveWriter + 1;
      if NextNextI >= WhiteMamLine
        then Result := Result + RecurseMamTakeWhite(N, NextNextI, OrtDirection, Board)
        else Result := Result + RecurseSingleTakeWhite(N, NextNextI, OrtDirection, Board);
      MoveWriter := MoveWriter - 1;
      DeadCount := DeadCount - 1;
      Board[NextI] := SaveDead;
    end;
  end;

  OrtDirection := OrtDirection2[Direction];
  NextI := DirectionTable[OrtDirection, Cell];
  if (NextI <> -1) and (Board[NextI] < 0) then
  begin
    NextNextI := DirectionTable[OrtDirection, NextI];
    if (NextNextI <> -1) and (Board[NextNextI] = 0) then
    begin
      Dead[DeadCount] := NextI;
      SaveDead := Board[NextI];
      Board[NextI] := brBlackDead;
      DeadCount := DeadCount + 1;
      Board[MoveWriter] := Cell;
      MoveWriter := MoveWriter + 1;
      if NextNextI >= WhiteMamLine
        then Result := Result + RecurseMamTakeWhite(N, NextNextI, OrtDirection, Board)
        else Result := Result + RecurseSingleTakeWhite(N, NextNextI, OrtDirection, Board);
      Board[NextI] := SaveDead;
      MoveWriter := MoveWriter - 1;
      DeadCount := DeadCount - 1;
    end;
  end;

  NextI := DirectionTable[Direction, Cell];
  if (NextI <> -1) and (Board[NextI] < 0) then
  begin
    NextNextI := DirectionTable[Direction, NextI];
    if (NextNextI <> -1) and (Board[NextNextI] = 0) then
    begin
      Dead[DeadCount] := NextI;
      SaveDead := Board[NextI];
      Board[NextI] := brBlackDead;
      DeadCount := DeadCount + 1;
      Board[MoveWriter] := Cell;
      MoveWriter := MoveWriter + 1;
      if NextNextI >= WhiteMamLine
        then Result := Result + RecurseMamTakeWhite(N, NextNextI, Direction, Board)
        else Result := Result + RecurseSingleTakeWhite(N, NextNextI, Direction, Board);
      Board[NextI] := SaveDead;
      MoveWriter := MoveWriter - 1;
      DeadCount := DeadCount - 1;
    end;
  end;

  if Result = 0 then
  begin
    Buffer[N] := Board;
    for J := 0 to DeadCount-1 do
      Buffer[N, Dead[J]] := 0;
    Buffer[N, Cell] := brWhiteSingle;
    Buffer[N, 32] := 0;
    Buffer[N, 33] := ActiveBlack;
    Buffer[N, 63] := WasTake;
    Buffer[N, MoveWriter] := Cell;
    Buffer[N, MoveWriter+1] := -1;
    N := N + 1;
    Result := 1;
  end

end;




// Beta tested 19.05.2002
function GetMovesWhite(N: Integer; var Board: TBoard): Integer;
var
  I: Integer;
  Temp: Integer;
  NextI, NextNextI: Integer;
  SaveDead: ShortInt;
  Direction: TDirection;
  SingleMoves: array[0..1023] of TSingleMoveRec;
begin
  Result := 0;
  DeadCount := 0;
  MoveWriter := 36;
  for I := 0 to 31 do
  begin

    // Ход простой
    if Board[I] = brWhiteSingle then
    begin

      // Проверка на взятие вниз влево
      NextI := DirectionTable[drLeftDown, I];
      if (NextI <> -1) and (Board[NextI] < 0) then
      begin
        NextNextI := DirectionTable[drLeftDown, NextI];
        if (NextNextI <> -1) and (Board[NextNextI] = 0) then
        begin
          if Result > 0 then Result := 0;
          Board[I] := 0;
          Dead[DeadCount] := NextI;
          SaveDead := Board[NextI];
          Board[NextI] := brBlackDead;
          DeadCount := DeadCount + 1;
          Board[MoveWriter] := I;
          MoveWriter := MoveWriter + 1;
          {if NextNextI >= WhiteMamLine} // Оптимизаия --- взятие назад не может привести к дамке
          {  then Result := Result - RecurseMamTakeWhite(N, NextNextI, drLeftDown, Board)}
            {else} Result := Result - RecurseSingleTakeWhite(N, NextNextI, drLeftDown, Board);
          Board[NextI] := SaveDead;
          MoveWriter := MoveWriter - 1;
          DeadCount := DeadCount - 1;
          Board[I] := brWhiteSingle;
        end;
      end;

      // Проверка на взятие вниз вправо
      NextI := DirectionTable[drRightDown, I];
      if (NextI <> -1) and (Board[NextI] < 0) then
      begin
        NextNextI := DirectionTable[drRightDown, NextI];
        if (NextNextI <> -1) and (Board[NextNextI] = 0) then
        begin
          if Result > 0 then Result := 0;
          Board[I] := 0;
          Dead[DeadCount] := NextI;
          SaveDead := Board[NextI];
          Board[NextI] := brBlackDead;
          DeadCount := DeadCount + 1;
          Board[MoveWriter] := I;
          MoveWriter := MoveWriter + 1;
          {if NextNextI >= WhiteMamLine} // Оптимизаия --- взятие назад не может привести к дамке
          {  then Result := Result - RecurseMamTakeWhite(N, NextNextI, drRightDown, Board)}
            {else} Result := Result - RecurseSingleTakeWhite(N, NextNextI, drRightDown, Board);
          Board[NextI] := SaveDead;
          MoveWriter := MoveWriter - 1;
          DeadCount := DeadCount - 1;
          Board[I] := brWhiteSingle;
        end;
      end;

      // Ход влево вверх
      NextI := DirectionTable[drLeftUp, I];
      if NextI >= 0 then
      begin
        Temp := Board[NextI];
        if Temp = 0 then // Поле свободно
        begin
          if Result >= 0 then // Не было взятий
          begin
            SingleMoves[Result].PointFrom := I;
            SingleMoves[Result].PointTo := NextI;
            SingleMoves[Result].Counter := 0;
            if NextI >= WhiteMamLine
              then SingleMoves[Result].WhatPut := brWhiteMam
              else SingleMoves[Result].WhatPut := brWhiteSingle;
            Result := Result + 1;
          end
        end
        else begin
          if Temp < 0 then
          begin
            NextNextI := DirectionTable[drLeftUp, NextI];
            if (NextNextI <> -1) and (Board[NextNextI] = 0) then
            begin
              if Result > 0 then Result := 0;
              Board[I] := 0;
              Dead[DeadCount] := NextI;
              SaveDead := Board[NextI];
              Board[NextI] := brBlackDead;
              DeadCount := DeadCount + 1;
              Board[MoveWriter] := I;
              MoveWriter := MoveWriter + 1;
              if NextNextI >= WhiteMamLine
                then Result := Result - RecurseMamTakeWhite(N, NextNextI, drLeftUp, Board)
                else Result := Result - RecurseSingleTakeWhite(N, NextNextI, drLeftUp, Board);
              Board[NextI] := SaveDead;
              MoveWriter := MoveWriter - 1;
              DeadCount := DeadCount - 1;
              Board[I] := brWhiteSingle;
            end;
          end;
        end;
      end;

      // Ход вправо вверх
      NextI := DirectionTable[drRightUp, I];
      if NextI >= 0 then
      begin
        Temp := Board[NextI];
        if Temp = 0 then // Поле свободно
        begin
          if Result >= 0 then // Не было взятий
          begin
            SingleMoves[Result].PointFrom := I;
            SingleMoves[Result].PointTo := NextI;
            SingleMoves[Result].Counter := 0;
            if NextI >= WhiteMamLine
              then SingleMoves[Result].WhatPut := brWhiteMam
              else SingleMoves[Result].WhatPut := brWhiteSingle;
            Result := Result + 1;
          end
        end
        else begin
          if Temp < 0 then
          begin
            NextNextI := DirectionTable[drRightUp, NextI];
            if (NextNextI <> -1) and (Board[NextNextI] = 0) then
            begin
              if Result > 0 then Result := 0;
              Board[I] := 0;
              Dead[DeadCount] := NextI;
              SaveDead := Board[NextI];
              Board[NextI] := brBlackDead;
              DeadCount := DeadCount + 1;
              Board[MoveWriter] := I;
              MoveWriter := MoveWriter + 1;
              if NextNextI >= WhiteMamLine
                then Result := Result - RecurseMamTakeWhite(N, NextNextI, drRightUp, Board)
                else Result := Result - RecurseSingleTakeWhite(N, NextNextI, drRightUp, Board);
              Board[NextI] := SaveDead;
              MoveWriter := MoveWriter - 1;
              DeadCount := DeadCount - 1;
              Board[I] := brWhiteSingle;
            end;
          end;
        end;
      end;
    end

    // Ход дамкой.
    else if Board[I] = brWhiteMam then
    begin
      Board[I] := 0;
      for Direction := Low(TDirection) to High(TDirection) do
      begin
        NextI := DirectionTable[Direction, I];
        repeat
          if NextI = -1 then Break;
          Temp := Board[NextI];
          if Temp = 0 then
          begin
            if Result >= 0 then // Не было взятий
            begin
              SingleMoves[Result].PointFrom := I;
              SingleMoves[Result].PointTo := NextI;
              SingleMoves[Result].Counter := Board[32] + 1;
              SingleMoves[Result].WhatPut := brWhiteMam;
              Result := Result + 1;
            end;
            NextI := DirectionTable[Direction, NextI];
          end
          else if Temp < brBlackDead then begin
            NextNextI := DirectionTable[Direction, NextI];
            if (NextNextI <> -1) and (Board[NextNextI] = 0) then
            begin
              Dead[DeadCount] := NextI;
              SaveDead := Board[NextI];
              Board[NextI] := brBlackDead;
              DeadCount := DeadCount + 1;
              Board[MoveWriter] := I;
              MoveWriter := MoveWriter + 1;
              if Result > 0 then Result := 0;
              Result := Result - RecurseMamTakeWhite(N, NextNextI, Direction, Board);
              Board[NextI] := SaveDead;
              MoveWriter := MoveWriter - 1;
              DeadCount := DeadCount - 1;
            end;
            Break;
          end
          else
            Break;
        until False;
      end;
      Board[I] := brWhiteMam;
    end;


  end;

  for I := 0 to Result-1 do
  begin
    Buffer[N] := Board;
    Buffer[N, SingleMoves[I].PointFrom] := 0;
    Buffer[N, SingleMoves[I].PointTo] := SingleMoves[I].WhatPut;
    Buffer[N, 32] := SingleMoves[I].Counter;
    Buffer[N, 33] := ActiveBlack;
    Buffer[N, 36] := SingleMoves[I].PointFrom;
    Buffer[N, 37] := SingleMoves[I].PointTo;
    Buffer[N, 38] := -1;
    Buffer[N, 63] := WasNotTake;
    N := N + 1;
  end;
end;




// Beta tested 19.05.2002
function RecurseMamTakeBlack(var N: Integer; Cell : Integer; Direction: TDirection; var Board: TBoard): Integer;
var
  OrtDirection: TDirection;
  NN: Integer;
  I, J, NextI, NextNextI: Integer;
  SaveDead: ShortInt;
begin
  Result := 0;

  I := Cell;
  repeat
    OrtDirection := OrtDirection1[Direction];
    NextI := I;
    repeat
      NextI := DirectionTable[OrtDirection, NextI];
      if NextI = -1 then Break;
      if Board[NextI] <> 0 then Break;
    until False;
    if (NextI <> -1) and (Board[NextI] > 0) then
    begin
      NextNextI := DirectionTable[OrtDirection, NextI];
      if (NextNextI <> -1) and (Board[NextNextI] = 0) then
      begin
        Dead[DeadCount] := NextI;
        SaveDead := Board[NextI];
        Board[NextI] := brWhiteDead;
        DeadCount := DeadCount + 1;
        Board[MoveWriter] := I;
        MoveWriter := MoveWriter + 1;
        Result := Result + RecurseMamTakeBlack(N, NextNextI, OrtDirection, Board);
        Board[NextI] := SaveDead;
        MoveWriter := MoveWriter - 1;
        DeadCount := DeadCount - 1;
      end;
    end;

    OrtDirection := OrtDirection2[Direction];
    NextI := I;
    repeat
      NextI := DirectionTable[OrtDirection, NextI];
      if NextI = -1 then Break;
      if Board[NextI] <> 0 then Break;
    until False;
    if (NextI <> -1) and (Board[NextI] > 0) then
    begin
      NextNextI := DirectionTable[OrtDirection, NextI];
      if (NextNextI <> -1) and (Board[NextNextI] = 0) then
      begin
        Dead[DeadCount] := NextI;
        SaveDead := Board[NextI];
        Board[NextI] := brWhiteDead;
        DeadCount := DeadCount + 1;
        Board[MoveWriter] := I;
        MoveWriter := MoveWriter + 1;
        Result := Result + RecurseMamTakeBlack(N, NextNextI, OrtDirection, Board);
        Board[NextI] := SaveDead;
        MoveWriter := MoveWriter - 1;
        DeadCount := DeadCount - 1;
      end;
    end;

    I := DirectionTable[Direction, I];
    if I = -1 then Break;
    if Board[I] < 0 then Break;
    if Board[I] > 0 then
    begin
      NextI := DirectionTable[Direction, I];
      if NextI = -1 then Break;
      if Board[NextI] = 0 then
      begin
        Dead[DeadCount] := I;
        SaveDead := Board[I];
        Board[I] := brWhiteDead;
        DeadCount := DeadCount + 1;
        Board[MoveWriter] := Cell;
        MoveWriter := MoveWriter + 1;
        Result := Result + RecurseMamTakeBlack(N, NextI, Direction, Board);
        Board[I] := SaveDead;
        MoveWriter := MoveWriter - 1;
        DeadCount := DeadCount - 1;
      end;
      Break;
    end;
  until False;

  if Result = 0 then
  begin
    Buffer[N] := Board;
    for J := 0 to DeadCount-1 do
      Buffer[N, Dead[J]] := 0;
    Buffer[N, 32] := 0;
    Buffer[N, 33] := ActiveWhite;
    Buffer[N, 63] := WasTake;
    Buffer[N, MoveWriter+1] := -1;
    NN := N + 1;
    Result := 1;
    NextI := DirectionTable[Direction, Cell];
    repeat
      if NextI = -1 then Break;
      if Board[NextI] <> 0 then Break;
      Buffer[NN] := Buffer[N];
      Buffer[NN, NextI] := brBlackMam;
      Buffer[NN, MoveWriter] := NextI;
      NN := NN + 1;
      Result := Result + 1;
      NextI := DirectionTable[Direction, NextI];
    until False;
    Buffer[N, Cell] := brBlackMam;
    Buffer[N, MoveWriter] := Cell;
    N := NN;
  end;
end;




// Beta tested 20.05.2002
function RecurseSingleTakeBlack(var N: Integer; Cell : Integer; Direction: TDirection; var Board: TBoard): Integer;
var
  OrtDirection: TDirection;
  NExtI, NExtNextI: Integer;
  SaveDead: ShortInt;
  J: Integer;
begin
  Result := 0;

  OrtDirection := OrtDirection1[Direction];
  NextI := DirectionTable[OrtDirection, Cell];
  if (NextI <> -1) and (Board[NextI] > 0) then
  begin
    NextNextI := DirectionTable[OrtDirection, NextI];
    if (NextNextI <> -1) and (Board[NextNextI] = 0) then
    begin
      Dead[DeadCount] := NextI;
      DeadCount := DeadCount + 1;
      SaveDead := Board[NextI];
      Board[NextI] := brWhiteDead;
      Board[MoveWriter] := Cell;
      MoveWriter := MoveWriter + 1;
      if NextNextI <= BlackMamLine
        then Result := Result + RecurseMamTakeBlack(N, NextNextI, OrtDirection, Board)
        else Result := Result + RecurseSingleTakeBlack(N, NextNextI, OrtDirection, Board);
      MoveWriter := MoveWriter - 1;
      DeadCount := DeadCount - 1;
      Board[NextI] := SaveDead;
    end;
  end;

  OrtDirection := OrtDirection2[Direction];
  NextI := DirectionTable[OrtDirection, Cell];
  if (NextI <> -1) and (Board[NextI] > 0) then
  begin
    NextNextI := DirectionTable[OrtDirection, NextI];
    if (NextNextI <> -1) and (Board[NextNextI] = 0) then
    begin
      Dead[DeadCount] := NextI;
      SaveDead := Board[NextI];
      Board[NextI] := brWhiteDead;
      DeadCount := DeadCount + 1;
      Board[MoveWriter] := Cell;
      MoveWriter := MoveWriter + 1;
      if NextNextI >= WhiteMamLine
        then Result := Result + RecurseMamTakeBlack(N, NextNextI, OrtDirection, Board)
        else Result := Result + RecurseSingleTakeBlack(N, NextNextI, OrtDirection, Board);
      Board[NextI] := SaveDead;
      MoveWriter := MoveWriter - 1;
      DeadCount := DeadCount - 1;
    end;
  end;

  NextI := DirectionTable[Direction, Cell];
  if (NextI <> -1) and (Board[NextI] > 0) then
  begin
    NextNextI := DirectionTable[Direction, NextI];
    if (NextNextI <> -1) and (Board[NextNextI] = 0) then
    begin
      Dead[DeadCount] := NextI;
      SaveDead := Board[NextI];
      Board[NextI] := brWhiteDead;
      DeadCount := DeadCount + 1;
      Board[MoveWriter] := Cell;
      MoveWriter := MoveWriter + 1;
      if NextNextI <= BlackMamLine
        then Result := Result + RecurseMamTakeBlack(N, NextNextI, Direction, Board)
        else Result := Result + RecurseSingleTakeBlack(N, NextNextI, Direction, Board);
      Board[NextI] := SaveDead;
      MoveWriter := MoveWriter - 1;
      DeadCount := DeadCount - 1;
    end;
  end;

  if Result = 0 then
  begin
    Buffer[N] := Board;
    for J := 0 to DeadCount-1 do
      Buffer[N, Dead[J]] := 0;
    Buffer[N, Cell] := brBlackSingle;
    Buffer[N, 32] := 0;
    Buffer[N, 33] := ActiveWhite;
    Buffer[N, 63] := WasTake;
    Buffer[N, MoveWriter] := Cell;
    Buffer[N, MoveWriter+1] := -1;
    N := N + 1;
    Result := 1;
  end

end;




// Beta tested 19.05.2002
function GetMovesBlack(N: Integer; var Board: TBoard): Integer;
var
  I: Integer;
  Temp: Integer;
  NextI, NextNextI: Integer;
  SaveDead: ShortInt;
  Direction: TDirection;
  SingleMoves: array[0..1023] of TSingleMoveRec;
begin
  Result := 0;
  DeadCount := 0;
  MoveWriter := 36;
  for I := 0 to 31 do
  begin

    // Ход простой
    if Board[I] = brBlackSingle then
    begin

      // Проверка на взятие вверх влево
      NextI := DirectionTable[drLeftUp, I];
      if (NextI <> -1) and (Board[NextI] > 0) then
      begin
        NextNextI := DirectionTable[drLeftUp, NextI];
        if (NextNextI <> -1) and (Board[NextNextI] = 0) then
        begin
          if Result > 0 then Result := 0;
          Board[I] := 0;
          Dead[DeadCount] := NextI;
          SaveDead := Board[NextI];
          Board[NextI] := brWhiteDead;
          DeadCount := DeadCount + 1;
          Board[MoveWriter] := I;
          MoveWriter := MoveWriter + 1;
          {if NextNextI >= WhiteMamLine} // Оптимизаия --- взятие назад не может привести к дамке
          {  then Result := Result - RecurseMamTakeBlack(N, NextNextI, drLeftDown, Board)}
            {else} Result := Result - RecurseSingleTakeBlack(N, NextNextI, drLeftUp, Board);
          Board[NextI] := SaveDead;
          MoveWriter := MoveWriter - 1;
          DeadCount := DeadCount - 1;
          Board[I] := brBlackSingle;
        end;
      end;

      // Проверка на взятие вверх вправо
      NextI := DirectionTable[drRightUp, I];
      if (NextI <> -1) and (Board[NextI] > 0) then
      begin
        NextNextI := DirectionTable[drRightUp, NextI];
        if (NextNextI <> -1) and (Board[NextNextI] = 0) then
        begin
          if Result > 0 then Result := 0;
          Board[I] := 0;
          Dead[DeadCount] := NextI;
          SaveDead := Board[NextI];
          Board[NextI] := brWhiteDead;
          DeadCount := DeadCount + 1;
          Board[MoveWriter] := I;
          MoveWriter := MoveWriter + 1;
          {if NextNextI >= WhiteMamLine} // Оптимизаия --- взятие назад не может привести к дамке
          {  then Result := Result - RecurseMamTakeBlack(N, NextNextI, drRightDown, Board)}
            {else} Result := Result - RecurseSingleTakeBlack(N, NextNextI, drRightUp, Board);
          Board[NextI] := SaveDead;
          MoveWriter := MoveWriter - 1;
          DeadCount := DeadCount - 1;
          Board[I] := brBlackSingle;
        end;
      end;

      // Ход влево вниз
      NextI := DirectionTable[drLeftDown, I];
      if NextI >= 0 then
      begin
        Temp := Board[NextI];
        if Temp = 0 then // Поле свободно
        begin
          if Result >= 0 then // Не было взятий
          begin
            SingleMoves[Result].PointFrom := I;
            SingleMoves[Result].PointTo := NextI;
            SingleMoves[Result].Counter := 0;
            if NextI <= BlackMamLine
              then SingleMoves[Result].WhatPut := brBlackMam
              else SingleMoves[Result].WhatPut := brBlackSingle;
            Result := Result + 1;
          end
        end
        else begin
          if Temp > 0 then
          begin
            NextNextI := DirectionTable[drLeftDown, NextI];
            if (NextNextI <> -1) and (Board[NextNextI] = 0) then
            begin
              if Result > 0 then Result := 0;
              Board[I] := 0;
              Dead[DeadCount] := NextI;
              SaveDead := Board[NextI];
              Board[NextI] := brWhiteDead;
              DeadCount := DeadCount + 1;
              Board[MoveWriter] := I;
              MoveWriter := MoveWriter + 1;
              if NextNextI <= BlackMamLine
                then Result := Result - RecurseMamTakeBlack(N, NextNextI, drLeftDown, Board)
                else Result := Result - RecurseSingleTakeBlack(N, NextNextI, drLeftDown, Board);
              Board[NextI] := SaveDead;
              MoveWriter := MoveWriter - 1;
              DeadCount := DeadCount - 1;
              Board[I] := brBlackSingle;
            end;
          end;
        end;
      end;

      // Ход вправо вниз
      NextI := DirectionTable[drRightDown, I];
      if NextI >= 0 then
      begin
        Temp := Board[NextI];
        if Temp = 0 then // Поле свободно
        begin
          if Result >= 0 then // Не было взятий
          begin
            SingleMoves[Result].PointFrom := I;
            SingleMoves[Result].PointTo := NextI;
            SingleMoves[Result].Counter := 0;
            if NextI <= BlackMamLine
              then SingleMoves[Result].WhatPut := brBlackMam
              else SingleMoves[Result].WhatPut := brBlackSingle;
            Result := Result + 1;
          end
        end
        else begin
          if Temp > 0 then
          begin
            NextNextI := DirectionTable[drRightDown, NextI];
            if (NextNextI <> -1) and (Board[NextNextI] = 0) then
            begin
              if Result > 0 then Result := 0;
              Board[I] := 0;
              Dead[DeadCount] := NextI;
              SaveDead := Board[NextI];
              Board[NextI] := brWhiteDead;
              DeadCount := DeadCount + 1;
              Board[MoveWriter] := I;
              MoveWriter := MoveWriter + 1;
              if NextNextI <= BlackMamLine
                then Result := Result - RecurseMamTakeBlack(N, NextNextI, drRightDown, Board)
                else Result := Result - RecurseSingleTakeBlack(N, NextNextI, drRightDown, Board);
              Board[NextI] := SaveDead;
              MoveWriter := MoveWriter - 1;
              DeadCount := DeadCount - 1;
              Board[I] := brBlackSingle;
            end;
          end;
        end;
      end;
    end

    // Ход дамкой.
    else if Board[I] = brBlackMam then
    begin
      Board[I] := 0;
      for Direction := Low(TDirection) to High(TDirection) do
      begin
        NextI := DirectionTable[Direction, I];
        repeat
          if NextI = -1 then Break;
          Temp := Board[NextI];
          if Temp = 0 then
          begin
            if Result >= 0 then // Не было взятий
            begin
              SingleMoves[Result].PointFrom := I;
              SingleMoves[Result].PointTo := NextI;
              SingleMoves[Result].Counter := Board[32] + 1;
              SingleMoves[Result].WhatPut := brBlackMam;
              Result := Result + 1;
            end;
            NextI := DirectionTable[Direction, NextI];
          end
          else if Temp >0 then begin
            NextNextI := DirectionTable[Direction, NextI];
            if (NextNextI <> -1) and (Board[NextNextI] = 0) then
            begin
              Dead[DeadCount] := NextI;
              SaveDead := Board[NextI];
              Board[NextI] := brWhiteDead;
              DeadCount := DeadCount + 1;
              Board[MoveWriter] := I;
              MoveWriter := MoveWriter + 1;
              if Result > 0 then Result := 0;
              Result := Result - RecurseMamTakeBlack(N, NextNextI, Direction, Board);
              Board[NextI] := SaveDead;
              MoveWriter := MoveWriter - 1;
              DeadCount := DeadCount - 1;
            end;
            Break;
          end
          else
            Break;
        until False;
      end;
      Board[I] := brBlackMam;
    end;

  end;

  for I := 0 to Result-1 do
  begin
    Buffer[N] := Board;
    Buffer[N, SingleMoves[I].PointFrom] := 0;
    Buffer[N, SingleMoves[I].PointTo] := SingleMoves[I].WhatPut;
    Buffer[N, 32] := SingleMoves[I].Counter;
    Buffer[N, 33] := ActiveWhite;
    Buffer[N, 36] := SingleMoves[I].PointFrom;
    Buffer[N, 37] := SingleMoves[I].PointTo;
    Buffer[N, 38] := -1;
    Buffer[N, 63] := WasNotTake;
    N := N + 1;
  end;
end;




// Beta tested 20.02.2002
function Estimate(const Board: TBoard): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to 31 do
    Result := Result + Board[I];
  Result := Result + Random(21) - 10
end;




var
  MySide: ShortInt;
  Deep: Integer;
  MaxBufferLen: Integer;
  CurrentN: Integer;

const
  NO_MOVES = 1;




// Beta tested 20.02.2002
function RecurseEstimate(var Board: TBoard): Integer;
var
  SaveCurrentN: Integer;
  PositionCount: Integer;
  I: Integer;
  Temp: Integer;
begin
  if CurrentN > MaxBufferLen then
  begin
    Result := Estimate(Board);
    Exit;
  end;

  Deep := Deep + 1;
  SaveCurrentN := CurrentN;
  if Board[33] = ActiveWhite
    then PositionCount := Abs(GetMovesWhite(SaveCurrentN, Board))
    else PositionCount := Abs(GetMovesBlack(SaveCurrentN, Board));
  CurrentN := CurrentN + PositionCount;

  if PositionCount = 0 then
  begin
    if Board[33] = MySide
      then Result := -100000 + Deep
      else Result := +100000 - Deep;
  end
  else if PositionCount = 1 then
  begin
    Result := RecurseEstimate(Buffer[SaveCurrentN]);
  end
  else begin

    // Обычная рекурсивная оценка
    Result := RecurseEstimate(Buffer[SaveCurrentN]);
    for I := SaveCurrentN+1 to CurrentN - 1 do
    begin
      Temp := RecurseEstimate(Buffer[I]);
      if (MySide = ActiveWhite) xor (MySide <> Board[33]) then
      begin
        if Temp > Result then
          Result := Temp;
      end
      else begin
        if Temp < Result then
          Result := Temp;
      end;
    end;
  end;

  Deep := Deep - 1;
  CurrentN := SaveCurrentN;
end;




// Beta tested 20.05.2002
function SelectMove(var Board: TBoard; MaxBufLen: Integer; var CurrentEstimate: Integer): Integer;
var
  I: Integer;
  CurrentIndex: Integer;
  Temp: Integer;
begin
  MySide := Board[33];
  MaxBufferLen := MaxBufLen;
  CurrentN := 0;
  Deep := 0;

  if Board[33] = ActiveWhite
    then CurrentN := Abs(GetMovesWhite(0, Board))
    else CurrentN := Abs(GetMovesBlack(0, Board));

  if CurrentN = 0 then
  begin
    Result := NO_MOVES;
    Exit;
  end;

  if CurrentN = 1 then
  begin
    Board := Buffer[0];
    Result := 0;
    Exit;
  end;

  CurrentEstimate := RecurseEstimate(Buffer[0]);
  CurrentIndex := 0;
  for I := 1 to CurrentN - 1 do
  begin
    Temp := RecurseEstimate(Buffer[I]);
    if MySide = ActiveWhite then
    begin
      if Temp > CurrentEstimate then
      begin
        CurrentEstimate := Temp;
        CurrentIndex := I;
      end;
    end
    else begin
      if Temp < CurrentEstimate then
      begin
        CurrentEstimate := Temp;
        CurrentIndex := I;
      end;
    end;
  end;

  Board := Buffer[CurrentIndex];
  Result := 0;
end;




// Beta - tested 19.05.2002
procedure InitDirectionTable;
var
  X, Y, C: Integer;
begin
  C := 0;
  for Y := 0 to 7 do
    for X := 0 to 7 do
    begin
      if (X xor Y) and $01 = 0 then // Если поле черное...
      begin
        if (X>0) and (Y<7)
          then DirectionTable[drLeftUp, C] := (X + 8*Y + 7) div 2
          else DirectionTable[drLeftUp, C] :=  -1;
        if (X<7) and (Y<7)
          then DirectionTable[drRightUp, C] := (X + 8*Y + 9) div 2
          else DirectionTable[drRightUp, C] :=  -1;
        if (X>0) and (Y>0)
          then DirectionTable[drLeftDown, C] := (X + 8*Y - 9) div 2
          else DirectionTable[drLeftDown, C] :=  -1;
        if (X<7) and (Y>0)
          then DirectionTable[drRightDown, C] := (X + 8*Y -7) div 2
          else DirectionTable[drRightDown, C] :=  -1;
        C := C + 1;
      end;
    end;
end;




// Beta tested 19.05.2002
procedure SetStartBoard;
var
  I: Integer;
begin
  for I := 0 to 11 do
    StartBoard[I] := 20;
  for I := 20 to 31 do
    StartBoard[I] := -20;
  StartBoard[32] := 0;
  StartBoard[33] := ActiveWhite;
end;




initialization
  InitDirectionTable;
  SetStartBoard;


end.