Форум программистов, компьютерный форум, киберфорум
Наши страницы
Pascal ABC
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.58/106: Рейтинг темы: голосов - 106, средняя оценка - 4.58
Адренс Аксидор
5 / 5 / 0
Регистрация: 16.05.2012
Сообщений: 92
#1

Написать игру PacMan

27.10.2012, 13:31. Просмотров 19335. Ответов 22
Метки нет (Все метки)

Получил задание на курсовую - написать игру на Pascal ABC. Жанр - PacMan. В интернете есть исходники для Turbo Pascal, но я хочу написать именно свою (на программиста пошёл ради того, чтобы научиться делать игры). Можете подсказать с чего начать программу?
И ещё вопрос: можете объяснить работу этой части процедуры
Pascal
1
2
3
4
inText := Regex.Replace(text,'\W[ ]+', ' ');
    arrSl := inText.Split(new char[1](' '), StringSplitOptions.RemoveEmptyEntries);
    lenSl := arrSl.Length;
    if (lenSl = 0) then begin writeln('Текст не загружен!'); exit end;
Что делают Regex и Split, а то во встроенном справочнике их нет.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
27.10.2012, 13:31
Ответы с готовыми решениями:

Написать программу-игру угадай число
1. Составить программу вывчисляющую сумму всех элементов одномерного массива из...

написать на Pascal игру, в которой есть кораблики, соревнующиеся между собой
:idea: Привета! Задача формулировалась преподом довольно размыто, поэтому...

Движение мобов в лабиринте (Игра наподобие PacMan'a)
В общем есть игруля моя и противники, сталкиваясь друг с другом или со стеной,...

Написать игру "Кто хочет стать миллионерам"
помогите написать прогу на зачёт!!!! Игру кто хочет стать миллианером на pascal...

Написать игру "Морской бой"
игра Морской бой нужна

22
Puporev
Модератор
54397 / 41974 / 28992
Регистрация: 18.05.2008
Сообщений: 98,885
27.10.2012, 13:47 #2
Цитата Сообщение от Адренс Аксидор Посмотреть сообщение
Что делают Regex и Split, а то во встроенном справочнике их нет.
Так это скорее всего переменные типа запись, придуманные самим программистом, естественно их нет ни в каких справочниках.
0
Адренс Аксидор
5 / 5 / 0
Регистрация: 16.05.2012
Сообщений: 92
27.10.2012, 16:37  [ТС] #3
Цитата Сообщение от Puporev Посмотреть сообщение
Так это скорее всего переменные типа запись, придуманные самим программистом, естественно их нет ни в каких справочниках.
В том-то и дело, что нет. А на счёт игры можете что-нибудь подсказать?
0
Puporev
Модератор
54397 / 41974 / 28992
Регистрация: 18.05.2008
Сообщений: 98,885
27.10.2012, 16:54 #4
так вроде написано....
Цитата Сообщение от Адренс Аксидор Посмотреть сообщение
В интернете есть исходники для Turbo Pascal, но я хочу написать именно свою
0
КонецСвета
Почетный модератор
7928 / 3899 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
28.10.2012, 13:25 #5
Лучший ответ Сообщение было отмечено как решение

Решение

1. Определиться с размещением карт: будут ли они записаны в файл или генерироваться в игре?
пример файла с несимметричным лабиринтом
Код
-------------------------------
|              |   |          |
|              |   |          |
|              |   |          |
|-------- -----|   |--- ------|
|                             |
|------------ -------|     |--|
|                    |     |  |
|--------------------|     |  |
|                          |  |
|                          |  |
|--------------------|        |
|                    |     |  |
|----------- --------|     |  |
|                          |  |
|                          |  |
|------------ -------|     |  |
|                    |     |  |
|                    |     |  |
|                    |     |  |
|                    |     |  |
|                    |     |  |
|--------------------|     |  |
|                          |  |
|                          |  |
|              |           |  |
|              |           |  |
|---------------- ---|     |  |
|                    |     |  |
-------------------------------

и процедура считывания схемы лабиринта из файла
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
procedure ReadMap;
var f: text;
begin
assign(f,Filename);
reset(f);
for i:=1 to 31 do
    begin
    for j:=1 to 31 do
        read(f,a[i,j]);
    readln(f);
    end;
close(f);
end;

чаще всего в ПэкМэне используется симметричный лабиринт
Код
-------------------
|                | 
| ------- -----| |-
|                  
| ----------- -----
|                  
| -----------------
|                  
| ---- ----- ------

здесь нужна несколько другая процедура считывания лабиринта из файла
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
procedure ReadMap;
var f: text;
begin
assign(f,Filename);
reset(f);
for i:=1 to 9 do
    begin
    for j:=1 to 20 do
        begin
        read(f,a[i,j]);
        a[18-i,j]:=a[i,j];
        a[18-i,40-j]:=a[i,j];
        a[i,40-j]:=a[i,j];
        end;
    readln(f);
    end;
close(f);
end;

2. На карте случайным образом появляются фрукты, следовательно, нам нужна
процедура, генерирующая случайный фрукт в случайном месте, но не на стене
Pascal
1
2
3
4
5
6
7
8
procedure Fruit(var z: mas);
var g1,g2: byte;
begin
repeat
g1:=random(20)+1; g2:=random(40)+1;
until (a[g1,g2]<>'|') and (a[g1,g2]<>'-');
a[g1,g2]:=chr(random(5)+48);
end;

3. Теперь карту надо нарисовать
процедура вывода карты в графическое окно
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
procedure DrawMap;
begin
for i:=1 to 20 do
    begin
    for j:=1 to 40 do
        begin
        setpencolor(clwhite);
        setbrushcolor(clwhite);
        if (a[i,j]='-') or (a[i,j]='|')
           then setbrushcolor(clblack);
        if a[i,j]='1'
           then setbrushcolor(clyellow);
        if a[i,j]='2'
           then setbrushcolor(clblue);
        if a[i,j]='3'
           then setbrushcolor(clmaroon);
        if a[i,j]='4'
           then setbrushcolor(clfuchsia);
        rectangle(j*10,i*10,j*10+10,i*10+10);
        end;
    end;
setbrushcolor(clred);
rectangle(pj*10,pi*10,pj*10+10,pi*10+10);
end;

4. Пришло время написать обработчик движения пэкмэна по нажатию клавиш вперед, назад, вверх, вниз
главное, ограничить его перемещения размерами лабиринта =)
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
procedure KeyDown(Key: integer);
begin
case Key of
VK_Left:
        begin
        if (pj>2) and
        (a[pi,pj-1]<>'-') and
        (a[pi,pj-1]<>'|') then pj:=pj-1;
        end;
