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.