Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для мобильных телефонов > MidletPascal > Наше Open Source Software

Наше Open Source Software Наработки для использования в Ваших проектах

Ответ
 
Опции темы
Старый 03.07.2014, 22:59   #1
.:MaSe:.
Оператор ЭВМ
 
Регистрация: 14.08.2013
Сообщений: 27
Написано одно полезное сообщение
Радость Простенький алгоритм обхода препятствий на 8 направлений

Почти в любой игре с видом сверху, при создании ИИ возникает вопрос насчёт враждебных ботов, которые всегда должны доходить до игрока и сражаться с ним и иногда для этого ИИ приходиться проходить через лабиринты.
Если у Вас пошаговая стратегия/РПГ, то лучше конечно же использовать волновой алгоритм, он поможет найти самый короткий и быстрый путь, что очень важно для пошаговых игр, но что если у вас всё происходит в реальном времени и на первом месте стоит память и быстродействие?


Ниже код, сутью которого является нахождение ближайшего к точке назначения пустого блока, когда юнит доходит* до этого пустого блока препятсявие считается пройденным и юнит двигается дальше. Процедура повторяется при каждом обнаружении препятствия.

Program laby;
const 
size=35;

var
x,y,x1,y1,x3,y3,dir,i,j,sx,sy,shrtdist,shrtdistninteger;
dist,dx,dy,k,l: array [0..8of integer;
map: array [1..size,1..sizeof integer;
searchboolean;
keyP,keyC,cx,cyinteger;

function empty(
x,integer): boolean;
begin
if (map[x,y]<1then empty:=true;else empty:=false;
end;

Begin

for i:=1 to size do
for 
j:=1 to size do
begin
if i=1 then map[j,i]:=1;// края мира всегда непроходимы
if j=1 then map[j,i]:=1;
if 
i=size then map[j,i]:=1;
if 
j=size then map[j,i]:=1;

if 
random(8)=0 then map[j,i]:=1;// генерируем случайные препятствия

setcolor(18,133,0);
if 
map[j,i]=1 then fillrect((j-1)*4,(i-1)*4,4,4);
end;

cx:=17;
cy:=17;

k[1]:=-1;    l[1]:=-1;// k для х, l для у
k[2]:= 0;    l[2]:=-1;
k[3]:= 1;    l[3]:=-1;
k[4]:=-1;    l[4]:= 0;
k[5]:= 1;    l[5]:= 0;
k[6]:=-1;    l[6]:= 1;
k[7]:= 0;    l[7]:= 1;
k[8]:= 1;    l[8]:= 1;

repeat
setcolor
(18,235,0);
FillRect(0,0,GetWidth,getHeight);
for 
i:=1 to size do
for 
j:=1 to size do
begin
setcolor
(18,133,0);
if 
map[j,i]=1 then fillrect((j-1)*4,(i-1)*4,4,4);
end;

keyC:=getKeyClicked;

if 
keyC=ke_key2 then cy:=cy-1;
if 
keyC=ke_key6 then cx:=cx+1;
if 
keyC=ke_key8 then cy:=cy+1;
if 
keyC=ke_key4 then cx:=cx-1;
if 
keyC=ke_key5 then
begin

if (x=0) and (y=0then
begin
x
:=cx;// кооридинаты героя
y:=cy;
end;else
begin
x1
:=cx;// координаты точки
y1:=cy;
end;

end;

if (
x=0) and (y=0then setcolor(255,255,2);else
if (
x1=0) and (y1=0then setcolor(255,0,0);

DrawRect((cx-1)*4,(cy-1)*4,3,3);

setcolor(255,255,2);
fillrect((x-1)*4,(y-1)*4,4,4);

setcolor(255,0,0);
DrawRect((x1-1)*4,(y1-1)*4,3,3);

repaint;
until (x>0) and (x1>0) ;


x3:=x;
y3:=y;
repeat

for i:=1 to size do// отрисовка мира
for j:=1 to size do
begin
if map[j,i]=1 then setcolor(18,133,0); else
if 
map[j,i]=2 then setcolor(123,123,123);else
if 
map[j,i]=0 then setcolor(18,235,0);

if (
map[j,i]=2) and (not searchthen map[j,i]:=0;//если юнит перестал искать путь, то "заметаем сделы", чтобы он мог повторно пройтись(например если он в тупике)
fillrect((j-1)*4,(i-1)*4,4,4);
end;

if 
not search then
Begin
if (x>x1) and (y>y1then dir:=1;//вверх-влево
if (x=x1) and (y>y1then dir:=2;//вверх
if (x<x1) and (y>y1then dir:=3;//вверх-вправо
if (x>x1) and (y=y1then dir:=4;//влево
if (x<x1) and (y=y1then dir:=5;//вправо
if (x>x1) and (y<y1then dir:=6;//вниз-влево
if (x=x1) and (y<y1then dir:=7;//вниз
if (x<x1) and (y<y1then dir:=8;//вниз-вправо
End;
else
BEGIN
shrtdist
:=size*size;// самая короткая дистанция равна площади карты
x3:=x1y3:=y1;//каждый раз побуем идти к точке

for i:=1 to 8 do
begin
if empty(x+k[i],y+l[i]) then begin dx[i]:=x1-(x+k[i]); dy[i] :=y1-(y+l[i]); dist[i]:=trunc(sqrt(sqr(dx[i])+sqr(dy[i]))) end;// поиск самого бижайшего пустого блока
if (dist[i]<shrtdist) and (empty(x+k[i],y+l[i])) then
begin
shrtdist
:=dist[i];
shrtdistn:=i;
x3:=x+k[i];
y3:=y+l[i];
end;
end;

if (
x>x3) and (y>y3then dir:=1;
if (
x=x3) and (y>y3then dir:=2;
if (
x<x3) and (y>y3then dir:=3;
if (
x>x3) and (y=y3then dir:=4;
if (
x<x3) and (y=y3then dir:=5;
if (
x>x3) and (y<y3then dir:=6;
if (
x=x3) and (y<y3then dir:=7;
if (
x<x3) and (y<y3then dir:=8;
if (
x=x3) and (y=y3then begin search:=falsex3:=x1y3:=y1end;// если пришли к временной точке, то ничего не исчем и идём к точке

END;

if (
dir=1then begin sx:=-1sy:=-1;  end;
if (
dir=2then begin sx:= 0sy:=-1;  end;
if (
dir=3then begin sx:= 1sy:=-1;  end;
if (
dir=4then begin sx:=-1sy:= 0;  end;
if (
dir=5then begin sx:= 1sy:= 0;  end;
if (
dir=6then begin sx:=-1sy:= 1;  end;
if (
dir=7then begin sx:= 0sy:= 1;  end;
if (
dir=8then begin sx:= 1sy:= 1;  end;


if empty(
x+sx,y+sythen
begin
x
:=x+sx;
y:=y+sy;
end;else search:=true;

map[x,y]:=2;// оставляем след, чтобы не возвращаться

setcolor(255,255,2);
fillrect((x-1)*4,(y-1)*4,4,4);//наш герой

setcolor(255,0,0);
DrawRect((x1-1)*4,(y1-1)*4,3,3);// наша точка


repaint;
delay(250);// чтобы успевать следить за параметрами


until (x=x1) and (y=y1);
setcolor(255,255,2);
DrawText('SUCCESS!!!',0,150);// Мы пришли 
repaint;
delay(3335);
End
Рекомендуется завести переменную(например step: integer) и каждому элементу массива, в котором был герой присваивать отрицательное значение step, а не 2. Если юнит попал в ловушку, то сканируем мир вокруг героя в радиусе одной клетки и если находится элемент с большим значением, то двигаемся к нему.

* В вышеприведённом коде юнит может ходить по диагоналям даже если соседние блоки непроходимы

Последний раз редактировалось .:MaSe:., 04.07.2014 в 01:13.
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
ant0N (04.07.2014)
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 03:15.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com