Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на Delphi и Lazarus

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 3.312 RSS
←   Октябрь 2010   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


За последние 60 дней ни разу не выходила


Сайт рассылки: http://rusfaq.ru/
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

3.312 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на Delphi и Lazarus


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Лучшие эксперты данной рассылки

Boriss
Статус: Академик
Рейтинг: 2521
∙ повысить рейтинг » 		Орловский Дмитрий
Статус: Профессор
Рейтинг: 2517
∙ повысить рейтинг » 		Евгений/Genia007/
Статус: Профессионал
Рейтинг: 1109
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И СОФТ / Программирование / Delphi и Lazarus

Номер выпуска:1562
Дата выхода:29.10.2010, 05:30
Администратор рассылки:Калашников О.А. (Руководитель)
Подписчиков / экспертов:282 / 195
Вопросов / ответов:1 / 1

Вопрос № 180304: Здравствуйте дорогие эксперты! Помогите пожалуйста с курсовым проэктом. Мне необходимо сделать игру "МАТ 2 ФИГУРАМИ" Тоисть надо чтобы на шахматной доске(каждый квадратие это елемент Timage) играли 2 фигуры и вражеский король.<...

Вопрос № 180304:

Здравствуйте дорогие эксперты!

Помогите пожалуйста с курсовым проэктом.
Мне необходимо сделать игру "МАТ 2 ФИГУРАМИ"
Тоисть надо чтобы на шахматной доске(каждый квадратие это елемент Timage) играли 2 фигуры и вражеский король.

Основная рутина по движку уже продумана, но никак не могу продумать систему проверки, которая бы проверяла после каждого совершонного хода мат ли королю.....

Помогите процедуркой или советом....просто уже голова кипит от 10.000 строчек кода!

Отправлен: 13.10.2010, 05:19
Вопрос задал: Юдин Евгений Сергеевич (1-й класс)
Всего ответов: 1
Страница вопроса »

Отвечает lamed (Профессор) :
Здравствуйте, Евгений Сергеевич!
© Цитата:
Сколько уже не сделано! А сколько еще предстоит не сделать..

Считаю целесообразным, прежде чем переходить к графике, отработать алгоритм. Часть реализована (* довольно упрощенно *) в коде.
Если Вы примете этот путь, Вам будет необходимо доработать/разработать
1. проверку "На одной диагонали"
2. проверку "на соседних клетках" (для короля)
3. проверку для пешки
4. проверку на шах. Для этого в цикле по каждой белой фигуре после хода белых проверяется возможность хода на поле черного короля
5. проверку на пат
6. проверку на мат, как "сумму" проверок на шах и пат

Присылайте свои доработки, целесообразно будет создать новую консультацию.
Удачи!
Код:
(*
а.Кр+Ф, Кр+Л, Кр+п
б.Ф+Ф, Ф+Л, Ф+С, Ф+К, Ф+п
в.Л+Л, Л+К, Л+п
г.С+п
д.К+п
е.п+п
*)

program chess;

const

 WHITE = 0;
  BLACK = 1;
type
  TColor = WHITE..BLACK;
  TFigure = record
  (* King, 'K'; Queen, 'Q'; Rook, 'R'; Bishop, 'B'; Knight, 'N'; Pawn, 'P'; *)
    id: integer;
    name: char;
    color: TColor;
    h,v: integer;
    deleted: boolean;
  end;
  TCell = record
    h, v : integer;
    id  : integer;
  end;
  TBoard = array[1..8, 1..8] of integer;
const

   MAXFIG = 50;
  NAMES = ['к', 'ф', 'л', 'ь', 'с', 'п'];
  HORIZ = [1..8];
  VERT  = ['a'..'h'];
  RECREATES = ['ф', 'л', 'к', 'с'];
var
  r,c: integer;
  smove: string;
  figs: array[1..50] of TFigure;
  MaxId: integer;
  board: TBoard;
  KingCheck: boolean; // шах королю
  MoveNo: integer; // номер хода

function ValidMoveSyntax(smove: string): boolean;
// Проверка синтаксиса
хода и элементарные проверки
// 1.начальное поле <> конечному
// 2.превращение пешки в допустимую фигуру
// пe7-e8ф
// кe2-e3
begin
  ValidMoveSyntax :=
    ((smove[1] in names) and (smove[2] in VERT) and
     (ord(smove[3])-ord('0') in HORIZ) and (smove[4] ='-') and
     (smove[5] in VERT) and (ord(smove[6])-ord('0') in HORIZ) and
     ((smove[2]<>smove[5]) or (smove[3]<>smove[6])) and
  
    ((length(smove)=6) or
       (length(smove)=7) and (smove[1]='п') and (smove[7] in RECREATES)));
end; { ValidMoveSyntax }

