Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Лабиринт на Паскале

Автор: _PAhA_ 23.05.2007 14:04

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

Автор: Ozzя 23.05.2007 14:21

{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.