VK_Right:
        begin
        if (pj<40) and
        ((a[pi,pj+1]<>'-') and
         (a[pi,pj+1]<>'|')) then pj:=pj+1;
        end;
VK_Up:
        begin
        if (pi>2) and
        ((a[pi-1,pj]<>'-') and
         (a[pi-1,pj]<>'|')) then pi:=pi-1;
        end;
VK_Down:
        begin
        if (pi<40) and
        ((a[pi+1,pj]<>'-') and
         (a[pi+1,pj]<>'|')) then pi:=pi+1;
        end;
  end;
DrawMap;
setbrushcolor(clwhite);
end;

5. В этой же процедуре следует описать реакцию на фрукты. О, кстати, мне вспоминается, что все пустые места в пэкмэне заполнены точечками, и пока он их не съест, не перейдет на следующий уровень...
по сути, "поедание" как фруктов, так и точечек организуется примерно таким образом
Pascal
1
2
3
4
5
if a[pi,pj]='2' then
   begin
   a[pi,pj]:=' ';
inc(kb,b);
end;
то есть каждый фрукт / точка будут иметь свое обозначение (в этом случае "2") и свою стоимость (b), поедание фрукта, то есть прохождение по этой точке приводит к замене символа фрукта на пустоту (пробел) и увеличение общего числа очков на стоимость фрукта

