{Шахматы. Хакимов Артем, 23гр.}
uses
wincrt,graph,dos;
const
CursorCol= Yellow;
SelectCol= Blue;
LastMoveCol= Brown;
GridCol= White;
WhiteCell= LightGray;
BlackCell= DarkGray;
CellCol: array [0..1] of integer = (WhiteCell,BlackCell);
sw = 640; {screen width}
sh = 480; {screen height}
{фигуры}
pusto=0; peshka=1; kon=2; slon=3; ladya=4; ferz=5; korol=6;
{белые фигуры}
wpeshka = 11; wkon=12; wslon=13; wladya=14; wferz=15; wkorol=16;
whites = [11..16];
{черные фигуры}
bpeshka = 21; bkon=22; bslon=23; bladya=24; bferz=25; bkorol=26;
blacks = [21..26];
{}
maxmoves = 256; {максимальное количество ходов в списке}
glubina = 4; {на сколько полуходов просчитывать}
{если фигура черная то (figure in blacks) если белая - (figure in whites)}
{если фигура - пешка то (figure mod 10 = peshka) итп}
{===========================================================}
type
tpos = record x,y:byte; end; {позиция}
thod = record a,b:tpos; end; {ход}
tfield = array[1..8,1..8] of byte; {доска}
{}
tplayerstate = record {состояние игрока}
king:tpos; {позиция короля на доске, чтобы каждый раз не искать его}
leftmoved,rightmoved,kingmoved,shah:boolean;
{двигалась ли левая ладья/правая ладья/король}
end;
{}
thodlist = record {список ходов}
h : array[1..maxmoves] of thod; {массив ходов}
c : byte; {размер массива}
end;
{}
tsit = record {ситуация}
field:tfield; {доска}
lastmove : thod; {предыдуший ход}
whitesmove:boolean; {просчитывается ли ход для белых}
Wh,Bl: tplayerstate; {состояния игроков}
moves: array[1..256] of thod; {пройденные ходы}
moves_count:byte; {количество ходов}
end;
{=================================================================}
const
startfield : tfield = ( {доска в начале игры}
(bladya,bpeshka,0,0,0,0,wpeshka,wladya),
(bkon, bpeshka,0,0,0,0,wpeshka,wkon),
(bslon, bpeshka,0,0,0,0,wpeshka,wslon),
(bferz, bpeshka,0,0,0,0,wpeshka,wferz),
(bkorol,bpeshka,0,0,0,0,wpeshka,wkorol),
(bslon, bpeshka,0,0,0,0,wpeshka,wslon),
(bkon, bpeshka,0,0,0,0,wpeshka,wkon),
(bladya,bpeshka,0,0,0,0,wpeshka,wladya)
);
{
(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),
(bkorol,0,0,wkorol,0,0,0,0),
(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),
(bferz,0,0,0,0,0,0,0));
}
{=================================}
type
tCellCol = (b,w,s,c,l); // black, white, select, cursor, last
var
bmp : array[peshka..korol,1..4] of pointer; {картинки фигур}
arrow:pointer; {стрелка мыши}
{1 - белая фигура на белой клетке
2 - черная фигура на белой клетке
3 - белая фигура на черной клетке
4 - черная фигура на черной клетке}
{=================================}
{заполняет массив картинок}
procedure make_bitmaps;
const
pic : array[peshka..korol,1..160] of byte = (
(5,49,47,49,47,49,47,44,47,44,41,40,41,40,37,39,38,39,30,26,31,21,31,28,22,
21,22,28,22,28,15,40,16,39,10,40,10,40,5,45,5,45,5,48,14,21,39,21,14,21,18,
16,18,16,22,14,22,14,19,12,19,12,19,7,19,7,23,4,23,4,29,4,29,4,34,7,34,7,34,
12,34,12,31,14,31,14,38,21,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0),(17,48,46,48,46,48,46,35,46,35,44,26,44,26,41,18,40,18,
35,14,36,14,29,12,32,12,26,11,26,11,22,5,22,4,20,12,20,10,18,10,18,10,16,12,
17,11,14,5,14,5,14,12,14,12,11,16,11,16,11,20,11,20,4,31,4,31,4,35,4,35,9,
38,9,38,11,39,11,39,13,38,13,38,15,33,15,33,25,29,25,29,26,27,26,27,26,34,
26,33,18,42,18,42,17,48,9,38,11,33,7,33,8,31,8,31,8,33,14,20,17,18,17,18,15,
21,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
(4,49,4,47,4,47,8,44,8,44,20,44,3,49,22,49,30,49,47,49,30,49,26,42,27,42,25,
42,25,42,21,49,19,44,23,40,22,41,30,41,30,41,32,44,32,44,44,44,44,44,47,49,
22,40,18,38,30,41,34,38,34,38,26,36,26,36,17,39,18,31,18,39,34,39,34,30,34,
31,25,29,26,29,17,31,34,31,38,24,18,31,14,24,14,24,26,11,26,11,38,25,26,10,
29,7,29,7,26,4,26,4,23,7,23,7,26,10,26,17,26,26,22,22,30,22,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),(8,4,8,13,44,4,44,
13,8,4,14,4,37,4,44,4,37,4,37,9,14,4,14,9,14,9,23,9,29,9,37,9,29,9,29,4,29,
4,23,4,23,4,23,9,8,13,14,17,43,13,37,17,37,17,37,30,14,17,14,30,14,30,9,36,
37,30,42,36,9,36,4,44,41,36,46,44,4,44,4,49,46,44,46,49,4,49,47,49,8,13,44,
13,14,17,37,17,14,30,37,30,9,36,42,36,4,44,47,44,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0),(14,42,14,46,14,46,21,49,21,49,31,49,31,49,38,46,38,46,38,41,38,41,30,39,
30,39,22,39,22,39,14,42,38,43,38,34,14,42,14,34,14,35,26,30,26,30,38,35,24,
35,29,35,26,33,26,37,14,34,7,15,7,15,17,27,17,27,16,10,16,10,23,26,23,26,26,
8,26,8,29,26,29,26,35,10,35,10,35,27,35,27,45,15,45,14,38,35,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),(12,33,12,45,12,45,20,49,20,49,32,49,
32,49,40,46,40,46,40,42,40,42,31,39,31,39,20,40,20,40,12,43,40,42,40,33,12,
34,21,30,21,30,32,30,32,30,40,33,27,30,20,18,20,18,16,15,16,15,9,15,9,15,4,
20,4,20,5,27,5,27,12,33,25,30,34,16,34,16,43,15,43,15,48,19,48,19,48,27,48,
27,40,34,21,19,22,16,22,16,26,13,26,13,30,16,29,15,32,19,21,13,31,13,31,13,
31,4,31,4,22,4,21,4,21,13,22,4,31,13,31,4,22,13,27,32,24,34,24,34,27,36,27,
36,29,34,29,34,26,32,0,0,0,0,0,0,0,0,0,0,0,0));
razmer: array[peshka..korol] of byte = (22,31,31,27,24,37);
st1 = 50; {сторона квадрата картинки линий}
st2 = sh div 8-2; {сторона картинки на экране}
var
a,b,c: integer;
begin
for c:=1 to 4 do
for a:=peshka to korol do
begin
{очищаем экран}
cleardevice;
{устанавливаем цвет фигуры}
case c of
1,3: begin setcolor(white); setfillstyle(solidfill,black); end;
2,4: begin setcolor(black); setfillstyle(solidfill,white); end;
end;
{рисуем фон цветом фигуры}
bar(0,0,st2,st2);
Line(0,st2+1,st2+1,st2+1);
Line(st2+1,0,st2+1,st2+1);
{рисуем линии фигуры}
for b:=1 to razmer[a] do
line(
pic[a,b*4-3]*st2 div st1,
pic[a,b*4-2]*st2 div st1,
pic[a,b*4-1]*st2 div st1,
pic[a,b*4-0]*st2 div st1
);
{устанавливаем цвет клетки}
case c of
1,2: setfillstyle(solidfill,lightgray);
3,4: setfillstyle(solidfill,darkgray);
end;
{заливаем пространство вне фигуры цветом клетки}
case c of
1,3: floodfill(0,0,white);
2,4: floodfill(0,0,black);
end;
{у нас остается фигура залитая своим цветом и ограниченная линиями}
{засовываем получившуюся картинку в массив}
getmem(bmp[a,c],imagesize(0,0,st2,st2));
getimage(0,0,st2,st2,bmp[a,c]^);
{}
end;
{рисуем стрелку мыши}
cleardevice;
setcolor(white);
setlinestyle(0,0,3); {толщина линий}
line(0,0,10,10); {крестик}
line(10,0,0,10);
getmem(arrow,imagesize(0,0,10,10)); {выделяем память}
getimage(0,0,10,10,arrow^); {копируем картинку в память}
setlinestyle(0,0,1); {толщина линий}
end;
{=================================}
var
sit0: tsit;
sel0,cur0: tpos;
col,col0: array [1..8,1..8] of byte; {цвет клетки}
const
Shown: boolean= false;
{рисует доску}
procedure paintfield(sit: tsit; const cur,sel: tpos);
procedure Frame(x1,y1,x2,y2: integer);
begin
MoveTo(x1,y1);
LineTo(x1,y2);
LineTo(x2,y2);
LineTo(x2,y1);
LineTo(x1,y1);
end;
const
st = sh div 8; {сторона квадрата шахматной доски}
var
i,j,p: integer;
begin
with sit do with lastmove do begin
if not Shown then begin
{чертим доску}
setcolor(GridCol);
for i:=0 to 8 do begin
line(st*i,0,st*i,st*8);
line(0,st*i,st*8,st*i);
end
end;
{рисуем фигуры}
for i:=1 to 8 do begin
for j:=1 to 8 do begin
if
(i=sel.x) and (j=sel.y)
then
col[i,j]:= SelectCol
else
if
(i=a.x) and (j=a.y) or (i=b.x) and (j=b.y)
then col[i,j]:= LastMoveCol
else col[i,j]:= CellCol[(i+j) mod 2];
if
not Shown or
(field[i,j] <> sit0.field[i,j]) or
(col[i,j]<>col0[i,j]) or
(i=cur0.x) and (j=cur0.y)
then begin
{в зависимости от того что надо нарисовать выбираем
соответствующий второй индекс в массиве bmp}
if sit.field[i,j]<>pusto then
if (i+j) mod 2=0 then
if sit.field[i,j] in whites then p := 2 else p := 1
else
if sit.field[i,j] in whites then p := 4 else p := 3
else p:=0;
{рисуем фигуру}
if p<>0 then begin
putimage((i-1)*st+1,(j-1)*st+1,bmp[sit.field[i,j] mod 10,p]^,0);
setfillstyle(solidfill,col[i,j]);
if
not (col[i,j] in [WhiteCell,BlackCell])
then
floodfill((i-1)*st+1,(j-1)*st+1,GridCol);
end
else begin
{иначе закрашиваем клетку}
setfillstyle(solidfill,col[i,j]);
bar((i-1)*st+1,(j-1)*st+1,i*st-1,j*st-1);
end;
end;
SetLineStyle(SolidLn,1,ThickWidth);
if (i=cur.x) and (j=cur.y) then begin
SetColor(CursorCol);
Frame((i-1)*st+2, (j-1)*st+2, i*st-2, j*st-2);
end
else
if (i=cur0.x) and (j=cur0.y) then begin
SetColor(col[i,j]);
Frame((i-1)*st+2, (j-1)*st+2, i*st-2, j*st-2);
end;
end
end
end;
sit0:= sit;
sel0:= sel;
cur0:= cur;
col0:= col;
Shown:= true;
end;
{=================================}
{выводит информацию о состоянии игры}
procedure show_state(const sit:tsit; const game_ended:boolean);
const bx = sw - 130; by = 50; {координаты первой записи}
begin
setcolor(white);
{закрашиваем правую часть экрана черным}
setfillstyle(solidfill,black);
bar(sh+1,0,sw,sh);
{пишем там чей сейчас ход}
if sit.whitesmove then outtextxy(bx,by,'Hod: White') else
outtextxy(bx,by,'Hod: Black');
{и кому сейчас шах}
if sit.Wh.shah then outtextxy(bx,by + 10,'Shah: White');
if sit.Bl.shah then outtextxy(bx,by + 10,'Shah: Black');
{чем закончилась игра}
if game_ended then
begin
{}
if sit.Wh.shah then outtextxy(bx,by + 20,'Blacks Win!') else
if sit.Bl.shah then outtextxy(bx,by + 20,'Whites Win!') else
outtextxy(bx,by + 20,'Draw!');
{}
end;
{}
end;
{=================================}
{записывает ситуацию в начале игры}
procedure make_start_sit(var sit:tsit);
begin
sit.field := startfield;
{}
sit.Bl.kingmoved := false;
sit.Wh.kingmoved := false;
sit.Bl.king.x := 5;
sit.Bl.king.y := 1;
sit.Wh.king.x := 5;
sit.Wh.king.y := 8;
sit.Bl.leftmoved := false;
sit.Bl.rightmoved := false;
sit.Wh.leftmoved := false;
sit.Wh.rightmoved := false;
sit.whitesmove := true;
sit.lastmove.a.x := 0;
sit.lastmove.b.x := 0;
sit.lastmove.a.y := 0;
sit.lastmove.b.y := 0;
sit.Wh.shah := false;
sit.Bl.shah := false;
sit.moves_count := 0;
end;
{=================================}
{правильность хода без учета шахов}
function is_legal_move(const sit:tsit; const hod:thod): boolean;
{свободна ли линия хода}
function linefree(const x1,y1,x2,y2:byte):boolean;
var x,y:byte; dx,dy:shortint;
begin
{устанавливаем дельта в зависимости от направления движения}
if x1 = x2 then dx := 0;
if y1 = y2 then dy := 0;
if x1 > x2 then dx := -1;
if x1 < x2 then dx := 1;
if y1 > y2 then dy := -1;
if y1 < y2 then dy := 1;
{устанавливаем начальную позицию и линия предположительно свободна}
x := x1;
y := y1;
linefree := true;
{до тех пор пока не дойдем до конечной позиции}
while not((x=x2) and (y=y2)) do
begin
{изменяем координаты проверяемой клетки}
x := x + dx;
y := y + dy;
{если в этой клетке кто-то есть и он не на конечной позиции}
if (sit.field[x,y] <> pusto) and not((x=x2) and (y=y2)) then
begin
linefree := false; {то линия занята}
exit;
end;
{}
end;
{}
end;
{----------------------------}
{не под атакой ли линия рокировки}
function linesafe(const x1,y1,x2,y2:byte; whiteattacker:boolean):boolean;
var
x,y,i,j:byte;
dx,dy:shortint;
tmphod:thod;
begin
{устанавливаем дельта в зависимости от направления движения}
if x1 = x2 then dx := 0;
if y1 = y2 then dy := 0;
if x1 > x2 then dx := -1;
if x1 < x2 then dx := 1;
if y1 > y2 then dy := -1;
if y1 < y2 then dy := 1;
{устанавливаем начальную позицию и линия предположительно свободна}
x := x1;
y := y1;
linesafe := true;
{до тех пор пока не дойдем до конечной позиции}
while not((x=x2) and (y=y2)) do begin
{изменяем координаты проверяемой клетки}
x := x + dx;
y := y + dy;
{перебираем все клетки в поисках атакующего}
for i:=1 to 8 do
for j:=1 to 8 do
{если цвет атакующего совпал с цветом найденной фигуры}
if (
(whiteattacker = (sit.field[i,j] in whites)) and
{и фигура вообще существует и она - не король}
not ((sit.field[i,j] mod 10) in [korol,pusto])
) then with tmphod do begin
{создаем временный ход}
a.x := i;
a.y := j;
b.x := x;
b.y := y;
{проверяем возможен ли он}
if is_legal_move(sit,tmphod) then begin
linesafe := false;
exit;
end;
end;
end;
end;
{--------------------------------------}
begin
{}
if (sit.field[hod.a.x,hod.a.y] = pusto) or {источник хода - пустая клетка}
(hod.a.x = hod.b.x) and (hod.a.y = hod.b.y) then {или ход нулевой}
begin
is_legal_move := false;
exit;
end;
{}
if ((sit.field[hod.a.x,hod.a.y] in whites) = {цвет источника и цели совпадает}
(sit.field[hod.b.x,hod.b.y] in whites)) and
(sit.field[hod.b.x,hod.b.y] <> pusto) then
begin
is_legal_move := false;
exit;
end;
{}
case sit.field[hod.a.x,hod.a.y] mod 10 of
{}
peshka:
is_legal_move := (
{СЛУЧАЙ1 - БОЛЬШОЙ ПРЫЖОК ПЕШКИ}
{если пешка белая и находится на 7 горизонтали или}
(sit.field[hod.a.x,hod.a.y] in whites) and (hod.a.y = 7) or
{пешка черная и находится на 2 горизонтали}
(sit.field[hod.a.x,hod.a.y] in blacks) and (hod.a.y = 2) ) and
{если пешка прыгает через 1 клетку на той же вертикали}
(abs(hod.a.y - hod.b.y) = 2) and (hod.a.x = hod.b.x) and
{и если перед ней пусто}
(sit.field[hod.b.x,hod.b.y] = pusto) and
(sit.field[hod.b.x,(hod.a.y + hod.b.y) div 2] = pusto) or
{СЛУЧАЙ2 - ОБЫЧНЫЙ ХОД ПЕШКИ}
{если та же вертикаль а по горизонталям перемещение на 1 клетку}
(hod.a.x = hod.b.x) and ({}( hod.a.y - hod.b.y = 1) and {вперед}
(sit.field[hod.a.x,hod.a.y] in whites) or {для белой пешки}
( hod.a.y - hod.b.y = -1) and {или назад}
(sit.field[hod.a.x,hod.a.y] in blacks){}) and {для черной пешки}
{и если перед ней пусто}
(sit.field[hod.b.x,hod.b.y] = pusto) or
{СЛУЧАЙ3 - АТАКА ПЕШКИ}
{если пешка белая и перемещается по горизонтали на 1 клетку}
(sit.field[hod.a.x,hod.a.y] in whites) and (abs(hod.a.x - hod.b.x)=1) and
{и перемещается вверх на одну клетку}
(hod.b.y = hod.a.y - 1) and
{и там черная фигура}
(sit.field[hod.b.x,hod.b.y] in blacks) or
{если пешка черная и перемещается по горизонтали на 1 клетку}
(sit.field[hod.a.x,hod.a.y] in blacks) and (abs(hod.a.x - hod.b.x)=1) and
{и перемещается вниз на одну клетку}
(hod.b.y = hod.a.y + 1) and
{и там белая фигура}
(sit.field[hod.b.x,hod.b.y] in whites) or
{СЛУЧАЙ4 - АТАКА НА ВРАЖЕСКУЮ ПЕШКУ, ПЕРЕПРЫГНУВШУЮ БИТОЕ ПОЛЕ}
{если пешка белая}
(sit.field[hod.a.x,hod.a.y] in whites) and
{переместилась по горизонтали на 1 клетку и по вертикали на 1 клетку вверх}
(abs(hod.a.x-hod.b.x) = 1) and ((hod.a.y - hod.b.y)=1) and
{предыдущий ход был сделан}
(sit.lastmove.a.x>0) and
{и предыдущий ход делала вражеская пешка}
(sit.field[sit.lastmove.b.x,sit.lastmove.b.y] = bpeshka) and
{из клетки с соответствующей горизонталью и вертикулью}
(sit.lastmove.a.x = hod.b.x) and (sit.lastmove.a.y = hod.b.y - 1) and
{в клетку}
(sit.lastmove.b.x = hod.b.x) and (sit.lastmove.b.y = hod.b.y + 1) or
{если пешка черная}
(sit.field[hod.a.x,hod.a.y] in blacks) and
{переместилась по горизонтали на 1 клетку и по вертикали на 1 клетку вниз}
(abs(hod.a.x-hod.b.x) = 1) and ((hod.a.y - hod.b.y)=-1) and
{и предыдущий ход делала вражеская пешка}
(sit.field[sit.lastmove.b.x,sit.lastmove.b.y] = wpeshka) and
{из клетки с соответствующей горизонталью и вертикулью}
(sit.lastmove.a.x = hod.b.x) and (sit.lastmove.a.y = hod.b.y + 1) and
{в клетку}
(sit.lastmove.b.x = hod.b.x) and (sit.lastmove.b.y = hod.b.y - 1);
kon:
is_legal_move :=
{если начало и конец хода не совпадают ни горизонталью ни вертикалью}
(hod.a.x <> hod.b.x) and (hod.a.y <> hod.b.y) and
{и расстояние перемещения по горизонтали + вертикали = 3 клетки (буква Г)}
((abs(hod.a.x - hod.b.x) + abs(hod.a.y - hod.b.y)) = 3);
slon:
is_legal_move :=
{если ходим по диагонали и путь чист}
( abs(hod.a.x - hod.b.x) = abs(hod.a.y - hod.b.y) ) and
linefree(hod.a.x,hod.a.y,hod.b.x,hod.b.y);
ladya:
is_legal_move :=
{если ходим по вертикали или горизонтали и путь чист}
( (hod.a.x = hod.b.x) or (hod.a.y = hod.b.y) ) and
linefree(hod.a.x,hod.a.y,hod.b.x,hod.b.y);
ferz:
is_legal_move := (
{слон +}
( abs(hod.a.x - hod.b.x) = abs(hod.a.y - hod.b.y) ) or
{ладья + путь чист}
(hod.a.x = hod.b.x) or (hod.a.y = hod.b.y) ) and
linefree(hod.a.x,hod.a.y,hod.b.x,hod.b.y);
korol:
is_legal_move :=
{СЛУЧАЙ1 - ОБЫЧНЫЙ ХОД}
{только на 1 клетку по горизонтали}
(abs(hod.a.x - hod.b.x) = 1) and (abs(hod.a.y - hod.b.y) = 0) or
{только на 1 клетку по вертикали}
(abs(hod.a.x - hod.b.x) = 0) and (abs(hod.a.y - hod.b.y) = 1) or
{или одновременно и по горизонтали и по вертикали на 1 клетку}
(abs(hod.a.x - hod.b.x) = 1) and (abs(hod.a.y - hod.b.y) = 1) or
{СЛУЧАЙ2 - РОКИРОВКА}
{белый король не двигался}
(sit.field[hod.a.x,hod.a.y] in whites) and not sit.Wh.kingmoved and
{и белому королю не шах}
not sit.Wh.shah and
{и при рокировке влево не двигалась левая ладья}
( (hod.a.x - hod.b.x = 2) and not sit.Wh.leftmoved and
(sit.field[1,8] = wladya) and (hod.a.y = hod.b.y) and
{и между королем и ладьей никого нет и линия не под ударом}
linefree(5,8,1,8) and linesafe(5,8,1,8,false) or
{или же при рокировке вправо не двигалась правая ладья}
(hod.a.x - hod.b.x = -2) and not sit.Wh.rightmoved and
(sit.field[8,8] = wladya) and (hod.a.y = hod.b.y) and
{и между королем и ладьей никого нет и линия не под ударом}
linefree(5,8,8,8) ) and linesafe(5,8,8,8,false) or
{аналогично рокировка для черного короля}
(sit.field[hod.a.x,hod.a.y] in blacks) and not sit.Bl.kingmoved and
not sit.Bl.shah and
( (hod.a.x - hod.b.x = 2) and not sit.Bl.leftmoved and
(sit.field[1,1] = bladya) and (hod.a.y = hod.b.y) and
linefree(5,1,1,1) and linesafe(5,1,1,1,true) or
(hod.a.x - hod.b.x = -2) and not sit.Bl.rightmoved and
(sit.field[8,1] = bladya) and (hod.a.y = hod.b.y) and
linefree(5,1,8,1) and linesafe(5,1,8,1,true));
end;{case}
end;
{=================================}
{делает ход. процедура вызывается только при после проверки правильности хода}
procedure makemove(var sit:tsit; const hod:thod);
var a,b:byte;
tmphod:thod;
begin
{}
case sit.field[hod.a.x,hod.a.y] mod 10 of
{}
peshka:
begin
{если пешка поменяла вертикаль и ушла в пустоту то убиваем врага}
if (hod.a.x <> hod.b.x) and (sit.field[hod.b.x,hod.b.y] = pusto) then
sit.field[hod.b.x,hod.a.y] := pusto;
{если пешка дошла до конца, превращаем ее в ферзя}
if (hod.b.y = 1) or (hod.b.y = 8) then
begin
{белая пешка}
if (sit.field[hod.a.x,hod.a.y] = wpeshka) then
sit.field[hod.a.x,hod.a.y] := wferz;
{черная пешка}
if (sit.field[hod.a.x,hod.a.y] = bpeshka) then
sit.field[hod.a.x,hod.a.y] := bferz;
{}
end;
{}
{}
end;
{}
korol:
begin
{рокировка}
if (abs(hod.a.x - hod.b.x) = 2) then {перепрыгнул клетку горизонтально}
{для белого короля}
if sit.whitesmove then
begin
if hod.a.x > hod.b.x then
begin
sit.Wh.leftmoved := true;
sit.field[4,8] := wladya;
sit.field[1,8] := pusto;
end;
if hod.a.x < hod.b.x then
begin
sit.Wh.rightmoved := true;
sit.field[6,8] := wladya;
sit.field[8,8] := pusto;
end;
end else
begin {для черного короля}
if hod.a.x > hod.b.x then
begin
sit.Bl.leftmoved := true;
sit.field[4,1] := bladya;
sit.field[1,1] := pusto;
end;
if hod.a.x < hod.b.x then
begin
sit.Bl.rightmoved := true;
sit.field[6,1] := bladya;
sit.field[8,1] := pusto;
end;
end; {if}
{}
{помечаем что король ходил}
if sit.whitesmove then sit.Wh.kingmoved := true else
sit.Bl.kingmoved := true;
{изменяем его координаты}
if sit.whitesmove then sit.Wh.king := hod.b else
sit.Bl.king := hod.b;
{}
end;
{}
ladya:
begin
{помечаем какая ладья ходила}
if (hod.a.x = 1) and (hod.a.y = 1) then sit.Bl.leftmoved := true;
if (hod.a.x = 8) and (hod.a.y = 1) then sit.Bl.rightmoved := true;
if (hod.a.x = 1) and (hod.a.y = 8) then sit.Wh.leftmoved := true;
if (hod.a.x = 8) and (hod.a.y = 8) then sit.Wh.rightmoved := true;
{}
end;
{}
end;{case}
{делаем ход}
sit.field[hod.b.x,hod.b.y] := sit.field[hod.a.x,hod.a.y];
sit.field[hod.a.x,hod.a.y] := pusto;
{передаем ход оппоненту}
sit.whitesmove := not sit.whitesmove;
{}
{детектор шахов}
{предполагаем что шахов нет}
sit.Bl.shah := false;
sit.Wh.shah := false;
{перебираем все клетки доски}
for a:=1 to 8 do
for b:=1 to 8 do
{если в этой клетке не пустота значит оттуда возможно могут напасть}
if sit.field[a,b]<>pusto then
begin
{устанавливаем источником хода - эту клетку}
tmphod.a.x := a;
tmphod.a.y := b;
{если на этой клетке белая фигура то приемник хода - черный король}
if sit.field[a,b] in whites then
tmphod.b := sit.Bl.king;
{а если там черные то нападаем на белого короля}
if sit.field[a,b] in blacks then
tmphod.b := sit.Wh.king;
{если фигура на этой клетке может атаковать короля}
if is_legal_move(sit,tmphod) then
begin
{значит соответвтвующему королю - шах}
if sit.field[a,b] in whites then sit.Bl.shah := true else
sit.Wh.shah := true;
{}
end;
{}
end;
{помечаем последний сделанный ход}
sit.lastmove := hod;
{добавляем ход в список}
inc(sit.moves_count);
sit.moves[sit.moves_count] := hod;
end;
{=================================}
{возможен ли ход}
function canmove(const sit:tsit; const hod:thod):boolean;
var nextsit : tsit; {ситуация после проверяемого хода}
begin
{предполагаем что ход возможен}
canmove := true;
{копируем ситуацию}
nextsit := sit;
{если фигура может так ходить то делаем ход}
if is_legal_move(sit,hod) and
((sit.field[hod.a.x,hod.a.y] in whites) = sit.whitesmove) then
makemove(nextsit,hod) else {иначе ход уже точно невозможен}
begin
canmove := false;
exit;
end;
{если после хода образуется шах тому кто ходил то ход невозможен}
if (nextsit.whitesmove and nextsit.Bl.shah) or
(not nextsit.whitesmove and nextsit.Wh.shah) then canmove := false;
{}
end;
{=================================}
{получить список всех возможных ходов}
procedure get_all_moves(const sit:tsit; var list:thodlist);
var a,b,c,d:byte; tmphod:thod;
list1,list2:thodlist;
begin
{в начале - списки пусты}
list1.c := 0;
list2.c := 0;
{перебираем все клетки доски}
for a:=1 to 8 do
for b:=1 to 8 do
{если на клетке не пусто значит оттуда можно ходить}
if sit.field[a,b] <> pusto then
for c:=1 to 8 do
for d:=1 to 8 do
begin
{}
if ((sit.field[c,d] in whites) <>
(sit.field[a,b] in whites)) and
(sit.field[c,d] <> pusto) then {добавляем взятия}
begin
{}
tmphod.a.x := a;
tmphod.a.y := b;
tmphod.b.x := c;
tmphod.b.y := d;
{}
if canmove(sit,tmphod) then
begin
{}
inc(list1.c);
list1.h[list1.c] := tmphod;
{}
end;
{}
end;
{}
if (sit.field[c,d] = pusto) then {добавляем обычные ходы}
begin
{}
tmphod.a.x := a;
tmphod.a.y := b;
tmphod.b.x := c;
tmphod.b.y := d;
{}
if canmove(sit,tmphod) then
begin
{}
inc(list2.c);
list2.h[list2.c] := tmphod;
{}
end;
{}
end;
{}
end;{for}
{объедияем списки}
list.c := 0;
{}
for a:=1 to list1.c do
begin
inc(list.c);
list.h[list.c] := list1.h[a];
end;
{}
for a:=1 to list2.c do
begin
inc(list.c);
list.h[list.c] := list2.h[a];
end;
{}
end;
{=================================}
{закончилась ли игра}
function is_game_ended(const sit:tsit; var list:thodlist):boolean;
var cwslon,cwkon,cbslon,cbkon,a,b,d:byte;
sovp:boolean;
begin
{получаем список всех возможных ходов}
get_all_moves(sit,list);
{если список пуст - значит игра закончилась}
is_game_ended := (list.c=0);
{}
if (list.c=0) then exit;
{}
{если ходы повторились (3) 4 раза то наступает ничья}
{}
a := 4; {длина серии}
d := 0; {смещение серий}
b := 0; {доп}
{пока помещается 2 длины серии ищем повторяющиеся}
while (sit.moves_count>=a*2) and (a<=128) do
begin
{в начале совпавших серий нет}
sovp := true;
{перебираем последовательные серии}
for b:=1 to a do {если ходы не равны}
if (sit.moves[b+d].a.x <> sit.moves[b+a+d].a.x) or
(sit.moves[b+d].a.y <> sit.moves[b+a+d].a.y) or
(sit.moves[b+d].b.x <> sit.moves[b+a+d].b.x) or
(sit.moves[b+d].b.y <> sit.moves[b+a+d].b.y) then
begin {совпадений нет}
sovp := false;
break;
end;
{если совпадения есть}
if sovp then
begin {то ничья}
is_game_ended := true;
exit;
end;
{пока можно, увеличиваем сдвиг а затем увеличиваем длину серии}
if sit.moves_count>a*2+d then inc(d) else inc(a,2);
{}
end;{while}
{}
{возможно ничья наступила из-за нехватки фигур}
cwslon := 0; cwkon := 0; cbslon := 0; cbkon := 0;
{считаем фигуры}
for a:=1 to 8 do
for b:=1 to 8 do
begin
{считаем слонов и коней}
case sit.field[a,b] of
wslon: inc(cwslon);
bslon: inc(cbslon);
wkon: inc(cwkon);
bkon: inc(cbkon);
end;
{если на поле все еще есть ферзь или ладья или пешка но это - не ничья}
if (sit.field[a,b] mod 10) in [ferz,ladya,peshka] then exit;
{если слонов и коней достаточно для победы то ничья не наступила}
if (cwslon > 1) or (cbslon > 1) or (cbkon > 1) or (cwkon > 1) or
(cwslon = 1) and (cwkon = 1) or (cbslon = 1) and (cbkon = 1) then exit;
{}
end;
{если фигур все же не хватает то наступила ничья}
is_game_ended := true;
{}
end;
{=================================}
{материальный вес фигуры}
const ves:array[peshka..korol] of word = (100,300,300,500,900,0);
korol_not_moved = 20; {нетронутый король}
ladya_not_moved = 10; {нетронутая ладья}
king_attack = 50; {оценка за шах}
{}
{позиционная оценка фигур}
peshka_pos: array[1..8,1..8] of shortint =
((0, 0, 0, 0, 0, 0, 0, 0),
(4, 4, 4, 0, 0, 4, 4, 4),
(6, 8, 2,10,10, 2, 8, 6),
(6, 8,12,16,16,12, 8, 6),
(8,12,16,24,24,16,12, 8),
(12,16,24,32,32,24,16,12),
(12,16,24,32,32,24,16,12),
(0, 0, 0, 0, 0, 0, 0, 0));
{}
korol1_pos: array[1..8,1..8] of shortint =
(( 0, 0, -4,-10,-10, -4, 0, 0),
( -4, -4, -8,-12,-12, -8, -4, -4),
(-12,-16,-20,-20,-20,-20,-16,-12),
(-16,-20,-24,-24,-24,-24,-20,-16),
(-16,-20,-24,-24,-24,-24,-20,-16),
(-12,-16,-20,-20,-20,-20,-16,-12),
(-4, -4, -8,-12,-12, -8, -4, -4),
( 0, 0, -4,-10,-10, -4, 0, 0));
{}
korol2_pos: array[1..8,1..8] of shortint =
(( 0, 6, 12, 18, 18, 12, 6, 0),
( 6, 12, 18, 24, 24, 18, 12, 6),
( 12, 18, 24, 30, 30, 24, 18, 12),
( 18, 24, 30, 36, 36, 30, 24, 18),
( 18, 24, 30, 36, 36, 30, 24, 18),
( 12, 18, 24, 30, 30, 24, 18, 12),
( 6, 12, 18, 24, 24, 18, 12, 6),
( 0, 6, 12, 18, 18, 12, 6, 0));
{}
kon_pos: array[1..8,1..8] of shortint =
(( 0, 4, 8,10,10, 8, 4, 0),
( 4, 8,16,20,20,16, 8, 4),
( 8,16,24,28,28,24,16, 8),
(10,20,28,32,32,28,20,10),
(10,20,28,32,32,28,20,10),
( 8,16,24,28,28,24,16, 8),
( 4, 8,16,20,20,16, 8, 4),
( 0, 4, 8,10,10, 8, 4, 0));
{}
slon_pos: array[1..8,1..8] of shortint =
((14,14,14,14,14,14,14,14),
(14,22,18,18,18,18,22,14),
(14,18,22,22,22,22,18,14),
(14,18,22,22,22,22,18,14),
(14,18,22,22,22,22,18,14),
(14,18,22,22,22,22,18,14),
(14,22,18,18,18,18,22,14),
(14,14,14,14,14,14,14,14));
{}
ferz_pos = 50; {коэффициент который делится на расстояние до вражеского короля}
{}
{оценочная функция}
procedure evaluate(const sit:tsit; var mark:integer);
var
a,b,figures:byte;
ka:shortint;
begin
mark := 0;
figures := 0;
{подсчет материала}
with sit do begin
for a:=1 to 8 do for b:=1 to 8 do if field[a,b]<>pusto then begin
{увеличиваем число фигур на доске}
inc(figures);
{черные фигуры + а белые -}
if field[a,b] in blacks then ka := 1 else ka := -1;
{материальная оценка}
mark := mark + ves[field[a,b] mod 10]*ka;
{позиционная оценка}
case field[a,b] mod 10 of
peshka:
if field[a,b] in blacks then
mark := mark + peshka_pos[a,b]
else
mark := mark - peshka_pos[a,9-b];
kon: mark := mark + kon_pos[a,b]*ka;
slon: mark := mark + slon_pos[a,b]*ka;
ferz:
if field[a,b] in blacks then
mark :=
round(mark + ferz_pos / ( abs(a-Wh.king.x) +
abs(b-Wh.king.y) ))
else
mark := round(mark - ferz_pos / ( abs(a-Bl.king.x)
+ abs(b-Bl.king.y) ));
end;{case}
end;
{оценка нетронутой ладьи и короля}
if Wh.kingmoved then mark := mark + korol_not_moved;
if Bl.kingmoved then mark := mark - korol_not_moved;
if Wh.leftmoved then mark := mark + ladya_not_moved;
if Bl.leftmoved then mark := mark - ladya_not_moved;
if Wh.rightmoved then mark := mark + ladya_not_moved;
if Bl.rightmoved then mark := mark - ladya_not_moved;
{оценка за шах}
if Wh.shah then mark := mark + king_attack;
if Bl.shah then mark := mark - king_attack;
{оценка позиции короля}
mark := round(mark + korol1_pos[Bl.king.x,Bl.king.y] * figures / 30+
korol2_pos[Bl.king.x,Bl.king.y] * (1-figures / 30));
mark := round(mark - korol1_pos[Wh.king.x,Wh.king.y] * figures / 30-
korol2_pos[Wh.king.x,Wh.king.y] * (1-figures / 30));
end
end;
{=================================}
{оценка ситуации}
procedure search(const sit:tsit; const whitecolor:boolean; const depth:byte;
{игровая ситуация, за белых ли считаем, грубина перебора}
alpha,beta:integer; var mark:integer);
{границы отсечений, возвращаемая оценка}
var
list:thodlist; {список возможных ходов}
nextsit:tsit; {ситуация после хода}
a:byte; {доп переменная}
mabyend:boolean; {возможно, что (depth=0)and(list.c=0)}
tempmark:integer; {лучшая оценка и возвращенная оценка}
begin
mabyend := false;
{если достигли дна стека то включаем оценочную функцию}
if (depth=0) then begin
evaluate(sit,mark);
{тк оценочная функция работает на черных для того чтобы
она работала на белых результат нужно взять с обратным знаком}
if whitecolor then mark := -mark;
{если кому-то шах значит это может бить концом игры и оценка будет другая}
if not sit.Bl.shah and not sit.Wh.shah then exit else mabyend := true;
end;
{получаем все ходы и если ходов нету, значит мат или ничья}
if is_game_ended(sit,list) then begin
{с точки зрения черных оцениваем мат и ничью}
if sit.Wh.shah then mark := 32000
else if sit.Bl.shah then mark := -32000 else mark := -32000;
{а для белых инвертируем}
if whitecolor then mark := -mark;
exit;
end;
{если конец игры не подтвердился, все равно выходим}
if mabyend then exit;
{перебираем ходы}
a := 1;
{если максимальная оценка хода для игрока А (альфа) превысила
максимальную нценку для игрока Б (бета), которая была получена на
предыдущем ходе, то мы может досрочно прекратить перебор и вернуть
альфа в качестве результата, т.к. уровнем выше мы все равно выберем
ход с максимальной оценкой (альфа) и поднимать ее еще выше не имеет
смысла. Если мы продолжим перебор то альфа будет только увеличиваться}
while (a<>list.c+1) {and (alpha<beta)} do begin
{создаем следующую ситуацию}
nextsit := sit;
makemove(nextsit,list.h[a]);
{считаем ее пользу}
search(nextsit,not whitecolor,depth - 1,-beta,-alpha,tempmark);
{тк считаем для врага, его польза нам во вред}
tempmark := - tempmark;
{если нашли ход получше, записываем его}
if tempmark > alpha then alpha := tempmark;
inc(a);
end;
{возвращаем результат}
mark := alpha;
end;
{=================================}
{ход компа}
procedure hod_compa(var sit:tsit; const whitecolor:boolean);
{}
const bx = sw - 130; by = sh - 50; w = 100; {progress bar}
{}
var list:thodlist; {ходы}
nextsit:tsit; {ситуация после хода}
a,bestmove:byte; {доп переменная и номер лучшего хода}
tempmark:integer; {возвращенная и лучшая оценки}
alpha,beta:integer; {границы оценок}
{}
begin
{получаем ходы}
get_all_moves(sit,list);
alpha := -22000; beta := 22000;
bestmove := 1;
{перебираем}
a := 1;
{}
while (a<>list.c+1) {and (alpha<beta)} do
begin
{создаем ситуацию}
nextsit := sit;
makemove(nextsit,list.h[a]);
{считаем ее пользу}
search(nextsit,not whitecolor,glubina-1,-beta,-alpha,tempmark);
tempmark := - tempmark;
{обновляем лучшую оценку и лучший ход}
if tempmark > alpha then
begin
bestmove := a;
alpha := tempmark;
end;
{progress bar}
setcolor(magenta);
line(bx,by,bx+w,by);
setcolor(lightgreen);
line(bx,by,round(bx+w*a/list.c),by);
{}
inc(a);
end;
{делаем ход}
makemove(sit,list.h[bestmove]);
{}
end;
{==================================}
var
mainsit : tsit; {главная игровая ситуация}
gd,gm:integer; {Graph driver Graph mode}
game_ended,poshel: boolean; {закончилась ли игра/человек сделал ход}
vibral:boolean; {человек выбрал клетку}
cur,sel: tpos; {координаты текущей и выбранной ячейки}
k: char; {нажатая кнопка}
tmphod:thod; {проверяемый ход}
tmplist: thodlist; {нафиг не нужен, но функиця без него не вызывается}
reg:registers; {регистры для мыши}
changed: boolean; {внешний вид экрана изменился}
pressed:boolean; {мышь нажата}
event:boolean; {мышь кликнута}
mouse:pointtype; {координаты мыши}
repaint:boolean; {перерисовка курсора мыши}
function Moveit(dx,dy: integer): boolean;
begin
with cur do begin
dx:= x+dx;
dy:= y+dy;
if (dx>0) and (dx<9) and (dy>0) and (dy<9) then begin
x:= dx;
y:= dy;
MoveIt:= true
end
else MoveIt:= false
end
end;
BEGIN {main}
gd := vga;
gm := vgahi;
initgraph(gd,gm,'');
{начальные установки}
make_bitmaps;
make_start_sit(mainsit);
game_ended := false;
mouse.x := 0; mouse.y := 0;
cur.x := 5; cur.y := 5;
k := #0;
{задаем координаты крысодрома}
with reg do
begin
ax := $7;
cx := 0;
dx := sh;
Intr($33,Reg);
ax := $8;
cx := 0;
dx := sh;
Intr($33,Reg);
end;
while (k<>#27) do {главный цикл}
begin
{}
poshel := false;
vibral := false;
pressed := false;
repaint := false;
sel.x := 0; sel.y := 0;
{рисуем доску}
paintfield(mainsit,cur,sel);
{если поле не изменилось то рисуем мышь}
if not changed then putimage(mouse.x - 5,mouse.y - 5,arrow^,xorput);
{}
repeat {ход человека}
{}
{если поле изменилось то рисуем мышь заново}
if changed then putimage(mouse.x - 5,mouse.y - 5,arrow^,xorput);
{}
k := #0;
changed := false;
event := false;
{получаем состояние мыши}
reg.ax := $3;
Intr($33,Reg);
{если координаты мыши изменились то нужно ее перерисовать}
repaint := (reg.cx <> mouse.x) or (reg.dx <> mouse.y);
{стираем мышь}
if repaint then putimage(mouse.x - 5,mouse.y - 5,arrow^,xorput);
{новые координаты мыши}
mouse.x := reg.cx;
mouse.y := reg.dx;
{перерисовываем мышь}
if repaint then putimage(mouse.x - 5,mouse.y - 5,arrow^,xorput);
{если кнопка нажата то считываем клавишу и перерисовываем экран}
k := readkey;
if k=#0 then k := readkey;
with cur do case k of
#72: Changed:= MoveIt( 0,-1);
#75: Changed:= MoveIt(-1, 0);
#77: Changed:= MoveIt( 1, 0);
#80: Changed:= MoveIt( 0, 1); {вниз}
#27: halt; {выход}
end; {case}
{условия клика мыши}
if (reg.bx<>0) then
begin
pressed := true;
end else
if pressed then
begin
event := true;
pressed := false;
end;
{выбор клетки}
if (k in [' ',#13]) or event then begin
{выбор текущей клетки мышью}
if event then begin
cur.x := mouse.x div (sh div 8)+1;
cur.y := mouse.y div (sh div 8)+1;
changed := true;
end;
if not vibral then begin
if mainsit.field[cur.x,cur.y] in whites then begin {если клетка не вырана то выбираем}
vibral := true;
sel.x := cur.x;
sel.y := cur.y;
Changed:= true;
end
end
else begin {если выбрана то проверяем возможен ли такой ход}
tmphod.a := sel;
tmphod.b := cur;
if
canmove(mainsit,tmphod) and {если возможен то ходим}
not game_ended
then begin
poshel := true;
makemove(mainsit,tmphod);
Changed:= true;
end
else if mainsit.field[cur.x,cur.y] in whites then begin
sel:= cur; {иначе просто выбираем эту клетку}
Changed:= true
end;{else}
end;
event := false;
{}
end;{k}
{перерисовка по необходимости}
if changed then paintfield(mainsit,cur,sel); {рисуем доску}
{}
until poshel; {ход человека}
{определяем закончилась ли игра}
game_ended := is_game_ended(mainsit,tmplist);
{отображаем состояние игры}
show_state(mainsit,game_ended);
{ход компа}
if not game_ended then
begin
{ходим}
hod_compa(mainsit,false);
{определяем закончилась ли игра}
game_ended := is_game_ended(mainsit,tmplist);
{отображаем состояние игры}
show_state(mainsit,game_ended);
{}
end; {comp}
{}
end; {while}
{}
closegraph;
{}
END.