IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Лабиринт на Паскале, СРОЧНЩ!!!!
сообщение
Сообщение #1


Гость






Помогите пожалуйста!!! Курсовая горит, нужно лабиринт на Паскале сделать, только не сложный, чтоб на 1 курс тянул!!! Помогите пожалуйста!
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 220
Пол: Мужской

Репутация: -  16  +


{Copyright by Kilor [TE@M16] <20.12.2000>}
{
Достаточно простая программа, показывающая как:
1. Создать односвязный лабиринт без циклов (типа "дерево").
[*] Достаточно распространенная задача, встречающаяся при генерации уровней
во многих играх.
2. Как найти в этом лабиринте наиболее длинный путь.
[*] Одна из наиболее интересных прикладных задач. Серединой этого пути
является точка, сумма расстояний до которой от всех остальных точек
лабиринта минимальна.
3. Как ускорить достаточно медленный волновой алгоритм прохождения лабиринта
(а вобщем-то и любой другой) при помощи объектно-ориентированного
программирования, использовав при этом и преимущества рекурсии.
4. Ну и, наконец, как создать просто красивый скринсейвер под DOS.
}
uses
crt,
graph,
dos;

const
k=2; {коэффициент увеличения}
type
Position=object
cx, cy, pcx, pcy : integer;
procedure move;
procedure init(vx, vy, pvx, pvy : integer);
end;

var
a, b, c, d, x, y, dx, dy, md, mdx1, mdy1, mdx2, mdy2 : integer;
lint : array [0..160, 0..120] of integer;
ActPos : array [1..200] of Position;
kw : longint;
tx : boolean;
num_pos, num_pos2 : integer;
gr,gm:Integer;

procedure Position.init(vx, vy, pvx, pvy : integer);
begin
{порождение новой "пройденной" точки}
inc(num_pos);
cx:=vx;
cy:=vy;
pcx:=pvx;
pcy:=pvy;
setcolor(9);
line(cx*k, cy*k, pcx*k, pcy*k);
end;
procedure Position.move;
begin
lint[cx, cy]:=lint[pcx, pcy]+1;
{ветвление от текущей точки в стороны...}
if (getpixel(cx*k-1, cy*k)=15) and ((pcx<>cx-1) or (pcy<>cy)) then ActPos[num_pos+1].init(cx-1, cy, cx, cy);
if (getpixel(cx*k, cy*k-1)=15) and ((pcx<>cx) or (pcy<>cy-1)) then ActPos[num_pos+1].init(cx, cy-1, cx, cy);
if (getpixel(cx*k+1, cy*k)=15) and ((pcx<>cx+1) or (pcy<>cy)) then ActPos[num_pos+1].init(cx+1, cy, cx, cy);
if (getpixel(cx*k, cy*k+1)=15) and ((pcx<>cx) or (pcy<>cy+1)) then ActPos[num_pos+1].init(cx, cy+1, cx, cy);
{ожидание для каждой точки равное 300/общее кол-во точек на предыдущем шаге}
{благодаря этому достигается равномерность прохождения лабиринта вне
зависимости от количества активных точек}
{ delay(300 div num_pos2);}
{... и уничтожение текущей точки}
cx:=-1;
end;

function test : boolean;
var tr : boolean;
begin
{тест точки на доступность для заполнения}
tr:=true;
if (x>=0) and (x<=getmaxx div k) and (y>=0) and (y<=getmaxy div k) then
begin
if (getpixel(x*k-k, y*k)=0) and ((x-1)*k<getmaxx) and (y*k<getmaxy) and (x-1>=0) and (y>=0) then tr:=false;
if (getpixel(x*k+k, y*k)=0) and ((x+1)*k<getmaxx) and (y*k<getmaxy) and (x+1>=0) and (y>=0) then tr:=false;
if (getpixel(x*k, y*k-k)=0) and (x*k<getmaxx) and ((y-1)*k<getmaxy) and (x>=0) and (y-1>=0) then tr:=false;
if (getpixel(x*k, y*k+k)=0) and (x*k<getmaxx) and ((y+1)*k<getmaxy) and (x>=0) and (y+1>=0) then tr:=false;
end;
test:=tr;
end;
procedure dist(ax, ay : integer);
var tr : boolean;
begin
{заполнение лабиринта (массива lint[]) расстояниями до точки (ax, ay)
и нахождение наиболее удаленной}