6. Скорее всего, в вашей игре будет несколько уровней, поэтому имеет смысл организовать
меню с выбором карты / сложности игры
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
function Filename: string;
var v: byte;
begin
v:=1;
repeat
writeln('Выберите сложность игры');
writeln('1-nigthmare');
writeln('2-very hard');
writeln('3-medium');
writeln('4-easy');
writeln('5-ha!');
until v in [1..5];
readln(v);
case v of
1:  Filename:='L:\1.txt';
2:  Filename:='L:\2.txt';
3:  Filename:='L:\3.txt';
4:  Filename:='L:\4.txt';
5:  Filename:='L:\5.txt';
end;
clrscr;
end;


Все, на что мне хватило терпения
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
uses crt,graphABC,Events,utils;
type mas=array [1..18,1..38] of char;
var a: mas;
    i,j,pi,pj: byte;
    dol: integer;
    s: string;
 
function Filename: string;
var v: byte;
begin
v:=1;
repeat
writeln('Выберите сложность игры');
writeln('1-nigthmare');
writeln('2-very hard');
writeln('3-medium');
writeln('4-easy');
writeln('5-ha!');
until v in [1..5];
readln(v);
case v of
1:  Filename:='L:\1.txt';
2:  Filename:='L:\2.txt';
3:  Filename:='L:\3.txt';
4:  Filename:='L:\4.txt';
5:  Filename:='L:\5.txt';
end;
clrscr;
end;
 
procedure ReadMap;
var f: text;
begin
assign(f,Filename);
reset(f);
for i:=1 to 9 do
    begin
    for j:=1 to 19 do
        begin
        read(f,a[i,j]);
        if a[i,j]=' ' then
           a[i,j]:='.';
        a[18-i,j]:=a[i,j];
        a[18-i,38-j]:=a[i,j];
        a[i,38-j]:=a[i,j];
        end;
    readln(f);
    end;
close(f);
end;
 
procedure Fruit(var z: mas);
var g1,g2: byte;
begin
repeat
g1:=random(18)+1; g2:=random(38)+1;
until (a[g1,g2]<>'|') and (a[g1,g2]<>'-');
a[g1,g2]:=chr(random(5)+48);
end;
 
procedure DrawMap;
begin
for i:=1 to 18 do
    begin
    for j:=1 to 38 do
        begin
        setpencolor(clwhite);
        setbrushcolor(clwhite);
        if a[i,j]='.'
           then  setbrushcolor(clskyblue);
        if (a[i,j]='-') or (a[i,j]='|')
           then setbrushcolor(clblack);
        if a[i,j]='1'
           then setbrushcolor(clyellow);
        if a[i,j]='2'
           then setbrushcolor(clblue);
        if a[i,j]='3'
           then setbrushcolor(clmaroon);
        if a[i,j]='4'
           then setbrushcolor(clfuchsia);
        rectangle(j*10,i*10,j*10+10,i*10+10);
        end;
    end;
setbrushcolor(clred);
rectangle(pj*10,pi*10,pj*10+10,pi*10+10);
end;
 
procedure KeyDown(Key: integer);
begin
case Key of
VK_Left:
        begin
        if (pj>2) and
        (a[pi,pj-1]<>'-') and
        (a[pi,pj-1]<>'|') then pj:=pj-1;
        end;
VK_Right:
        begin
        if (pj<38) and
        ((a[pi,pj+1]<>'-') and
         (a[pi,pj+1]<>'|')) then pj:=pj+1;
        end;
VK_Up:
        begin
        if (pi>2) and
        ((a[pi-1,pj]<>'-') and
         (a[pi-1,pj]<>'|')) then pi:=pi-1;
        end;
VK_Down:
        begin
        if (pi<38) and
        ((a[pi+1,pj]<>'-') and
         (a[pi+1,pj]<>'|')) then pi:=pi+1;
        end;
  end;
DrawMap;
setbrushcolor(clwhite);
if a[pi,pj]='.' then
   begin
   inc(dol);
   a[pi,pj]:=' ';
   end;
if a[pi,pj]='1' then
   begin
   inc(dol,10);
   a[pi,pj]:=' ';
   Fruit(a);
   end;
if a[pi,pj]='2' then
   begin
   a[pi,pj]:=' ';
   inc(dol,20);
   Fruit(a);
   end;