function ValidMove(c1,c2: TCell): boolean;
// Не анализируем превращение, рокировку
//
function CheckH(c1,c2: TCell): boolean;
var
  i: integer;
begin

  if c1.h <> c2.h then
    CheckH := false
  else
    begin
      for i:= c1.v+1 to c2.v-1 do
        if board[c1.h,i]<>0 then
          exit;
      CheckH :=
true;
    end;
end; { CheckH }

function CheckV(c1,c2: TCell): boolean;
var
  i: integer;
begin

  if c1.v <> c2.v then
    CheckV := false
  else
    begin
      for i:= c1.h+1 to c2.h-1 do
        if board[i, c1.v]<>0 then
          exit;
      CheckV := true;
    end;
end; { CheckV }

function CheckG(c1,c2: TCell): boolean;
begin
  CheckG := abs((c1.h-c2.h)*(c1.v-c2.v))=2;
end; { CheckG }
 

function CheckD(c1,c2: TCell): boolean;
//
// Внимание! Только диагонали, параллельные главной
//
var
  i: integer;

  cells : integer;
  v1, h1: integer;
begin
  CheckD := false;
  cells := c1.v+c1.h-1;
  if c1.v+c1.h=c2.v+c2.h then
  begin
    begin
      if c1.h>c2.h then
        begin
          v1:=c1.v;
          h1:=c1.h;
        end
      else
        begin
          v1:=c2.v;
          h1:=c2.h;
        end;
      for i:= 2 to cells-1 do
        begin
          if board[i, c1.v]<>0 then
            exit;
          dec(h1);
          inc(v1);

       end
    end;
    CheckD := true;
  end;
end; { CheckD }

var
  fig1, fig2: TFigure;
  i, j: integer;
  CanCheck: boolean;
  b1, b2: integer;
begin
  b1:= board[c1.h, c1.v];
  b2:= board[c2.h, c2.v];

  ValidMove := false;
  CanCheck  := false;

  if b1=0 then
    exit;
  fig1:= figs[b1];

  if b2 <> 0 then begin
    fig2:= figs[b2];
    if fig1.color=fig2.color then
      ex
 it;

/// а вот здесь недоработка
/// проверять придется после любого хода белых
/// и любого хода черных
/// пример.
/// Белые. Крf6, Фa1;
/// Черные. Крh8
/// 1.Крf6-g6+! ("Вскрытый" шах)
///
    if fig2.name='к' then
      CanCheck := true;
  end;

  if
    (fig1.name='к') { ToDo } or
    (fig1.name='ф') and (CheckH(c1,c2) or CheckV(c1, c2) or CheckD(c1,c2)) or
    (fig1.name='л') and (CheckH(c1,c2) or CheckV(c1,
c2)) or
    (fig1.name='ь') and CheckG(c1,c2) or
    (fig1.name='с') and CheckD(c1,c2) or
    (fig1.name='п') { ToDo }
  then
    begin
      ValidMove := true;
      if CanCheck then
        KingCheck := true;
    end;
end; { ValidMove }

procedure init;
var
  i,j: integer;
begin
  KingCheck := false;
  MaxId := 0;
  for i:= 1 to 8 do
    for j:= 1 to 8 do
      board[i,j] := 0;
  MoveN
 o := 0;
end; { init }

procedure GetFigures(c: TColor);
// считывание позиций фигур одной стороны
var
  s: string;
  h,v: integer;
begin
  repeat
    write('->');
    readln(s);
    if trim(s)<>'' then
      begin
        h := ord(s[3])-ord('0');
        v := ord(s[2])-ord('a')+1;
        if board[h,v]=0 then
          begin
            inc(MaxId);
            figs[MaxId].name := s[1];
            figs[MaxId].color:=
c;
            figs[MaxId].h:= h;
            figs[MaxId].v:= v;
            figs[MaxId].deleted := false;
            board[h,v]:=MaxId;
          end
        else
          writeln('Ошибка: поле занято');
      end;
    until trim(s)='';
end; { GetFigure }

procedure PrintPos;
var
  sw, sb: string; // позиция белых и черных
  ds: string;
  i: integer;
begin
  sw:= 'Белые : ';
  sb:
 = 'Черные: ';
  for i:= 1 to MaxId do
    begin
      ds := figs[i].name+chr(ord('a')+figs[i].v-1)+chr(ord('0')+figs[i].h);
      if figs[i].color=WHITE then
        sw := sw+ds+' '
      else
        sb := sb+ds+' ';
    end;
  sw:=sw+';';
  sb:=sb+'.';
  writeln(sw);
  writeln(sb);
end; { PrintPos }

procedure StrToMove(sMove: string; var c1: TCell; var c2: TCell);
begin
  c1.v := ord(sMove[2])-ord('a')+1;

 c1.h := ord(sMove[3])-ord('0');

  c2.v := ord(sMove[5])-ord('a')+1;
  c2.h := ord(sMove[6])-ord('0');
