Консольный "Тетрис"

(* Encoding: CP866 *)
(* Автор оригинального кода: Александр Титов (aka Mag_White) *)
(* https://www.cyberforum.ru/pascalabc/thread2483511.html *)
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;                                 // Объявляем счетчик для циклов в главном теле программы

(************************ автор кода рандомизации 0CodErr ************************)
var 
  RandSeed: LongWord;
  RandCounter: LongWord;
  
// Initialize the random-number generator
procedure Randomize;
asm
  rdtsc
  mov RandSeed, eax
end;  

// Produce random values in a given range [MinValue..MaxValue]
// Note: Always return 0 if range = [0..$FFFFFFFF]
// cause (MaxValue - MinValue + 1) * eax + MinValue = 0  
// uses variation of XorShift based algorithm
function Random(MinValue, MaxValue: LongWord) : LongWord; StdCall; overload;
asm
  mov eax, RandSeed
  mov ecx, eax
  shl eax, 13
  xor ecx, eax
  mov eax, ecx
  shr eax, 17
  xor ecx, eax
  mov eax, ecx
  shl eax, 5
  xor eax, ecx
  add RandCounter, 361275
  mov RandSeed, eax
  add eax, RandCounter
  mov edx, MaxValue
  sub edx, MinValue
  inc edx
  mul edx
  mov eax, edx
  add eax, MinValue  
end;

// produce numbers in the range [0..Value), Value — not included
function Random(Value: LongWord) : LongWord; StdCall; overload;
begin
  Result := Random(0, Value - 1);
end;
(*********************************************************************************)
  
//  Процедура рисования клеток поля
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));write(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
InitConsole('Консольный Тетрис', True); 
// Показ стартовой заставки!
CursorOff;//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. // Конец текста кода программы этой замечательной игры Тетрис на Паскале АБЦ!