if a[pi,pj]='3' then
   begin
   a[pi,pj]:=' ';
   inc(dol,30);
   Fruit(a);
   end;
if a[pi,pj]='4' then
   begin
   a[pi,pj]:=' ';
   inc(dol,40);
   Fruit(a);
   end;
if a[pi,pj]='5' then
   begin
   a[pi,pj]:=' ';
   inc(dol,50);
   Fruit(a);
   end;
s:=inttostr(dol);
s:='Вы собрали '+s+' золота';
textout(400,50,s);
end;
 
begin
hidecursor;
pi:=2; pj:=2;
ReadMap;
Fruit(a);
DrawMap;
OnKeyDown:=KeyDown;
end.
15
Вложения
Тип файла: txt 1.txt (189 байт, 604 просмотров)
Адренс Аксидор
5 / 5 / 0
Регистрация: 16.05.2012
Сообщений: 92
28.10.2012, 14:58  [ТС] #6
Ох, спасибо большое - буду разбираться
0
Адренс Аксидор
5 / 5 / 0
Регистрация: 16.05.2012
Сообщений: 92
30.11.2012, 09:02  [ТС] #7
А не подскажете, как реализовать противников? Я так понимаю, что нужно задать им рандомное движение, если игрока нет на линии обзора, а частоту движения с помощью таймера. Когда игрок появляется на линии обзора, то они устремляются к нему и гонятся, пока таймер не отсчитает определённое время после того, как игрок скрылся с линии. Или нужно как то по-другому?
0
КонецСвета
Почетный модератор
7928 / 3899 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
30.11.2012, 12:00 #8
можно еще попробовать независимо от прямой видимости регулировать движение врагов (кажется, в пэкмене практически так). То есть: определить текущие координаты врага относительно пэксмена и соответственно определить направление нужного сдвига.
примерно так
Pascal
1
2
if ip<ie then kdi:=1 else kdi:=-1;
if jp<je then kdj:=1 else kdi:=-1;
где ip и ie-координаты пэкмена
jp и je - координаты пэкмена
kdi и kdj - направление движения (можно и через условный оператор написать)
а дальше добавить учет стен..

(правда, не знаю, будут ли у пэкмена шансы спастись=)
2
Адренс Аксидор
5 / 5 / 0
Регистрация: 16.05.2012
Сообщений: 92
22.12.2012, 13:32  [ТС] #9
А можно ли здесь сделать так, чтобы программа произвольно вызвала одно из действий в keyDown, чтобы организовывать произвольное движение врагов? Просто запускал некоторые flash-версии Пакмана, в некоторых враги движутся произвольно и не стремятся "врезаться" в игрока. Вместо этого их добавляют на уровень в количестве 3-5 штук
0
КонецСвета
Почетный модератор
7928 / 3899 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
22.12.2012, 13:58 #10
вполне возможно:
сформировать двумерный массив с координатами врагов
генератор случайных чисел определяет направление движения
провести проверку - совершилось ли движение (чтобы не топтались на месте)
например, так
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
for i:=1 to 5 do
    begin
    b:=false;           //проверка движения, чтобы враг не топтался на месте
      repeat
      v:=random(4);
      case v of
      0: if (z[i,1]+1<31) and not (a[z[i,1]+1,z[i,2] in ['|','-']) //если справа не конец лабиринта и не стена
            then
            begin
            b:=true;
            z[i,1]:=z[i,1]+1; //движение вправо
            end;
      // и так далее 1, 2, 3  - движение вниз, влево, вверх
      until b;
2
Адренс Аксидор
5 / 5 / 0
Регистрация: 16.05.2012
Сообщений: 92
22.12.2012, 18:43  [ТС] #11
Спасибо большое)

Добавлено через 4 часа 36 минут
Можете посмотреть, где-то я ошибся. Программа работает, но противник все равно не двигается.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
for i:=1 to 18 do
    begin
    for j:=1 to 38 do
