{Шахматы. Хакимов Артем, 23гр.}
uses crt,graph,dos;

const
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 = {5}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; {просчитывается ли ход для белых}
white,black: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));

{=================================}

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:byte;

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);
      {рисуем линии фигуры}
      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: begin floodfill(0,0,white); end;
      2,4: begin floodfill(0,0,black); end;
      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;

{=================================}

{рисует доску}
procedure paintfield(const sit: tsit; const cur,sel:tpos);
const st = sh div 8; {сторона квадрата шахматной доски}
var a,b,p:byte;
whitecell:boolean; {закрашиваем ли клетку белым}
begin
{чертим доску}
setcolor(white);
for a:=0 to 8 do
   begin
   line(st*a,0,st*a,st*8);
   line(0,st*a,st*8,st*a);
   end;
{рисуем фигуры}
whitecell := false;
{}
for a:=1 to 8 do
   begin
   {}
   for b:=1 to 8 do
      begin
      {меняем цвет каждой следующей клетки}
      whitecell := not whitecell;
      {в зависимости от того что надо нарисовать выбираем
      соответствующий второй индекс в массиве bmp}
      if sit.field[a,b]<>pusto then
      if whitecell then
      if sit.field[a,b] in whites then p := 2 else p := 1 else
      if sit.field[a,b] in whites then p := 4 else p := 3 else p := 0;
      {рисуем фигуру}
      if p<>0 then
      putimage((a-1)*st+1,(b-1)*st+1,bmp[sit.field[a,b] mod 10,p]^,0) else
         begin
         {иначе закрашиваем клетку}
         if whitecell then setfillstyle(solidfill,lightgray) else
         setfillstyle(solidfill,darkgray);
         {}
         bar((a-1)*st+1,(b-1)*st+1,a*st-1,b*st-1);
         {}
         end;
      {если на этой клетке стоит курсор - заливаем ее зеленым}
      if (a=cur.x) and (b=cur.y) then
         begin
         setfillstyle(solidfill,green);
         floodfill((a-1)*st+1,(b-1)*st+1,white);
         end else
      {аналогично для выбранной клетки}
      if (a=sel.x) and (b=sel.y) then
         begin
         setfillstyle(solidfill,blue);
         floodfill((a-1)*st+1,(b-1)*st+1,white);
         end else
      {клетка относящаяся к последнему ходу закрашивается другим цветом}
      if (a=sit.lastmove.a.x) and (b=sit.lastmove.a.y) or
         (a=sit.lastmove.b.x) and (b=sit.lastmove.b.y) then
         begin
         setfillstyle(solidfill,brown);
         floodfill((a-1)*st+1,(b-1)*st+1,white);
         end;
      {}
      end;
   {это потому что в строке - четное количество клеток}
   whitecell := not whitecell;
   {}
   end;
{}
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.white.shah then outtextxy(bx,by + 10,'Shah: White');
if sit.black.shah then outtextxy(bx,by + 10,'Shah: Black');
{чем закончилась игра}
if game_ended then
   begin
   {}
   if sit.white.shah then outtextxy(bx,by + 20,'Blacks Win!') else
   if sit.black.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.black.kingmoved := false;
