PMG

Форумы по созданию игр
Текущее время: 23 окт 2017 03:04

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ Сообщений: 6 ] 
Автор Сообщение
 Заголовок сообщения: Волновой поиск
СообщениеДобавлено: 06 сен 2005 18:59 
Не в сети
Опытный
Аватара пользователя

Зарегистрирован: 11 дек 2004 22:33
Сообщения: 112
Откуда: Ханты-Мансийск
Здесь я не буду задавать вопросы а выложу свой пример на PASCAL реализации алгоритма Волнового поиска пути.

P.S. Если что-то непонятно спрашивайте. Можете разместить на этом сайте.

Код:
uses Graph,Crt;

const
  Map: array[0..14,0..19] of integer =
  (
  (1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
  (1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1),
  (1,0,0,5,1,0,1,0,0,0,0,1,1,1,1,0,0,0,0,1),
  (1,1,1,1,1,0,1,0,1,1,1,1,0,0,0,0,1,0,0,1),
  (1,1,0,0,0,0,1,0,0,0,1,0,0,1,1,0,1,1,1,1),
  (1,1,0,1,1,1,1,0,0,1,1,0,0,0,0,0,0,0,0,1),
  (1,0,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1,1,0,1),
  (1,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,0,1,0,1),
  (1,0,0,0,1,0,1,1,1,1,1,1,0,1,0,0,0,0,0,1),
  (1,1,1,0,1,0,1,0,0,0,0,1,0,1,0,0,1,1,1,1),
  (1,0,1,0,0,0,1,0,1,0,1,1,1,1,1,0,1,0,0,1),
  (1,0,1,0,0,0,1,6,1,0,1,0,0,0,1,0,0,0,0,1),
  (1,0,0,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,0,1),
  (1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,1),
  (1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
  );

var
  grDriver: Integer;
  grMode: Integer;
  ErrCode: Integer;
  key: char;
  stx,sty,ex,ey:integer;
  Calc:array[0..14,0..19] of integer;

function IntToStr(I: Longint): String;
var
  S: string[11];
begin
  Str(I, S);
  IntToStr := S;
end;

procedure Calculation;
var i,j:integer;
    max:integer;
    findon:boolean;
begin
  setcolor(green);
  Calc[sty,stx]:=1;
  max:=1;
  findon:=false;
  while (findon=false) do
  begin
    for i:=0 to 14 do begin
    for j:=0 to 19 do begin
    if (Calc[i,j]=max) and (i=ey) and (j=ex) then findon:=true;
      if ((Calc[i,j]=max) and (findon=false)) then
      begin
      OutTextXY(round(GetMaxX/20*(j))+6,round(GetMaxY/15*(i))+6,IntToStr(max));
        if Calc[i+1,j]=0 then begin
          Calc[i+1,j]:=max+1;
        end;
        if Calc[i,j-1]=0 then begin
          Calc[i,j-1]:=max+1;
        end;
        if Calc[i-1,j]=0 then begin
          Calc[i-1,j]:=max+1;
        end;
        if Calc[i,j+1]=0 then begin
          Calc[i,j+1]:=max+1;
        end;
      end;
      end;
      end;
      max:=max+1;
      delay(7000);
  end;
end;

procedure Update(ox,oy,x,y:integer);
begin
  setcolor(black);
  Circle(round(GetMaxX/20*(ox))+16,round(GetMaxY/15*(oy))+16,14);
  setcolor(white);
  Circle(round(GetMaxX/20*(x))+16,round(GetMaxY/15*(y))+16,14);
end;

procedure MoveTo;
var i,j,max,x,y:integer;
begin
  max:=Calc[ey,ex];
  x:=ex; y:=ey;
  while max<>1 do begin
    if (Calc[y-1,x]=max-1) then begin
      Update(x,y,x,y-1);
      y:=y-1;
      max:=max-1;
      delay(5000);
    end;
    if (Calc[y,x-1]=max-1) then begin
      Update(x,y,x-1,y);
      x:=x-1;
      max:=max-1;
      delay(5000);
    end;
    if (Calc[y+1,x]=max-1) then begin
      Update(x,y,x,y+1);
      y:=y+1;
      max:=max-1;
      delay(5000);
    end;
    if (Calc[y,x+1]=max-1) then begin
      Update(x,y,x+1,y);
      x:=x+1;
      max:=max-1;
      delay(5000);
    end;
  end;
end;

procedure Grind(lx,ly:integer);
var i:integer;
begin
  for i:=0 to lx do begin
    line(round(GetMaxX/lx*i),0,round(GetMaxX/lx*i),GetMaxY);
  end;
  for i:=0 to ly do begin
    line(0,round(GetMaxY/ly*i),GetMaxX,round(GetMaxY/ly*i));
  end;
end;

procedure LoadMap;
var i,j:integer;
begin
  for i:=0 to 14 do begin
    for j:=0 to 19 do begin
      case Map[i,j] of
        0:Calc[i,j]:=0;
        1:begin
            Calc[i,j]:=-1;
            FloodFill(round(GetMaxX/20*(j))+1, round(GetMaxY/15*(i))+1, White);
        end;
        5:begin
            ex:=j; ey:=i;
            Circle(round(GetMaxX/20*(j))+16,round(GetMaxY/15*(i))+16,14);
        end;
        6:begin
            stx:=j; sty:=i;
            Line(round(GetMaxX/20*(j))+4,round(GetMaxY/15*(i))+4,
                 round(GetMaxX/20*(j))+28,round(GetMaxY/15*(i))+28);
            Line(round(GetMaxX/20*(j))+28,round(GetMaxY/15*(i))+4,
                 round(GetMaxX/20*(j))+4,round(GetMaxY/15*(i))+28);
        end;
      end;
    end;
  end;
end;

begin
  grDriver := Detect;
  InitGraph(grDriver, grMode,'');
  ErrCode := GraphResult;
  if ErrCode = grOk then
  begin  { Do graphics }
    Grind(20,15);
    LoadMap;
    key:=readkey;
    if (key=#13) then halt;
    if (key='L') or (key='l') then Calculation;
    MoveTo;
    Readln;
    CloseGraph;
  end
  else
    Writeln('Graphics error:', GraphErrorMsg(ErrCode));
end.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: 07 сен 2005 11:53 
Не в сети
Гуру
Аватара пользователя

Зарегистрирован: 03 авг 2004 10:37
Сообщения: 2686
Откуда: Кирово-Чепецк
Если хочешь могу положить этот исходник в файл:
http://pmg.org.ru/ai/findpath.zip
© Анисимов С.Ю. Описание алгоритмов поиска пути или навигация путника (A*, волновой алгоритм, алгоритм разделяй и влавствуй,поворота Креша). Перевод статьи John Christian Lonningdal - Smart unit navigation.
Примеры программ Pascal, C, txt, doc.
© Valentin Ovcharenko, Alexander Valeryanovich, Michael Vladimirovich. Поиск пути с помощью "метода приоритета".
Borland C++ v3.1, Turbo Pascal
© Фролов Андрей. Алгоритм обхода препятствий на двухмерной карте по правилу правой/левой руки.
© Никуличев Денис. Класс GWave реализует версию волнового алгоритма.

_________________
С уважением, Сергей


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: 07 сен 2005 17:17 
Не в сети
Опытный
Аватара пользователя

Зарегистрирован: 11 дек 2004 22:33
Сообщения: 112
Откуда: Ханты-Мансийск
Да можешь вложить только с авторскими правами на меня !!!

_________________
С уважением, Владислав


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: 08 сен 2005 11:32 
Не в сети
Гуру
Аватара пользователя

Зарегистрирован: 03 авг 2004 10:37
Сообщения: 2686
Откуда: Кирово-Чепецк
Естественно. И что написать в комментариях?

_________________
С уважением, Сергей


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: 08 сен 2005 18:02 
Не в сети
Опытный
Аватара пользователя

Зарегистрирован: 11 дек 2004 22:33
Сообщения: 112
Откуда: Ханты-Мансийск
© Василенко Владислав. Пример реализации Волнового алгоритма в Borland Pascal 7.0.

_________________
С уважением, Владислав


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: 09 сен 2005 14:30 
Не в сети
Гуру
Аватара пользователя

Зарегистрирован: 03 авг 2004 10:37
Сообщения: 2686
Откуда: Кирово-Чепецк
ok

_________________
С уважением, Сергей


Вернуться к началу
 Профиль  
 
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 6 ] 

Часовой пояс: UTC + 3 часа [ Летнее время ]


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
Русская поддержка phpBB