Разработка простейшей аркадной игры "Тетрис"
Дата написания: 11.12.2016
Статья предназначена для начинающих программистов. Задача: написать игру, - упрощенный вариант "Тетриса". Реализован поворот лишь на 90 градусов.
Для описания программного кода будет использоваться Borland Pascal 7.0
Program Tetris_Version_1; { Make 05.12.1998 }
Uses { All rights reserved }
Crt,Dos;
Const
n = 4;
a1: array[1..n,1..n] of byte = ((0,0,0,0),
(0,1,1,0),
(0,1,1,0),
(0,0,0,0));
a2: array[1..n,1..n] of byte = ((0,0,0,0),
(0,1,0,0),
(0,1,0,0),
(0,1,1,0));
a3: array[1..n,1..n] of byte = ((0,0,0,0),
(0,0,1,0),
(0,0,1,0),
(0,1,1,0));
a4: array[1..n,1..n] of byte = ((0,0,0,0),
(0,1,0,0),
(0,1,1,0),
(0,0,1,0));
a5: array[1..n,1..n] of byte = ((0,0,0,0),
(0,0,1,0),
(0,1,1,0),
(0,1,0,0));
a6: array[1..n,1..n] of byte = ((0,1,0,0),
(0,1,0,0),
(0,1,0,0),
(0,1,0,0));
a7: array[1..n,1..n] of byte = ((0,0,0,0),
(0,1,0,0),
(0,1,1,0),
(0,1,0,0));
Var
key : char;
stop : Boolean;
hsc,sc : integer;
startskor,skor : integer;
x,y : byte;
stopgame,sig : boolean;
a,b : array [1..4,1..4] of byte;
c : array [-1..16,1..25,1..2] of byte;
babaxvalue : boolean;
colorfig : byte;
movingtrue : boolean;
{----------------------------------------------------------------}
procedure cursoroff;
begin
asm
mov ah,1
mov cx,$0100
int $10
end
end;
{----------------------------------------------------------------}
procedure start;
var
d : string[30];
t : byte;
begin
d:='Евгений Шаров представляет ';
clrscr;
delay(1000);
textcolor(1);
for t:=1 to 15 do
begin
gotoxy(6+(t*2),12);
write(d[t*2]);
delay(40);
gotoxy(5+(t*2),12);
write(d[t*2-1]);
delay(40)
end;
delay(2100);
clrscr;
delay(900);
d:='П Р О Г Р А М М У ';
clrscr;
textcolor(1);
for t:=1 to 30 do
begin
gotoxy(11+t,12);
write(d[t]);
delay(40)
end;
delay(2100);
textmode(3);
cursoroff;
delay(1500);
while not keypressed do
begin
gotoxy(20,7);
textcolor(random(14)+1);
writeln('----------¬');
gotoxy(20,8);
writeln('L---¬ -----');
gotoxy(20,9);
writeln(' ¦ ¦-----¬------¬-----¬--¬ --¬-----¬');
gotoxy(20,10);
writeln(' ¦ ¦¦ ----L-¬ ---¦ -¬ ¦¦ ¦ / ¦¦ ----');
gotoxy(20,11);
writeln(' ¦ ¦¦ L--¬ ¦ ¦ ¦ L- ¦¦ ¦/ / ¦¦ ¦ ');
gotoxy(20,12);
writeln(' ¦ ¦¦ ---- ¦ ¦ ¦ ----¦ / /¦ ¦¦ ¦ ');
gotoxy(20,13);
writeln(' ¦ ¦¦ L--¬ ¦ ¦ ¦ ¦ ¦ / ¦ ¦¦ L--¬');
gotoxy(20,14);
writeln(' L--L----- L-- L-- L-- L--L-----');
delay(800);
end;
key:=readkey;
if key = #0
then
key:=readkey;
clrscr;
delay(1000);
textmode(1)
end;
{----------------------------------------------------------------}
procedure help;
begin
clrscr;
textcolor(lightgreen);
writeln;
writeln(' ':13,'Hello,Baby...');
writeln('');
writeln('');
writeln('');
writeln('');
writeln('');
writeln('');
writeln('');
readkey;
textcolor(blue);
clrscr
end;
{----------------------------------------------------------------}
procedure rand;
var
h : integer;
i,j : byte;
begin
randomize;
h:=0;
while not (h in [1..7]) do
h:=random(9);
i:=colorfig;
colorfig:=1;
while not (colorfig in [10,11,13,14,15]) do
begin
colorfig:=random(16);
if i = colorfig
then
colorfig:=1
end;
case h of
1:
for i:=1 to 4 do
for j:=1 to 4 do
a[i,j]:=a1[i,j];
2:
for i:=1 to 4 do
for j:=1 to 4 do
a[i,j]:=a2[i,j];
3:
for i:=1 to 4 do
for j:=1 to 4 do
a[i,j]:=a3[i,j];
4:
for i:=1 to 4 do
for j:=1 to 4 do
a[i,j]:=a4[i,j];
5:
for i:=1 to 4 do
for j:=1 to 4 do
a[i,j]:=a5[i,j];
6:
for i:=1 to 4 do
for j:=1 to 4 do
a[i,j]:=a6[i,j];
7:
for i:=1 to 4 do
for j:=1 to 4 do
a[i,j]:=a7[i,j]
end
end;
{----------------------------------------------------------------}
procedure status;
begin
if sc>hsc
then
hsc:=sc;
textbackground(7);
textcolor(10);
gotoxy(1,2);
write(' ');
gotoxy(1,3);
write(' ');
gotoxy(1,2);
write('Score :',sc:5);
gotoxy(1,3);
write('HScore :',hsc:5);
textbackground(0);
end;
{----------------------------------------------------------------}
procedure moving(what:byte);
var
ss : boolean;
i,j : byte;
begin
ss:=true;
if (x<14) or (x>24)
then
exit;
case what of
0 :
begin
for i:=x-14 to x-8 do
for j:=Y to y+3 do
begin
if i = -1
then
begin
i:=0;
ss:=false
end;
if c[i,j,1] = 1
then
if c[i-1,j,1] = 2
then
ss:=false
end;
if ss
then
begin
for i:=x-14 to x-8 do
for j:=Y to y+3 do
if c[i,j,1] = 1
then
begin
c[i-1,j,1]:=1;
c[i,j,1]:=0;
c[i-1,j,2]:=colorfig;
c[i,j,2]:=0
end;
x:=x-1;
movingtrue:=true
end
end;
1 :
begin
for i:=x-14 to x-8 do
for j:=Y to y+3 do
begin
if i = 24
then
begin
i:=23;
ss:=false
end;
if c[i,j,1] = 1
then
if c[i+1,j,1] = 2
then
ss:=false
end;
if ss
then
begin
for i:=x-8 downto x-14 do
for j:=Y to y+3 do
if c[i,j,1] = 1
then
begin
c[i+1,j,1]:=1;
c[i,j,1]:=0;
c[i+1,j,2]:=colorfig;
c[i,j,2]:=0
end;
x:=x+1;
movingtrue:=true
end
end;
2 :
begin
for i:=x-14 to x-8 do
for j:=Y to y+3 do
begin
if i = -1
then
begin
i:=0;
ss:=false
end;
if i = 24
then
begin
i:=23;
ss:=false
end;
if c[i,j,1] = 1
then
if c[i,j+1,1] = 2
then
ss:=false
end;
if ss
then
begin
for i:=x-14 to x-8 do
for j:=Y+3 downto y do
if c[i,j,1] = 1
then
begin
c[i,j+1,1]:=1;
c[i,j,1]:=0;
c[i,j+1,2]:=colorfig;
c[i,j,2]:=0;
end;
y:=y+1;
movingtrue:=true
end
end
end
end;
{----------------------------------------------------------------}
procedure paint;
var
i,j,h : byte;
begin
for i:=1 to 11 do
for j:=1 to 21 do
begin
case c[i,j,1] of
0 : textcolor(0);
1,2: textcolor(c[i,j,2]);
end;
gotoxy(14+i,0+j);
write(#$db)
end
end;
{----------------------------------------------------------------}
procedure babax;
var
i,j : integer;
ss : boolean;
begin
ss:=true;
for i:=x-14 to x-8 do
for j:=y to y+3 do
if c[i,j,1] = 1
then
if c[i,j+1,1] = 2
then
ss:=false;
if not ss
then
begin
for i:=x-14 to x-8 do
for j:=y+3 downto y do
if c[i,j,1] = 1
then
c[i,j,1]:= 2;
babaxvalue:=true;
sound(70);
delay(50);
nosound
end
end;
{----------------------------------------------------------------}
procedure secondscreen;
begin
textcolor(14);
textbackground(7);
gotoxy(27,2);
write('ESC выход ');
gotoxy(27,3);
write('P пауза ');
gotoxy(27,4);
write('N по час ');
gotoxy(27,5);
write('M против час ');
gotoxy(27,6);
write(#25' вниз ');
gotoxy(27,7);
write(#27' влево ');
gotoxy(27,8);
write(#26' вправо ')
end;
{----------------------------------------------------------------}
procedure screen;
var
i,j : byte;
begin
clrscr;
textcolor(7);
for i:=1 to 24 do
begin
gotoxy(1,i);
write('--------------');
gotoxy(27,i);
write('-------------')
end;
for i:=1 to 2 do
begin
gotoxy(15,i+22);
write('------------')
end;
textcolor(4);
for i:=1 to 22 do
begin
gotoxy(14,i);
write('-');
gotoxy(26,i);
write('-')
end;
gotoxy(15,22);
write('-----------');
status;
secondscreen;
textbackground(0)
end;
{----------------------------------------------------------------}
procedure count;
var
i,j,k : integer;
ss : boolean;
begin
for i:=1 to 21 do
begin
ss:=true;
for j:=1 to 11 do
if c[j,i,1]<>2
then
ss:=false;
if ss
then
begin
for j:=1 to 11 do
begin
c[j,i,1]:=0;
c[j,i,2]:=0;
sc:=sc+1
end;
for k:=i downto 1 do
for j:=1 to 11 do
if c[j,k,1] = 2
then
begin
c[j,k+1,1]:=2;
c[j,k,1]:=0;
c[j,k+1,2]:=c[j,k,2];
c[j,k,1]:=0;
end;
end;
end;
textbackground(7);
textcolor(10);
gotoxy(1,2);
write(' ');
gotoxy(1,3);
write(' ');
gotoxy(1,2);
write('Score :',sc:5);
gotoxy(1,3);
write('HScore :',hsc:5);
textbackground(0)
end;
{----------------------------------------------------------------}
procedure circlefig(r:byte);
var
aa : array [1..4,1..4] of byte;
cc : array [1..4] of byte;
i,j : byte;
begin
if (x<15) or (x>21)
then
exit;
case r of
1:
for i:=1 to 4 do
begin
for j:=1 to 4 do
cc[j]:=a[i,j];
for j:=4 downto 1 do
aa[5-j,i]:=cc[j]
end;
2:
for i:=1 to 4 do
begin
for j:=1 to 4 do
cc[j]:=a[i,j];
for j:=1 to 4 do
aa[j,5-i]:=cc[j]
end;
end;
for i:=x-14 to x-11 do
for j:=y to y+3 do
begin
c[i,j,1]:=aa[i-x+15,j+1-y];
if c[i,j,1] = 1
then
c[i,j,2]:=colorfig;
if c[i,j,1] = 0
then
c[i,j,2]:=0;
end
end;
{----------------------------------------------------------------}
procedure nastr;
var
stop : boolean;
x,y : byte;
begin
clrscr;
window(1,1,40,8);
textbackground(5);
clrscr;
textcolor(14);
stop:=false;
gotoxy(3,3);
writeln(' ',#26,' Ускорить ',#27,' Затормозить');
writeln(' ENTER-выход в главное меню');
textcolor(10);
x:=3;
y:=6;
while not stop do
begin
while not keypressed do
begin
gotoxy(x-1,y);
write(' ',#2);
delay(startskor);
x:=x+1;
if x = 37
then
begin
gotoxy(x-2,y);
write(' ');
x:=3
end
end;
key:=readkey;
if key = #13
then stop:=true;
if key = #0
then
begin
key:=readkey;
case key of
#75 : begin
startskor:=startskor+10;
if startskor = 250
then
startskor:=240
end;
#77 : begin
startskor:=startskor-10;
if startskor = 0
then
startskor:=10
end
end
end
end;
window(1,1,40,25);
textbackground(1);
clrscr
end;
{----------------------------------------------------------------}
procedure klavisha;
begin
if keypressed
then
begin
key:=readkey;
if key = #27
then
begin
gotoxy(15,10);
textcolor(green);
write('Закончить ?');
gotoxy(16,11);
write('Y for yes');
key:=readkey;
if key in ['y','Y','Н','н']
then
begin
stopgame:=true;
paint;
exit
end;
if key = #0
then
key:=readkey;
exit
end;
if key in ['n','N','т','Т']
then
circlefig(2);
if key in ['ь','Ь','m','M']
then
circlefig(1);
if key in ['p','P','з','З']
then
begin
gotoxy(18,10);
textcolor(green+blink);
write('Пауза');
while not keypressed do;
key:=readkey;
if key = #0
then
key:=readkey;
exit
end;
if key = #0
then
begin
key:=readkey;
case key of
#75:
begin
moving(0) { left }
end;
#77:
begin
moving(1) { rigth }
end;
#72:
begin
end;
#80:
begin
moving(2) { down }
end
end
end
end
end;
{----------------------------------------------------------------}
procedure game;
var
i,j : integer;
begin
textbackground(0);
x:=18;
y:=1;
sc:=0;
rand;
for i:=1 to 22 do
begin
c[0,i,1]:=2;
c[12,i,1]:=2
end;
for i:=0 to 12 do
c[i,22,1]:=2;
for i:=1 to 11 do
for j:=1 to 21 do
c[i,j,1]:=0;
for i:=4 to 7 do
for j:=1 to 4 do
c[i,j,1]:=a[i-3,j];
{ inc(x);}
babaxvalue:=false;
screen;
stopgame:=false;
movingtrue:=false;
skor:=startskor*130;
while not stopgame do
begin
i:=0;
while i < skor do
begin
klavisha;
if stopgame
then
break;
if movingtrue
then
begin
paint;
movingtrue:=false;
i:=i+300
end;
i:=i+1
end;
if stopgame
then
break;
moving(2); { down }
paint;
babax;
if babaxvalue
then
begin
count;
if y in [1..2]
then
begin
stopgame:=true;
break
end;
rand;
inc(sc);
status;
x:=18;
y:=1;
for i:=4 to 7 do
for j:=1 to 4 do
c[i,j,1]:=a[i-3,j];
{ inc(x); }
babaxvalue:=false
end;
end;
gotoxy(16,10);
textcolor(green+blink);
write('Game over');
status;
while keypressed do
key:=readkey;
while not keypressed do;
key:=readkey;
if key = #0
then
key:=readkey;
textbackground(1);
clrscr
end;
{----------------------------------------------------------------}
BEGIN
randomize;
textmode(1);
cursoroff;
start;
textbackground(1);
clrscr;
cursoroff;
stop:=false;
startskor:=50;
hsc:=0;
while not stop do
begin
textcolor(11);
gotoxy(11,21);
writeln('All rights reserved.');
textcolor(14);
gotoxy(11,6);
writeln('<<< Death Tetris >>>');
textcolor(15);
gotoxy(10,11);
write('Игра.................1');
gotoxy(10,12);
write('О программе..........2');
gotoxy(10,13);
write('Настройка............3');
gotoxy(10,14);
write('Выход в ДОС..........4');
key:=readkey;
case key of
'1' : game;
'2' : help;
'3' : nastr;
'4' : stop:= not stop;
else
begin
Sound(160);
Delay(17);
NoSound
end
end
end;
textmode(3)
END.
Prolog — это язык логического программирования. Он является декларативным языком: вся стуктура программы представлена в виде правил и фактов. На нем можно строить экспертные системы, генерирующие ответы вида true (истина) или false (ложь). Пролог хорошо подходит для автоматического перебора вариантов решений с возвратами. Язык не требует написания большого объемного кода и позволяет получать отличные результаты. |
Интересные материалы на сайте:
|
|