begin
    b:=false;           
      repeat
       u:=random(4);
      case u of
      1:  begin
       if (gj>2) and
        (t[gi,gj-1]<>'-') and
        (t[gi,gj-1]<>'|') then begin b:=true; t[gi,gj]:=t[gi,gj-1]; 
        end; end;
        2: begin
        if (gj<38) and
        ((t[gi,gj+1]<>'-') and
         (t[gi,gj+1]<>'|')) then begin b:=true; t[gi,gj]:=t[gi,gj+1]; 
        end; end;
        3: begin
        if (gi>2) and
        ((t[gi-1,gj]<>'-') and
         (t[gi-1,gj]<>'|')) then begin b:=true; t[gi,gj]:=t[gi-1,gj]; 
        end; end;
        4: begin
        if (gi<38) and
        ((t[gi+1,gj]<>'-') and
         (t[gi+1,gj]<>'|')) then begin b:=true;  t[gi,gj]:=t[gi+1,gj]; 
        end; end;
        end; until b;  end; end;
А вот если так, через процедуру, то просто прыгает по всему лабиринту
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
procedure Enemu;
var b:boolean; i,j:integer;  u:byte; begin
for i:=1 to 18 do
    begin
    for j:=1 to 38 do
begin
    b:=false;           
      repeat
       u:=random(4);
      case u of
      1:  begin
       if (gj>2) and
        (t[gi,gj-1]<>'-') and
        (t[gi,gj-1]<>'|') then gj:=gj-1;
        end;
        2: begin
        if (gj<38) and
        ((t[gi,gj+1]<>'-') and
         (t[gi,gj+1]<>'|')) then gj:=gj+1;
        end;
        3: begin
        if (gi>2) and
        ((t[gi-1,gj]<>'-') and
         (t[gi-1,gj]<>'|')) then gi:=gi-1;
        end;
        4: begin
        if (gi<38) and
        ((t[gi+1,gj]<>'-') and
         (t[gi+1,gj]<>'|')) then gi:=gi+1;
        end; 
        end; until b;  end; end; end;
0
КонецСвета
Почетный модератор
7928 / 3899 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
22.12.2012, 20:05 #12
Адренс Аксидор, в настоящий момент вижу две "ошибки":
u:=random(4) - генерирует случайное число в диапазоне от 0 до 3, а cases у вас расписаны от 1 до 4

но более существенно то, что изменения, которые происходят с врагами внутри процедуры, не вносятся в генеральный массив данных о положении врагов, вот они и остаются на месте или прыгают по лабиринту=) (это я гипотетически предполагаю исходя из того кода, что вы дали)

то есть прежде всего вам стоит создать процедуру генерации случайного положения врагов или изначально задать им некую одну исходную позицию (не забудьте проверить, чтобы в этой позиции не оказалась стена)

причем у данной процедуры, (допустим, GenEnemy(var z: matr)) будет фактическая переменная, массив, в который записаны и будут изменяться данные о местоположении врагов

а вот второй процедуре - процедуре движения врагов - нужно тоже эту переменную записать как фактическу, к тому же вы забыли и про проверку "ход сделан или нет" и немного не так организовали массив данных о положении врагов

я к чему веду: вам недостаточно оперировать с массивом-картой, нужен отдельный массив (из 5 элементов, если у вас 5 врагов, для каждого i 2 числа: координаты по х и по у)
изменения производятся с массивом врагов, после чего новые данные записываются в массив карты, а старые данные о положении врагов должны буть удалены с массива карты...
1
Адренс Аксидор
5 / 5 / 0
Регистрация: 16.05.2012
Сообщений: 92
22.12.2012, 20:49  [ТС] #13
Я пока одному врагу координаты задал - он появляется в нужном месте. Что касается case, если начинал индексацию с 0, то выскакивала ошибка после создания лабиринта (уже в самой программе, а не при компиляции).
Что касается остальных замечаний - попробую переделать.
Спасибо, что помогаете!
0
КонецСвета
Почетный модератор
7928 / 3899 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
22.12.2012, 20:53 #14
проблему с кейс можно разрешить так
u:=random(4)+1;
=)
1
Адренс Аксидор
5 / 5 / 0
Регистрация: 16.05.2012
Сообщений: 92
22.12.2012, 21:20  [ТС] #15
Вот какая в общем получается у меня. С case все равно продолжается ошибка. Или поменять тип? У меня byte. pi,pj - игрок. gi,gj -враг
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
begin
hidecursor;
pi:=2; pj:=2;
gi:=16; gj:=36; 
ReadMap;
Fruit(a);
DrawMap;
 
