Начнём с конструктора new
. Он будет типовым.
Передаваемые ему два параметра (не считая скрытого, имени класса) — это ссылка
на массив форм и номер цвета фигуры. Эти значения помещаются в анонимный
ассоциативный массив с ключами соответственно shapes
и color, ссылка на который и будет объектом класса
Tetris::Figure
:
Perlsub new($$) { my $class=shift; my $shapes=shift; my $color=shift; my $self={ shapes=>$shapes, color=>$color }; return bless $self, $class; }
Метод shape
, как и было обещано, возвращает текущую
форму фигуры, ту, что идёт первой по счёту в массиве форм:
Perlsub shape() { return shift->{shapes}[0]; }
Методы rotateLeft
и rotateRight
«прокручивают» массив форм вперёд
и назад, перебрасывая соответственно первый элемент в конец массива
и последний — в начало:
Perlsub rotateLeft() { my $self=shift; push @{$self->{shapes}}, shift @{$self->{shapes}}; } sub rotateRight() { my $self=shift; unshift @{$self->{shapes}}, pop @{$self->{shapes}}; }
Напомним, что текущая форма фигуры кодируется строкой, в которой в один или
несколько рядов расположены символы ■
и □
. Ряды разделяются символом |
.
Учитывая, что все ряды имеют одинаковую ширину, в качестве ширины фигуры можно
взять ширину самого верхнего (самого первого) ряда. Таким образом, ширина
фигуры — это положение в строке самого первого символа — разделителя рядов.
Специально для фигуры «I», лежащей на боку (она занимает лишь один ряд,
и строка, кодирующая её форму, не содержит разделителя рядов), мы припишем
к кодирующей строке разделитель перед поиском, и тогда он будет с гарантией
найден. Для поиска положения подстроки внутри строки служит встроенная
процедура index
:
Perlsub width() { return index(shift->shape.'|', '|'); }
Ясно, что высота фигуры — это количество рядов в кодирующей строке. Оно равно
количеству символов |
в этой строке, увеличенное на единицу.
Для подсчёта количества определённых символов в строке хорошо подходит
встроенный оператор tr/…/…/, основное предназначение которого —
транслитерация, то есть замена
одних символов в строке на другие.
Используется оператор tr/…/…/ так:
Perl$str='транслитерация'; $str=~tr/аеёиоуыэюя/АЕЁИОУЫЭЮЯ/; теперь в строке$str
содержится'трАнслИтЕрАцИЯ'
В качестве особого бонуса выражение $str=~tr/…/…/
возвращает количество символов в строке, подлежащих замене:
Perl$count=$str=~tr/бвгджзклмнпрстфхцчъь/БВГДЖЗКЛМНПРСТФХЦЧЪЬ/; в переменной$count
будет количество согласных букв в строке$str
, строка$str
теперь содержит'ТРАНСЛИТЕРАЦИЯ'
Этим свойством оператора tr/…/…/ мы и воспользуемся:
Perlsub height() { return 1+shift->shape=~tr/|//; }
Наконец, запрограммируем метод getCell
, который по
заданным «зелёным» координатам клетки определяет, принадлежит ли она фигуре или
нет. Если координаты выходят за пределы прямоугольника, описанного около
фигуры, метод возвращает безусловно ложное значение. В противном случае
потребуются манипуляции с кодирующей строкой: из неё извлекается
$j
-й ряд, а в нём $i
-й символ, и этот
символ сравнивается с символом ■
. При этом возвращается
результат сравнения. Для извлечения $j
-го ряда из строки её
нужно прежде поделить на части, превратив в список рядов. Для этого применим
встроенную процедуру split
. Первый параметр при её
вызове — регулярное выражение, по которому строка будет разбиваться на части.
В нашем случае разделителем будет символ |
, и тогда
регулярным выражением будет |
. Второй параметр при вызове
split
— строка, подлежащая разделению на части. Процедура
split
возвращает список частей, и, если нас интересует
$j
-й ряд, его можно получить, взяв $j
-й
элемент возвращённого списка: (split /\|/,
$self->shape)[$j]
. Как обычно, $i
-я клетка
в найденном ряду находится при помощи процедуры substr
.
Perlsub getCell($$) { my $self=shift; my ($j, $i)=@_; return 0 if $i<0 or $j<0 or $i>=$self->width or $j>=$self->height; return '■' eq substr((split /\|/, $self->shape)[$j], $i, 1); }
На этом разработка класса Tetris::Figure
завершена.
Программирование класса Tetris::UI
начнём с подключения
класса Term::Slangy
, чтобы сделать доступными процедуры
для работы с экраном и клавиатурой:
Perlpackage Tetris::UI; use Term::Slangy;
Нам потребуются две числовые константы — GLASS_X и GLASS_Y. Это «красные» координаты левого верхнего угла стакана на экране. По традиции константам в Perl дают имена, состоящие из заглавных букв; слова в имени разделяются знаками подчёркивания. Константа ― это что-то такое, что не должно изменяться. Переменные не совсем подходят для хранения констант, поскольку они по своей природе изменчивы — для этого они и предназначены. Наилучшее средство для реализации констант в Perl — это процедуры, возвращающие нужное значение:
Perlsub GLASS_X { return 10; } sub GLASS_Y { return 9; }
Или так:
Perlsub GLASS_X { 10; } sub GLASS_Y { 9; }
(вспомним, что в отсутствие явного return
в теле процедуры
неявно возвращается последнее вычисленное в теле значение). Мы же вместо этих
громоздких конструкций подключим пакет constant
, и при
подключении укажем ссылку на ассоциативный массив. Ключи в этом массиве — имена
констант. Всю работу по созданию процедур-констант возьмёт на себя пакет
constant
:
Perluse constant { GLASS_X=>10, GLASS_Y=>9 };
Определения процедур init
и term
не содержат в себе ничего таинственного. Это
приготовления для работы с экраном и клавиатурой, выключение курсора,
объявление цветовых пар и вывод баннера в процедуре
init
, а также очевидные завершающие действия
в процедуре term
:
Perlsub init() { utf8Mode(-1); initTT(); initKeypad(); cursorVisibility(0); colorPair(1, COLOR_GREEN, COLOR_BLACK); colorPair(2, COLOR_RED, COLOR_BLACK); colorPair(3, COLOR_GREEN, COLOR_BLACK); colorPair(4, COLOR_BLUE, COLOR_BLACK); colorPair(5, COLOR_CYAN, COLOR_BLACK); colorPair(6, COLOR_MAGENTA, COLOR_BLACK); colorPair(7, COLOR_BROWN, COLOR_BLACK); colorPair(8, COLOR_GRAY, COLOR_BLACK); colorPair(9, COLOR_BLACK, COLOR_BLACK); setColor(7); move(2, 2); writeString('ТЕТРИС'); move(3, 2); writeString('© 2003—2010, Ф. Антонов, А. Швец'); } sub term() { clear; cursorVisibility(1); termTT; }
Теперь займёмся процедурой showFigure
. Она принимает
три обязательных параметра —
,
объект класса $fig
Figure
, который следует изобразить на
экране, и «жёлтые» координаты
и $x
верхнего левого угла
прямоугольника, описанного около фигуры. Четвёртый, необязательный параметр —
это номер цветовой пары для рисования фигуры. Если он не задан, фигура будет
нарисована её собственным цветом, $y
$fig->{color}
. Необязательный параметры в прототипе
процедуры отделяются от обязательных точкой с запятой.
Perlsub showFigure($$$;$) { my $fig=shift; my $x=shift; my $y=shift; setColor(shift // $fig->{color}); …
Для обработки факультативного параметра мы применили уже известный нам оператор //. В старых версиях Perl последнюю строку придётся заменить на
Perlmy $color=shift; $color=$fig->{color} unless defined $color; setColor($color);
Оставшаяся часть кода процедуры весьма прямолинейна: двойной цикл по всем
клеткам описанного прямоугольника (переменные $j
и $i
— «зелёные» координаты клеток), в котором клетки
прямоугольника, являющиеся частью фигуры, изображаются в нужном месте экрана
с помощью символа-блока █
:
Perl… for(my $j=0; $j<$fig->height; $j++) { for(my $i=0; $i<$fig->width; $i++) { if($fig->getCell($j, $i)) { move(GLASS_Y+$y+$j, GLASS_X+$x+$i); writeChar(0x2588); # █ } } } refresh(); }
Текста пока нет