{обнуление всех переменных, массивов, ...}
num_pos:=0;
for a:=0 to (getmaxx div k)+1 do
for b:=0 to (getmaxy div k)+1 do
lint[a, b]:=0;
num_pos2:=1;
{запуск "порождения" точек, начиная с заданной}
ActPos[1].init(ax, ay, ax, ay);
{"порождение", пока есть свободные точки}
while (num_pos>0) and (not keypressed) do
begin
{сдвиг активных точек в массиве в начало для ускорения прохождения}
a:=0;
b:=1;
while a<num_pos do
begin
if ActPos[b].cx<>-1 then
begin
inc(a);
ActPos[a]:=ActPos[b];
end;
inc(b);
end;
a:=num_pos;
num_pos2:=num_pos;
{поочередное задействование активных "точек порождения"}
for b:=1 to a do ActPos[b].move;
dec(num_pos, a);
end;
for a:=0 to getmaxx do
for b:=0 to getmaxy do
if getpixel(a, b)=9 then putpixel(a, b, 15);
end;
begin
randomize;
gr:=Detect;
initgraph(gr,gm,'C:\BP\BGI');
while not keypressed do
begin
{алгоритм создания лабиринта прост:}
{ 1. Начинаем с середины экрана.}
x:=(getmaxx div 2) div k;
y:=(getmaxy div 2) div k;
moveto(x*k, y*k);
putpixel(x*k, y*k, 15);
setcolor(15);
kw:=((getmaxx div k)+1)*((getmaxy div k)+1);
dec(kw);
while (kw>0) and (not keypressed) do
begin
putpixel(x*k, y*k, 15);
dx:=0;
dy:=0;
{ 2. Случайно рисуем за собой след, не пересекая уже имеющийся, пока не}
{ "запремся" в уже прочерченном следе.}
if random(2)=0 then dx:=(random(2)*2)-1 else dy:=(random(2)*2)-1;
if (getpixel((x+dx)*k, (y+dy)*k)=0) and ((x+dx)*k<getmaxx) and ((y+dy)*k<getmaxy) and (x+dx>=0) and (y+dy>=0) then
begin
inc(x, dx);
inc(y, dy);
lineto(x*k, y*k);
dec(kw);
end;
putpixel(x*k, y*k, 9);
if (test=true) and (kw>0) then
begin
dx:=0;
dy:=0;
if random(2)=0 then dx:=(random(2)*2)-1 else dy:=(random(2)*2)-1;
{ 3. Случайно перемещаемся по узлам уже имеющегося следа, пока не найдем еще}
{ свободную точку.}
if ((x+dx)*k<getmaxx) and ((y+dy)*k<getmaxy) and (x+dx>=0) and (y+dy>=0) then
begin
{ 4. Рисуем в нее след из той точки, откуда мы в нее попали.}
putpixel(x*k, y*k, 15);
inc(x, dx);
inc(y, dy);
moveto(x*k, y*k);
{putpixel(x*k, y*k, 15);}
end;
{ 5. Возвращаемся к пункту 2, если на экране существуют пустые точки (kw>0)}
end;
end;
putpixel(x*k, y*k, 15);

{непосредственный поиск наидлиннейшего пути:}
{ 1. Определяем наиболее удаленную точку от последней прочерченной.}
{ (очевидно, что искомый путь соединяет две "висячие" вершины)}
dist(x, y);
md:=0;
for a:=0 to getmaxx div k do
for b:=0 to getmaxy div k do
if md<lint[a, b] then
begin
md:=lint[a, b];
mdx1:=a;
mdy1:=b;
end;
{ 2. Повторяем пункт 1 для найденной точки.}
dist(mdx1, mdy1);
md:=0;
for a:=0 to getmaxx div k do
for b:=0 to getmaxy div k do
if md<lint[a, b] then
begin
md:=lint[a, b];
mdx2:=a;
mdy2:=b;
end;
{ 3. Путь между точками 1 и 2 - искомый. Отрисовываем его.}

{ Этот факт имеет достаточно несложное доказательство на основе теории графов.}
a:=mdx2;
b:=mdy2;
moveto(a*k, b*k);
setcolor(9);
while ((a<>mdx1) or (b<>mdy1)) and (not keypressed) do
begin
if (lint[a-1, b]=lint[a, b]-1) and (getpixel(a*k-1, b*k)<>0) then dec(a) else
if (lint[a, b-1]=lint[a, b]-1) and (getpixel(a*k, b*k-1)<>0) then dec(b) else
if (lint[a+1, b]=lint[a, b]-1) and (getpixel(a*k+1, b*k)<>0) then inc(a) else
if (lint[a, b+1]=lint[a, b]-1) and (getpixel(a*k, b*k+1)<>0) then inc(b);
lineto(a*k, b*k);
delay(200);
end;
if not keypressed then delay(30000);
cleardevice;
end;
closegraph;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 26.10.2020 3:07
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name