OnKeyDown:=KeyDown;
begin
for i:=1 to 18 do
    begin
    for j:=1 to 38 do
begin
    b:=false;           
      repeat
       u:=random(4);
      case u of
      1:  begin
       if (gj>2) and 
        (t[gi,gj-1]<>'-') and
        (t[gi,gj-1]<>'|') then gj:=gj-1; OnKeyDown:=KeyDown;
        
        end;
        2: begin
        if (gj<38) and
        ((t[gi,gj+1]<>'-') and
         (t[gi,gj+1]<>'|')) then gj:=gj+1; OnKeyDown:=KeyDown;
         
        end;
        3: begin
        if (gi>2) and
        ((t[gi-1,gj]<>'-') and
         (t[gi-1,gj]<>'|')) then gi:=gi-1; OnKeyDown:=KeyDown;
          
        end;
        4: begin
        if (gi<38) and
        ((t[gi+1,gj]<>'-') and
         (t[gi+1,gj]<>'|')) then gi:=gi+1; OnKeyDown:=KeyDown;
          
        end; 
        end; until b;  end; end; end;
end.
Добавлено через 19 минут
А вот в процедуре изменение case не вызывает ошибки.
0
КонецСвета
Почетный модератор
7928 / 3899 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
22.12.2012, 21:40 #16
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

примерно так
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
var a: array [1..38,1..38] of char;
    z: array [1..5,1..2] of byte;
    
procedure GenEnemy;
var i,zi,zj: byte;
begin
for i:=1 to 5 do
    begin
    repeat
    z[i,1]:=random(38);
    z[i,2]:=random(38);
    until a[z[i,1],z[i,2]]=' ';
    a[z[i,1],z[i,2]]:='e';
    end;
end;
 
//прочие процедуры
 
procedure KeyDown(Key: integer);
var i,u: byte;
begin
case Key of                 //сначала перемещается пэкмен
VK_Left:
        begin
        if (pj>2) and
        (a[pi,pj-1]<>'-') and
        (a[pi,pj-1]<>'|') then pj:=pj-1;
        end;
VK_Right:
        begin
        if (pj<38) and
        ((a[pi,pj+1]<>'-') and
         (a[pi,pj+1]<>'|')) then pj:=pj+1;
        end;
VK_Up:
        begin
        if (pi>2) and
        ((a[pi-1,pj]<>'-') and
         (a[pi-1,pj]<>'|')) then pi:=pi-1;
        end;
VK_Down:
        begin
        if (pi<38) and
        ((a[pi+1,pj]<>'-') and
         (a[pi+1,pj]<>'|')) then pi:=pi+1;
        end;
  end;                              //теперь перемещаются враги
for i:=1 to 5 do
    begin
    b:=false;
      repeat
        u:=random(4);
        case u of
             0:
             begin
             if not (a[z[i,1],z[i,2]+1] in ['|','-'])
                and (z[i,2]+1<38) then
                    begin
                    b:=true;
                    a[z[i,1],z[i,2]]:=' ';
                    z[i,2]:=z[i,2]+1;
                    a[z[i,1],z[i,2]]:='e';
                    end;
             end;
             1:
             begin
             if not (a[z[i,1+1],z[i,2]] in ['|','-'])
                and (z[i,1]+1<38) then
                    begin
                    b:=true;
                    a[z[i,1],z[i,2]]:=' ';
                    z[i,1]:=z[i,1]+1;
                    a[z[i,1],z[i,2]]:='e';
                    end;
             end;
             2:
             begin
             if not (a[z[i,1],z[i,2]-1] in ['|','-'])
                and (z[i,2]-1>2) then
                    begin
                    b:=true;
                    a[z[i,1],z[i,2]]:=' ';
                    z[i,2]:=z[i,2]-1;
                    a[z[i,1],z[i,2]]:='e';
                    end;
             end;
             3:
             begin
             if not (a[z[i,1]-1,z[i,2]] in ['|','-'])
                and (z[i,1]-1>2) then
                    begin
                    b:=true;
                    a[z[i,1],z[i,2]]:=' ';
                    z[i,2]-1:=z[i,2];
                    a[z[i,1],z[i,2]]:='e';
                    end;
             end;
             end;
      until b;
    end;
