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

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

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

> Лабиринт, ПОмогите пожалуйста с лабиринтом
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 8
Пол: Мужской
Реальное имя: Андрей

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


Здравствуйте!Помогите пожалуйста с курсовым по Паскалю!Задание примерно состоит в том чтобы сделать программу которая ищет выход из лабиринта.Самому простейшему варианту буду очень рад(желательно с комментариями)Заранее спасибо!
PS Очень оЧЕНЬ надо А я в Паскале не бум бум)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






uses
CRT;

const
mx=100; nx=100;
Left=1; Right=-1;
Trace=-1;

type
tLabyrinth=array[0..mx,0..nx]of integer;

var
m,n,m1,n1,x,y,dx,dy,k,l,x0,i,j:integer;
Lab:tLabyrinth;
f:text;
c:char;

procedure Show;
var
i,j:integer;
begin
for j:=0 to n1 do begin
for i:=0 to m1 do begin
l:=Lab[i,j];
if l>0 then begin
TextColor(l+7);
Write('*');
TextColor(7)
end
else if l=0 then Write(' ')
else Write('#');
end;
WriteLn
end
end;


procedure Turn(dir:integer; var x,y:integer);
var
z:integer;
begin
z:=x;
x:=dir*y;
y:=-dir*z
end;


procedure Step(var x,y,dx,dy:integer);
begin
Turn(Left,dx,dy);
while Lab[x+dx,y+dy]>0 do Turn(Right,dx,dy);
x:=x+dx;
y:=y+dy
end;


begin
{Read the data file}
Assign(f,'labyrinth_0_0.dat');
ReSet(f);
m1:=-1;
while not EoLn(f) do begin
Read(f,c);
Inc(m1);
case c of
'1',' ': Lab[m1,0]:=1;
'0': Lab[m1,0]:=0
end
end;
ReadLn(f);
n1:=0;
while not EoF(f) do begin
Inc(n1);
for i:=0 to m1 do begin
Read(f,c);
case c of
'1',' ': Lab[i,n1]:=1;
'0': Lab[i,n1]:=0
end
end;
ReadLn(f)
end;
m:=m1-1; n:=n1-1;
Close(f);

{Passing}
k:=0;
WriteLn('Labyrinth ',m,'x',n);
{Probing all the entries}
for x0:=m downto 1 do if Lab[x0,0]=0 then begin
Inc(k);
x:=x0;
y:=1;
dx:=0;
dy:=1;
while (y>0)and(y<n1) do begin
Inc(Lab[x,y],Trace);
Step (x,y,dx,dy);
end;
Write('Entry ',k,': ');
if y=0 then WriteLn('No way!') else WriteLn('Passed.');
for j:=1 to n do for i:=1 to m do if Lab[i,j]<0 then Lab[i,j]:=k+1;
Show;
Write('Press Enter..');
ReadLn;
WriteLn
end;
WriteLn('Done.')
end.


Это просто Гениальный лабиринт Lapp'a!МОжет кто нибудь описать что тут и как поисходит?!(что делают процедуры,и как самм программа работает)в каждой строчке)Я попробую сделать свой на подобие этого пожалуйста!
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Цитата(Гость @ 13.09.2011 15:24) *
Я попробую сделать свой

Ловлю на слове ).
Я думаю, можно даже упростить для начала. Если сделать только самое главное, прога будет вдвое меньше. И понять ее будет проще. Хорошо, я помогу.



--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
keng   Лабиринт   11.09.2011 15:42
TarasBer   1. Изучи основы Паскаля (время у тебя есть). 2. Из…   11.09.2011 16:28
Lapp   сделать программу которая ищет выход из лабиринта.…   12.09.2011 7:36
keng   keng, давай начнем с описания лабиринта. Уточни …   12.09.2011 20:04
TarasBer   Ну на один вопрос ты ответил, ладно. Остался второ…   12.09.2011 20:28
keng   У меня есть некоторые мысли но нужно в одну их соб…   13.09.2011 14:15
TarasBer   Надо дописать в начало процедуры вот это, иначе бу…   13.09.2011 15:26
keng   Да оставил если не сдам отчислят(( А как это все о…   13.09.2011 15:44
TarasBer   Ну пишешь всё это и в конце пишешь begin xk :=…   13.09.2011 16:57
keng   uses wincrt; label 1,2,3; var f:text; i,j,k,xn,jn,…   13.09.2011 17:07
Гость   uses CRT; const mx=100; nx=100; Left=1; Rig…   13.09.2011 18:24
Lapp   Я попробую сделать свой Ловлю на слове ). Я думаю…   14.09.2011 2:49
Lapp   [color=#009900]На всякую гениальную программу найд…   14.09.2011 8:00
keng   Все таки вот этот меня зацепил чем то)Я попробывал…   15.09.2011 14:07
TarasBer   > //дир в будующем является const Чего? Проце…   15.09.2011 14:19
keng   TarasBer Спасибо!Теперь это мне понятно!А …   15.09.2011 14:59
Lapp   Послушай, keng, это же совсем (ну, хорошо, не совс…   16.09.2011 8:52


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

 





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