program tetris; //
// Создатель Тетриса - Алексей Пажитнов!
// Создатель Паскаль - Никлаус Вирт! Супер!!!
// Для запуска программы требуется скачать и установить бесплатную версию Pascal ABC
//
uses crt; // Подключаем модуль Crt, который осуществляет вывод на экран в текстовом режиме 80 столбцов на 25 строк.
var ss,nn,x,y,pus,a,b,c,d,lin,rlin:integer; // Объявляем основные переменные
st:array[1..12,1..22] of integer; // Объявляем массив игрового поля 12х22 под именем st[12х22]
randmas:array[1..999999] of integer; // Объявляем Случайный ранд массив для создания числовой последовательности появления фигур, для определения следующей фигуры
CounterFigure:integer; // Объявляем счетчик выпавших фигур
CurrFigure,NextFigure:integer; // Объявляем переменные для вывода информации о следующей текущей и новой фигуре
Score:integer; // Объявляем переменную для сохранение игрового результата (игровые очки)
i:integer; // Объявляем счетчик для циклов в главном теле программы
// Процедура рисования клеток поля
procedure k(x,y:integer); // Процедура k(x,y) - рисует в определенной координате текстового экрана кусок фигуры, кусок забора стакана
begin //
gotoxy(x*2+20,23-y); // Поставить текстовый курсор в строку (X*2+30) по Иксу и (24-Y) по Игрику - стартовое положение стакана !
if ss=0 then write('. '); // Если ss=0 то выводится два сивола пустого фона в кавычках '. ' Для затирания следов перемещения фигуры по экрану.
if ss=1 then write('[]'); // ss=1 то выводится блок фигуры Тетриса, из двух знаков в кавычках '[]'
if ss=2 then begin textcolor(LightCyan); write(chr(124),chr(124));textcolor (white); end; // ss=2 то выводится символы из ASCII № 124 для рисования границ СТАКАНА Тетриса '||' как было в оригинальной ретро-версии Тетриса
if (ss=3) and (st[x,y]>0) then pus:=1; // ss=3 и Индекс массива не пустое место (граница стакана или граница фигур), то присвоить pus=1
if ss=4 then st[x,y]:=1; // ss=4 то записать 1 в массив элементов стакана st:array[1..12,1..22]
//
end; // Конец процедцры рисования клеток k(x,y)
// Процедура рисования фигур
procedure fig(x,y,n,s:integer); // Процедура fig(x,y,n,s) хранит информацию о типах фигур Тетриса
begin
if s=3 then pus:=0; // Если s=3 то сделать pus=0
ss:=s; k(x,y); // Сделать ss=s и вызвать процедуру k(x,y)
if n=1 then begin k(x+1,y);k(x,y-1);k(x+1,y-1) end; // Шаблон фигуры 1 (n=1)
// [][]
// [][]
if n=2 then begin k(x-1,y);k(x+1,y);k(x+2,y) end; // Шаблон фигуры 2 (n=2)
// [][][][]
if n=3 then begin k(x,y+1);k(x,y-1);k(x,y-2) end; // Шаблон фигуры 3 (n=3)
// []
// []
// []
// []
if n=4 then begin k(x+1,y);k(x-1,y);k(x-1,y+1) end; // Шаблон фигуры 4 (n=4)
// []
// [][][]
if n=5 then begin k(x,y+1);k(x+1,y+1);k(x,y-1) end; // Шаблон фигуры 5 (n=5)
// [][]
// []
// []
if n=6 then begin k(x-1,y);k(x+1,y);k(x+1,y-1) end; // Шаблон фигуры 6 (n=6)
// [][][]
// []
if n=7 then begin k(x,y+1);k(x,y-1);k(x-1,y-1) end; // Шаблон фигуры 7 (n=7)
// []
// []
// [][]
if n=8 then begin k(x-1,y);k(x+1,y);k(x+1,y+1) end; // Шаблон фигуры 8 (n=8)
// []
// [][][]
if n=9 then begin k(x,y+1);k(x,y-1);k(x+1,y-1) end; // Шаблон фигуры 9 (n=9)
// []
// []
// [][]
if n=10 then begin k(x+1,y);k(x-1,y);k(x-1,y-1) end; // Шаблон фигуры 10 (n=10)
// [][][]
// []
if n=11 then begin k(x,y+1);k(x,y-1);k(x-1,y+1) end; // Шаблон фигуры 11 (n=11)
// [][]
// []
// []
if n=12 then begin k(x-1,y);k(x,y-1);k(x+1,y-1) end; // Шаблон фигуры 12 (n=12)
// [][]
// [][]
if n=13 then begin k(x,y+1);k(x-1,y);k(x-1,y-1) end; // Шаблон фигуры 13 (n=13)
// []
// [][]
// []
if n=14 then begin k(x+1,y);k(x-1,y-1);k(x,y-1) end; // Шаблон фигуры 14 (n=14)
// [][]
// [][]
if n=15 then begin k(x-1,y);k(x,y-1);k(x-1,y+1) end; // Шаблон фигуры 15 (n=15)
// []
// [][]
// []
if n=16 then begin k(x+1,y);k(x-1,y);k(x,y+1) end; // Шаблон фигуры 16 (n=16)
// []
// [][][]
if n=17 then begin k(x+1,y);k(x,y+1);k(x,y-1) end; // Шаблон фигуры 17 (n=17)
// []
// [][]
// []
if n=18 then begin k(x,y-1);k(x-1,y);k(x+1,y) end; // Шаблон фигуры 18 (n=18)
// [][][]
// []
if n=19 then begin k(x-1,y);k(x,y+1);k(x,y-1) end; // Шаблон фигуры 19 (n=19)
// []
// [][]
// []
end; // Конец процедуры рисования фигур
// Процедура поворота фигуры
procedure pov;
begin
nn:=nn-1;
if nn=15 then nn:=19;
if nn=13 then nn:=15;
if nn=11 then nn:=13;
if nn=7 then nn:=11;
if nn=3 then nn:=7;
if nn=1 then nn:=3;
if nn=0 then nn:=1;
end; // Конец процедуры поворота фигуры
// Процедура очистка* стакана
procedure clrst;
begin
for x:=1 to 12 do
for y:=1 to 22 do
if (x=1) or (x=12) or (y=1) then st[x,y]:=2
else st[x,y]:=0; // Рисуется контур стакана и обнуляется стакан
end; // Конец процедуры очистки* стакана
// Процедура рисовать весь стакан
procedure risvesst;
begin
for x:=1 to 12 do for y:=1 to 22 do
begin
ss:=st[x,y];
k(x,y) // Вызов процедуры k(x,y) - рисует в определенной координате текстового экрана поклеточно кусок фигуры, кусок забора стакана
end;
end; // Конец процедуры рисовать весь стакан
// Поцедура контроля и передвижения фигур с помощью клавиатуры
// !!! Если клавиши не реагируют, пользователь должен перевести клавиатуры в английскую раскладку!!!
procedure dvig;
var
i:integer;
key:char;
begin
for i:=1 to 10 do
begin
delay(d); // Задержка на основе данных из переменной d
key:=' ';
if keypressed then key:=readkey;
if key='a' then // Если нажата клавиша a, то влево <=== [a]
begin
fig(x-1,y,nn,3);
if pus=0 then begin fig(x,y,nn,0); x:=x-1; fig(x,y,nn,1);
end;
end;
if key='d' then // Если нажата клавиша d, то вправо ===> [d]
begin
fig(x+1,y,nn,3);
if pus=0 then begin fig(x,y,nn,0); x:=x+1; fig(x,y,nn,1);
end;
end;
if key='w' then // Если нажата клавиша w, то поворот фигуры =[w]=
begin
pov; fig(x,y,nn,3); pov;pov;pov;
if pus=0 then begin fig(x,y,nn,0); pov; fig(x,y,nn,1);
end;
end;
if key='s' then d:=1; // Если нажата клавиша s, то фигура летит вниз =[s]=
end;
end; // Конец процедуры контроля и передвижения фигур с помощью клавиатуры
// Процедура создания новой текущей и следующей фигуры
procedure newfigure;
begin
// gotoxy(62,20); writeln(' '); //отладка
// gotoxy(62,20); writeln('CounterFigure ', CounterFigure); //отладка
//gotoxy(62,15); writeln(' '); //отладка
//gotoxy(62,15); writeln('Текущая ', CurrFigure); //отладка
NextFigure:=randmas[CounterFigure+2]; // Определение следующей фигуры
CurrFigure:=randmas[CounterFigure+1]; // Определение текущей фигуры
gotoxy(55,10); writeln(' '); // Стирание строки
gotoxy(55,10); writeln('Очки: ', Score); // Очки за успехи в игре
//gotoxy(55,3); writeln(' '); // Пробелы. Отладка
gotoxy(55,3); writeln('Следующая '); // Информация о следующей фигуре
gotoxy(56,4); writeln(' '); // Пробелы, по 15 штук, для стирания следов показа следующей фигуры предыдущего хода
gotoxy(56,5); writeln(' '); //
gotoxy(56,6); writeln(' '); //
gotoxy(56,7); writeln(' '); //
gotoxy(56,8); writeln(' '); //
gotoxy(56,9); writeln(' '); //
fig(20,17,NextFigure,1); // Рисуется фигура, которая будет выпадать следующей 20=x координата , 17=y координата, NextFigure=nn значение, 1=[] из какого элемента рисуется фигура
nn:=CurrFigure; // Рисуется текущая фигура, определенная в переменной CurrFigure
end; // Конец процедуры создания новой текущей и следующей фигуры
// СТАРТ ГЛАВНОЙ ПРОГРАММЫ
begin
// Показ стартовой заставки!
HideCursor; // Скрыть курсор. Чтобы вклюсить обратно, нужен оператор ShowCursor;
TextBackground(Blue); // Установить черный цвет фона
ClrScr; // Очистить экран
TextColor(White); // Установить белый цвет букв
TextBackGround(Blue); // Установить синий цвет фона для букв
GotoXY(22,12); // Поставить курсор
write('Это версия Тетриса на Паскале ABC!'); // Вывести текст
GotoXY(8,14); writeln('Выбери английскую раскладку на клавиатуре и нажми на любую клавишу!'); // Вывести текст
TextColor(White);
GotoXY(15,5); writeln('[][][] [][][] [][][] [][][] [] [] [][][]');
GotoXY(15,6); writeln(' [] [] [] [] [] [] [][] [] ');
GotoXY(15,7); writeln(' [] [][][] [] [][][] [] [] [] [] ');
GotoXY(15,8); writeln(' [] [] [] [] [] [] [] [] ');
GotoXY(15,9); writeln(' [] [][][] [] [] [][] [] [][][]');
GotoXY(39,3);TextBackGround(Red); write('(c) Алексей Пажитнов');
GotoXY(22,19);TextBackGround(Red); write('Александр Титов, Екатеринбург, 2019');
TextBackground(Blue); TextBackGround(Blue); TextColor(White);
ReadKey; // Ожидать нажатия любой клавиши !!!}
// Конец показа стартовой заставки!
randomize; // Включение генератора случайных чисел
for i:=1 to 999999 do randmas[i]:=(1+ random(18)); //Создание случайной последовательности почти бесконечной, для определения текущей и следующей фигуры
TextBackground(Blue); TextBackGround(Blue); TextColor(White);
clrscr; //Очистить экран от следов начальной заставки
textcolor(DarkGray); // Нижняя текстовая строка по середине
gotoxy(1,25);
Write(' Привет мир любителей оригинальной игры Тетрис (Алексей Пажитнов, 1984, СССР), спасибо создателю языка программирования Паскаль (Никлаус Вирт, 1970, Швейцария) от программистов на Pascal ABC (Титов Александр, 2019, Россия, Екатеринбург)!');
TextColor(White);
textcolor(Yellow); // Левая верхняя строка, подсказывающая "как играть?"
gotoxy(01,10);
Writeln(' Как играть?');
Writeln('');
Writeln(' <A> влево');
Writeln(' <D> вправо');
Writeln(' <S> сбросить вниз');
Writeln(' <W> поворот фигуры');
TextColor(White); // Конец левой верхней строка
textcolor(Green); // Правая верхняя строка с названием игры =TETЯIS=Pascal=ABC=2019=
gotoxy(52,01);
Writeln('=TETЯIS=Pascal=ABC=2019=');
TextColor(White); // Конец верхней правой строки
clrst; // Процедура обнуления стакана
risvesst; // Процедура рисования стакана
lin:=0; // Установить ноль для счетчика линий, который влияет на скорость игры, т.к. содержится в переменной d
Score:=0; // Установить ноль очков для старта новой игры
repeat // Начать повторение основного цикла игры! До тех пор, пока есть пустое место на поле для передвижения и появления новых фигур
newfigure; // Тут станет известно какая фигура будет следующей и текущей
x:=6;y:=21; // Здесь появляется новая фигура! Обрати внимание на x=6 b y=20 это координаты появления новой фигуры
fig(x,y,nn,3); // d влияет на скорость игры (задержка по умолчанию стоял d:=70-(lin*5);
d:=80-(lin*3); // когда d 170 - это очень медленно, когда он 10 - то быстровато!
if pus=0 then // Если клетка пустая и нет столкновения со стаканом и уложенными ранее в стакан кирпичиками,
begin // то
repeat // повторять до столкновения
fig(x,y,nn,1); // Рисуется текущая фигура до движения, 1=[] из какого элемента рисуется фигура
dvig; // Вызвать процедуру движения фигуры с определением нажатой клавиши
fig(x,y-1,nn,3); // Нарисовать фигуру со смещением по оси Y при условии ss=3 и Индекс массива не пустое место (граница стакана или граница фигур), то присвоить pus=1 и остановить падение фигуры вниз за один элемент до границы стакана
if pus=0 then begin fig(x,y,nn,0); y:=y-1; end; //Рисуется фигура из элементов пустого поля стаканов '. '
until pus=1; // Столкновение произошло
fig(x,y,nn,4); // !!!!! Нарисовать текущую фигуру, которая не может двигаться и записать её положение в массив элеменов стакана st[]
CounterFigure:=CounterFigure+1; // Счетчик фигур для отладки
Score:=Score+100; // Прибавить 100 очков к счету за касание фигуры с полом
for y:=22 downto 2 do // Проверка заполненных рядов
begin // Начало проверки заполненных рядов
a:=0; for x:=2 to 11 do a:=a+st[x,y]; // Счетчик заполненных фигур, проверяет наличие клетки фигуры в массиве и увеличивается на 1, если там есть элемент фигуры
if a=10 then // Если сумма клеток равна 10, то значит ряд заполнился, его нужно удалить, массив элементов стакана сдвинуть вниз
begin // Начало сдвига массива
for b:=y to 21 do for c:=2 to 11 do st[c,b]:=st[c,b+1]; // Сдвиг массива вниз
lin:=lin+1; // Суммировать полностью заполненные линии и увеличть скорость игры
gotoxy(55,12); writeln('Линии: ',lin); // Показать количество полностью заполненных линий
Score:=Score+1000; // Прибавить 1000 очков к счету за полную линию!
end; // Конец сдвига массива
end; //Конец проверки заполненных рядов
risvesst; // Процедура рисования элементов всего стакана
pus:=0;
end;
until pus=1; // Остановить повторение основного игрового цикла! Т.к. нет пустово места.
gotoxy(4,2); writeln('Игра окончена!'); // Написать"Игра окончена"
end. // Конец текста кода программы этой замечательной игры Тетрис на Паскале АБЦ!
