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

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

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

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





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

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


Здравствуйте!Помогите пожалуйста с курсовым по Паскалю!Задание примерно состоит в том чтобы сделать программу которая ищет выход из лабиринта.Самому простейшему варианту буду очень рад(желательно с комментариями)Заранее спасибо!
PS Очень оЧЕНЬ надо А я в Паскале не бум бум)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Гость
сообщение 13.09.2011 14:24
Сообщение #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!МОжет кто нибудь описать что тут и как поисходит?!(что делают процедуры,и как самм программа работает)в каждой строчке)Я попробую сделать свой на подобие этого пожалуйста!
 К началу страницы 
+ Ответить 

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


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

 



- Текстовая версия 21.06.2025 14:37
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"