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

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

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

> Рисунок человечка в матрице
DFooz
сообщение 27.03.2006 23:10
Сообщение #1


Новичок
*

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

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


В задаче по массиву-лабиринту передвигается человек в виде циферки. А можно ли как то сделать так, чтобы именно рисунок человечка передвигался в нем, т.е. что-то нарисованное, а не простая цифра? Если можно, то примерно как это реализовать?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
klem4
сообщение 28.03.2006 10:41
Сообщение #2


Perl. Just code it!
******

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

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


Вот накатал smile.gif

Управление

w - up
s - down
a - left
d - right

escape - exit

uses crt;
const
FIELD_SIZE = 20;

type

TField = array [1..FIELD_SIZE, 1..FIELD_SIZE] of byte;

TMan = object

public

constructor Init;
destructor Done;

function CanMove(dRow, dCol : integer) : boolean;
procedure Move(dRow, dCol : integer);
procedure Show;

private

row, col : integer;
coords : array [0..7] of record row, col : byte; end;
end;

constructor TMan.Init;
begin
row := FIELD_SIZE div 2;
col := row;
Move(0, 0);
end;

destructor TMan.Done;
begin
end;

function TMan.CanMove(dRow, dCol : integer) : boolean;
var
stop : boolean;
begin

row := row + dRow;
col := col + dCol;

// столкновение с "бортами" возможно в 4-х точках, проверим их

stop := false;

stop := ((row - 1) < 1);
if not stop then stop := ((row + 3) > FIELD_SIZE);
if not stop then stop := ((col - 1) < 1);
if not stop then stop := ((col + 1) > FIELD_SIZE);

if stop then begin
row := row - dRow;
col := col - dCol;
end;
CanMove := not stop;

end;

procedure TMan.Move(dRow, dCol : integer);
begin
coords[0].row := row;
coords[0].col := col;

coords[1].row := row - 1;
coords[1].col := col;

coords[2].row := row;
coords[2].col := col - 1;

coords[3].row := row;
coords[3].col := col + 1;

coords[4].row := row + 1;
coords[4].col := col;

coords[5].row := row + 2;
coords[5].col := col;

coords[6].row := row + 3;
coords[6].col := col - 1;

coords[7].row := row + 3;
coords[7].col := col + 1
end;

procedure TMan.Show;
begin
end;

procedure PrintField(f : TField; m : TMan);
var
i, j : byte;
begin
FillChar(f, sizeof(f), 0);
with m do begin
for i := 1 to 7 do
with coords[i] do
f[row, col] := 1;
end;

for i := 1 to FIELD_SIZE do begin
writeln;
for j := 1 to FIELD_SIZE do begin
case f[i,j] of
0 : TextColor(White);
1 : TextColor(Blue);
end;
write(f[i,j] : 2);
end;
end;
end;

var
man : TMan;
field : TField;
ch : char;
dr, dc : integer;

begin

Clrscr;

man.Init;

repeat
dr := 0;
dc := 0;
clrscr;
PrintField(field, man);
ch := readkey;
case ch of
'w' : begin dr := -1; dc := 0; end;
's' : begin dr := +1; dc := 0; end;
'a' : begin dc := -1; dr := 0; end;
'd' : begin dc := +1; dr := 0; end;
end;
if man.CanMove(dr, dc) then man.Move(dr, dc);
until ch = #27;

man.Done;

end.


С лабиринтом конечно будет похуже ... но если человека делать просто как циферку, то все еще вроще.

Сообщение отредактировано: volvo - 5.11.2006 19:25


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 



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