end; { StrToMove }

procedure ChangeBoard(c1, c2: TCell);
var
  b1, b2: integer;
begin
  b1:= board[c1.h, c1.v];
  b2:= board[c2.h, c2.v];

  if b2 <> 0 then
    figs[b2].deleted := true;
  figs[b1].h := c2.h;
  figs[b1].v := c2.v;
  board[c2.h,c2.v] := b1;
  board[c1.h
 ,c1.v] := 0;
end; { ChangeBoard }

procedure PrintBoard;
var
  h, v: integer;
begin
  for h:= 8 downto 1 do begin

    for v:= 1 to 8 do
      write(board[h,v],' ');
    writeln;
  end;
  writeln('================');
end; { PrintBoard }

var
  h,v: integer;
  sWhiteMove, sBlackMove: string;
  cc1, cc2: TCell;
  cc3, cc4: TCell;
  done: boolean;
begin { main }

  init;
  // Вводим позицию и заполняем массивы:
  // доску и фигуры
  //
  writeln('Введите позицию белых фигур, пробел для завершения');
  GetFigures(WHITE);

  writeln('Введите
позицию черных фигур, пробел для завершения');
  GetFigures(BLACK);

  // Эхо-печать
  PrintPos;
  PrintBoard;

  // Вводим ходы
  writeln('Вводите ходы, пробел для завершения');
  repeat
    inc(MoveNo);
    write(MoveNo, '.');
    readln(sWhiteMove);
    sWhiteMove := trim(sWhiteMove);

    if sWhiteMove='' then
      begin
        writeln('Партия прервана на ', MoveNo, ' 
 ходу ');
        exit;
      end;

    if not ValidMoveSyntax(sWhiteMove) then
      begin
        writeln('Ошибка в записи ', MoveNo, ' хода белых');
        dec(MoveNo);
        break;
      end;

    StrToMove(sWhiteMove, cc1, cc2);
    if not ValidMove(cc1, cc2) then
      begin
        writeln('Ход ', sWhiteMove, ' невозможен');
        dec(MoveNo);
        break;
      end;

    ChangeBoard(cc1, cc2);
    //
Если все удачно, меняем позицию на доске
    // Меняем список фигур
    PrintPos;
    PrintBoard;

    write(MoveNo, '....');
    done := false;
    while not done do
      begin
        readln(sBlackMove);

        if not ValidMoveSyntax(sBlackMove) then
          begin
            writeln('Ошибка в записи ', MoveNo, ' хода черных');
            write(MoveNo, '....');
            readln(sBlackM
 ove);
          end
        else
          begin
            StrToMove(sBlackMove, cc3, cc4);
            if not ValidMove(cc3,cc4) then
              writeln('Ход черных ', sBlackMove, ' невозможен');
          end;
        done := true;
    end;

    ChangeBoard(cc3,cc4);
    PrintPos;
    PrintBoard;
    // Если все удачно, меняем позицию на доске
    // Меняем список фигур
  until sWhiteMove='';
  writeln('Спасибо за игру!');

end.

Пример диалога
Код:
Введите позицию белых фигур, пробел для завершения
->кh6
->лf6
-> 
Введите позицию черных фигур, пробел для 
 завершения
->кh8
-> 
Белые : кh6 лf6 ;
Черные: кh8 .
0 0 0 0 0 0 0 3 
0 0 0 0 0 0 0 0 
0 0 0 0 0 2 0 1 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
================
Вводите ходы, пробел для завершения
1.лf6-f5
6=5
Белые : кh6 лf5 ;
Черные: кh8 .
0 0 0 0 0 0 0 3 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 1 
0 0 0 0 0 2 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
================
1....кh8-g8
Белые
: кh6 лf5 ;
Черные: кg8 .
0 0 0 0 0 0 3 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 1 
0 0 0 0 0 2 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
================
2.лf5-f6
5=6
Белые : кh6 лf6 ;
Черные: кg8 .
0 0 0 0 0 0 3 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 2 0 1 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
=========
 =======
2....кg8-h8
Белые : кh6 лf6 ;
Черные: кh8 .
0 0 0 0 0 0 0 3 
0 0 0 0 0 0 0 0 
0 0 0 0 0 2 0 1 
0 0 0 0 0 0 0 
0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
0 0 0 0 0 0 0 0 
================
3. 
Партия прервана на 3 ходу


Ответ отправил: lamed (Профессор)
Ответ отправлен: 26.10.2010, 18:21
Номер ответа: 263668

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 263668 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Оценить выпуск »
    Нам очень важно Ваше мнение об этом выпуске рассылки!

    Задать вопрос экспертам этой рассылки »

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)
    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров »

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.

    © 2001-2010, Портал RFPRO.RU, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2010.6.22 от 18.10.2010
    В избранное