DrawMap;
setbrushcolor(clwhite);
s:=inttostr(dol);
s:='Вы собрали '+s+' золота';
textout(400,50,s);
end;
1
Адренс Аксидор
5 / 5 / 0
Регистрация: 16.05.2012
Сообщений: 92
23.12.2012, 10:44  [ТС] #17
Всё, немного переделал - прыгать перестал - это в версии с процедурой. Вот только перестал проверять для врага стенки. И как связать переход врага с нажатием клавиши? Ой, не увидел ваше последнее сообщение

Добавлено через 12 часов 35 минут
В общем сделал так, и когда игрок выбирает любое действие в KeyDown вызывается эта процедура. Т.е. ход делает игрок - делает враг. А как теперь столкновения сделать? Просто pi и gi, pj и gi не приравняешь (ошибка вылетает).

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
procedure Enemu(var a: mas);
var b:boolean;   u:byte; 
begin
  
    b:=false;           
      repeat
       u:=random(4);
      case u of
      0:  begin
       if (gj>2) and not
        (a[gi,gj-1] in ['-','|']) 
      then begin b:=true;gj:=gj-1; 
        end; end;
        1: begin
        if (gj<38) and not
        (a[gi,gj+1] in['-', '|'])
          then begin b:=true; gj:=gj+1; 
        end; end;
        2: begin
        if (gi>2) and not
        (a[gi-1,gj] in ['-','|']) 
          then begin b:=true; gi:=gi-1; 
        end; end;
        3: begin
        if (gi<38) and not
        (a[gi+1,gj] in ['-','|']) 
          then begin b:=true;  gi:=gi+1; 
        end; end;
        end; until b;  end;
Добавлено через 23 минуты
Всё, прошу прощения, организовал столкновения. Большое спасибо за помощь в написании программы!!!
1
Адренс Аксидор
5 / 5 / 0
Регистрация: 16.05.2012
Сообщений: 92
25.12.2012, 09:49  [ТС] #18
Можно ещё небольшой вопрос задать? При тестирование программы порой появляется баг: игра засчитывает проигрыш, когда не нужно, хотя, когда нужно, срабатывает всегда. Можете подсказать, какое ещё условие нужно задать или изменить, чтобы не было бага? pi,pj - координаты пакмана, gi,gj -врага
Pascal
1
2
3
4
if a[pi,pj]=a[gi,gj]  then
   begin
   ClearWindow; SetFontColor(clRed); SetBrushColor(clBlack);  FillCircle(240,55,50);  SetBrushColor(clWhite); FillCircle(240,55,25); textout(197, 50,'Вы проиграли'); 
    end;
0
КонецСвета
Почетный модератор
7928 / 3899 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
25.12.2012, 12:37 #19
не могу навскидку предположить - в чем может быть причина.. когда появляется такой баг - в начеле или в конце игры?
может быть, попробовать условие записать как if (pi=gi) and (pj=gj) then?
1
Адренс Аксидор
5 / 5 / 0
Регистрация: 16.05.2012
Сообщений: 92
25.12.2012, 19:46  [ТС] #20
Спасибо, попробую. Ошибка после 20-го - 30го хода

Добавлено через 9 минут
Это решение помогло, ещё раз спасибо. Теперь будут добавлять элементы ООП.
0
25.12.2012, 19:46
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
25.12.2012, 19:46

Написать игру "Стрельба из пушки"
Прошу помощи с написанием простенькой игры. Вот задание: Написать игру...

Написать игру "пятнашки"
помогите написать самые самые простые пятнашки, с использованием двумерных...

сохранить игру
как сохранить игру в файл, а потом из меню ее запустить?


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru