Вторник, 20 Августа 2019, 17:24

Приветствую Вас Гость

[ Новые сообщения · Игроделы · Правила · Поиск ]
  • Страница 1 из 1
  • 1
Форум игроделов » Программирование » Delphi/Pascal/Object Pascal » Тетриc на Pascal ABC
Тетриc на Pascal ABC
Mag_WhiteДата: Среда, 17 Июля 2019, 20:55 | Сообщение # 1
уже был
Сейчас нет на сайте
Здравствуйте, уважаемые любители оригинального Тетриса от Алексея Пажитного!
Предлагаю протестировать мой вариант этой игры на Паскале АБЦ!
Файл во вложении!
Тетрис паскаль АБЦ с комментариями.zip





Добавлено (17 Июля 2019, 20:57)
---------------------------------------------

Код
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. // Конец текста кода программы этой замечательной игры Тетрис на Паскале АБЦ!
TLTДата: Четверг, 18 Июля 2019, 12:46 | Сообщение # 2
Сейчас на сайте
В движке, как вижу, не предусмотрены фигуры из больше четырёх квадратов? А зря - разновидности Тетриса были и с более разнообразными фигурами, нежели стандартный набор.

Дао, выраженное словами, не есть истинное Дао.
DimaLinkДата: Суббота, 17 Августа 2019, 12:17 | Сообщение # 3
был не раз
Сейчас нет на сайте
Посмотрел скриншоты в теме на киберфоруме. Прикольно. А такой паскаль EXE файл дает создать? А то помню, что в БЕЙСИКЕ там старом, ЭКЗЕ файлы не делались. Там предлагалось в Bas файл все писать и из бейсика все запускать.
Форум игроделов » Программирование » Delphi/Pascal/Object Pascal » Тетриc на Pascal ABC
  • Страница 1 из 1
  • 1
Поиск:

Все права сохранены. GcUp.ru © 2008-2019 Рейтинг