Четверг, 21 Ноября 2019, 04:02

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

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

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