sit.white.kingmoved := false;
sit.black.king.x := 5;
sit.black.king.y := 1;
sit.white.king.x := 5;
sit.white.king.y := 8;
sit.black.leftmoved := false;
sit.black.rightmoved := false;
sit.white.leftmoved := false;
sit.white.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.white.shah := false;
sit.black.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,a,b: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 a:=1 to 8 do
      for b:=1 to 8 do
         {если цвет атакующего совпал с цветом найденной фигуры}
         if (whiteattacker = (sit.field[a,b] in whites)) and
         {и фигура вообще существует и она - не король}
         not ((sit.field[a,b] mod 10) in [korol,pusto]) then
            begin
            {создаем временный ход}
            tmphod.a.x := a;
            tmphod.a.y := b;
            tmphod.b.x := x;
            tmphod.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.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.white.kingmoved and
   {и белому королю не шах}
   not sit.white.shah and
   {и при рокировке влево не двигалась левая ладья}
   ( (hod.a.x - hod.b.x = 2) and not sit.white.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.white.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.black.kingmoved and
   not sit.black.shah and
   ( (hod.a.x - hod.b.x = 2) and not sit.black.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.black.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.white.leftmoved := true;
            sit.field[4,8] := wladya;
            sit.field[1,8] := pusto;
            end;
         if hod.a.x < hod.b.x then
            begin
            sit.white.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.black.leftmoved := true;
               sit.field[4,1] := bladya;
               sit.field[1,1] := pusto;
               end;
            if hod.a.x < hod.b.x then
               begin
               sit.black.rightmoved := true;
               sit.field[6,1] := bladya;
               sit.field[8,1] := pusto;
               end;
            end; {if}
   {}
   {помечаем что король ходил}
   if sit.whitesmove then sit.white.kingmoved := true else
   sit.black.kingmoved := true;
   {изменяем его координаты}
   if sit.whitesmove then sit.white.king := hod.b else
   sit.black.king := hod.b;
   {}
   end;
{}
ladya:
   begin
   {помечаем какая ладья ходила}
   if (hod.a.x = 1) and (hod.a.y = 1) then sit.black.leftmoved := true;
   if (hod.a.x = 8) and (hod.a.y = 1) then sit.black.rightmoved := true;
   if (hod.a.x = 1) and (hod.a.y = 8) then sit.white.leftmoved := true;
   if (hod.a.x = 8) and (hod.a.y = 8) then sit.white.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.black.shah := false;
sit.white.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.black.king;
        {а если там черные то нападаем на белого короля}
        if sit.field[a,b] in blacks then
        tmphod.b := sit.white.king;
        {если фигура на этой клетке может атаковать короля}
        if is_legal_move(sit,tmphod) then
           begin
           {значит соответвтвующему королю - шах}
           if sit.field[a,b] in whites then sit.black.shah := true else
           sit.white.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.black.shah) or
   (not nextsit.whitesmove and nextsit.white.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;
{подсчет материала}
for a:=1 to 8 do
   for b:=1 to 8 do
      if sit.field[a,b]<>pusto then
         begin
         {увеличиваем число фигур на доске}
         inc(figures);
         {черные фигуры + а белые -}
         if sit.field[a,b] in blacks then ka := 1 else ka := -1;
         {материальная оценка}
         mark := mark + ves[sit.field[a,b] mod 10]*ka;
         {позиционная оценка}
         case sit.field[a,b] mod 10 of
         peshka:
            if sit.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 sit.field[a,b] in blacks then
            mark := round(mark + ferz_pos / ( abs(a-sit.white.king.x)
            + abs(b-sit.white.king.y) )) else
            mark := round(mark - ferz_pos / ( abs(a-sit.black.king.x)
            + abs(b-sit.black.king.y) ));
         end;{case}
         {}
         end;
{оценка нетронутой ладьи и короля}
if sit.white.kingmoved then mark := mark + korol_not_moved;
if sit.black.kingmoved then mark := mark - korol_not_moved;
if sit.white.leftmoved then mark := mark + ladya_not_moved;
if sit.black.leftmoved then mark := mark - ladya_not_moved;
if sit.white.rightmoved then mark := mark + ladya_not_moved;
if sit.black.rightmoved then mark := mark - ladya_not_moved;
{оценка за шах}
if sit.white.shah then mark := mark + king_attack;
if sit.black.shah then mark := mark - king_attack;
{оценка позиции короля}
mark := round(mark + korol1_pos[sit.black.king.x,sit.black.king.y] * figures / 30+
   korol2_pos[sit.black.king.x,sit.black.king.y] * (1-figures / 30));
mark := round(mark - korol1_pos[sit.white.king.x,sit.white.king.y] * figures / 30-
   korol2_pos[sit.white.king.x,sit.white.king.y] * (1-figures / 30));
{}
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.black.shah and not sit.white.shah then exit else mabyend := true;
   {}
   end;
{получаем все ходы и если ходов нету, значит мат или ничья}
if is_game_ended(sit,list) then
   begin
   {с точки зрения черных оцениваем мат и ничью}
   if sit.white.shah then mark := 32000 else
   if sit.black.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; {перерисовка курсора мыши}

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);
      {если кнопка нажата то считываем клавишу и перерисовываем экран}
      if keypressed then
         begin
         k := readkey;
         if k=#0 then k := readkey;
         changed := true;
         end;
      {}
      case k of
      #72: if cur.y>1 then dec(cur.y); {вверх}
      #75: if cur.x>1 then dec(cur.x); {влево}
      #77: if cur.x<8 then inc(cur.x); {вправо}
      #80: if cur.y<8 then inc(cur.y); {вниз}
      #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
            vibral := true;
            sel.x := cur.x;
            sel.y := cur.y;
            {}
            end else {если выбрана то проверяем возможен ли такой ход}
               begin
               {}
               tmphod.a := sel;
               tmphod.b := cur;
               {}
               if canmove(mainsit,tmphod) {если возможен то ходим}
               and not game_ended then
                  begin
                  poshel := true;
                  makemove(mainsit,tmphod);
                  end else {иначе просто выбираем эту клетку}
                     begin
                     sel.x := cur.x;
                     sel.y := cur.y;
                     end;
               {}
               end;{else}
         {}
         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.