#!/usr/bin/perl use warnings; use utf8; ################################################## package Tetris::Figure; sub new($$) { my $class=shift; my $shapes=shift; my $color=shift; my $self={ shapes=>$shapes, color=>$color }; return bless $self, $class; } sub shape() { return shift->{shapes}[0]; } sub rotateLeft() { my $self=shift; push @{$self->{shapes}}, shift @{$self->{shapes}}; } sub rotateRight() { my $self=shift; unshift @{$self->{shapes}}, pop @{$self->{shapes}}; } sub width() { return index(shift->shape.'|', '|'); } sub height() { return 1+shift->shape=~tr/|/|/; } sub 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); } ################################################## package Tetris::UI; use Term::Slangy; use constant { GLASS_X=>10, GLASS_Y=>9 }; sub 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; } sub showFigure($$$;$) { my $fig=shift; my $x=shift; my $y=shift; setColor(shift // $fig->{color}); 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(); } sub showNextFigure($) { my $nextFigure=shift; setColor(3); move(GLASS_Y, GLASS_X+Tetris::Game->GLASS_COLS+4); writeString('Следующая:'); for(my $j=0; $j<4; $j++) { move(GLASS_Y+2+$j, GLASS_X+Tetris::Game->GLASS_COLS+4); writeString(' '); } showFigure($nextFigure, Tetris::Game->GLASS_COLS+4, 2); } sub showScore($) { setColor(3); move(GLASS_Y+7, GLASS_X+Tetris::Game->GLASS_COLS+4); writeString('Счёт: '.shift); } sub showGlass() { setColor(1); hLine(GLASS_Y+Tetris::Game->GLASS_ROWS, GLASS_X-1, Tetris::Game->GLASS_COLS+2, 0x2591); # ░ vLine(GLASS_Y, GLASS_X-1, Tetris::Game->GLASS_ROWS, 0x2591); vLine(GLASS_Y, GLASS_X+Tetris::Game->GLASS_COLS, Tetris::Game->GLASS_ROWS, 0x2591); my $color; for(my $j=0; $jGLASS_ROWS; $j++) { for(my $i=0; $iGLASS_COLS; $i++) { $color=Tetris::Game::getGlassCell($j, $i); setColor($color); move(GLASS_Y+$j, GLASS_X+$i); writeChar($color==9? 0x20: 0x2588); # █ refresh(); } } refresh(); } sub play($) { system "mplayer \"$_[0]\" >/dev/null 2>&1"; } ######################################################### package Tetris::Game; use Encode; use open ':locale'; use open ':std'; use constant { GLASS_COLS=>10, GLASS_ROWS=>15 }; use constant { MOVE_RIGHT=>0, MOVE_UP=>1, MOVE_LEFT=>2, MOVE_DOWN=>3, ROTATE_LEFT=>4, ROTATE_RIGHT=>5 }; ########## my @figures; my @glass; my $score; my $nextFigure; my $figure; my $figureX; my $figureY; sub init { Tetris::UI::init; $SIG{INT}=$SIG{__DIE__}=\&Tetris::UI::term; $score=0; @figures=( # T Tetris::Figure->new(['■■■|□■□', '■□|■■|■□', '□■□|■■■', '□■|■■|□■'], 2), # Q Tetris::Figure->new(['■■|■■'], 3), # I Tetris::Figure->new(['■|■|■|■', '■■■■'], 4), # Z Tetris::Figure->new(['■■□|□■■', '□■|■■|■□'], 5), # S Tetris::Figure->new(['□■■|■■□', '■□|■■|□■'], 6), # J Tetris::Figure->new(['□■|□■|■■', '■■■|□□■', '■■|■□|■□', '■□□|■■■'], 7), # L Tetris::Figure->new(['■□|■□|■■', '□□■|■■■', '■■|□■|□■', '■■■|■□□'], 0) ); for(my $j=0; $jheight; $j++) { for(my $i=0; $i<$figure->width; $i++) { setGlassCell($figureY+$j, $figureX+$i, $figure->{color}) if $figure->getCell($j, $i); } } @glass=(grep { grep {$_==9} @$_ } @glass); while(GLASS_ROWS>@glass) { Tetris::UI::play('wallend.wav'); unshift @glass, [(9) x GLASS_COLS]; $score++; } Tetris::UI::showGlass; } sub getGlassCell { my ($j, $i)=@_; return undef if $j<0 or $i<0; return $glass[$j][$i]; } sub setGlassCell { my ($j, $i, $c)=@_; $glass[$j][$i]=$c; } sub canStay { my $answer=0; for(my $j=0; $j<$figure->height; $j++) { for(my $i=0; $i<$figure->width; $i++) { my $color=getGlassCell($figureY+$j, $figureX+$i); $answer||=(defined $color and $color!=9 and $figure->getCell($j, $i) or not defined $color); return 0 if $answer; } } return 1; } sub canMove { my $dir=shift; move($dir); my $answer=canStay; move((MOVE_LEFT, MOVE_DOWN, MOVE_RIGHT, MOVE_UP, ROTATE_RIGHT, ROTATE_LEFT)[$dir]); return $answer; } sub showMove { hide(); move(shift); show(); } sub show { Tetris::UI::showFigure($figure, $figureX, $figureY); } sub hide { Tetris::UI::showFigure($figure, $figureX, $figureY, 9); } sub move { my $dir=shift; if($dir==MOVE_RIGHT) { $figureX++; } elsif($dir==MOVE_LEFT) { $figureX--; } elsif($dir==MOVE_DOWN) { $figureY++; } elsif($dir==MOVE_UP) { $figureY--; } elsif($dir==ROTATE_LEFT) { $figure->rotateLeft; } elsif($dir==ROTATE_RIGHT) { $figure->rotateRight; } } sub fall { hide(); move(MOVE_DOWN) while canMove(MOVE_DOWN); show(); } sub game { $nextFigure=$figures[int rand @figures]; Tetris::UI::showGlass; while() { $figure=$nextFigure; $nextFigure=$figures[int rand @figures]; Tetris::UI::showNextFigure($nextFigure); Tetris::UI::showScore($score); $figureX=int((GLASS_COLS-$figure->width)/2); $figureY=0; term unless canStay; while() { show; if(Tetris::UI::inputPending(5)) { my $key=Tetris::UI::getKey(); if($key==0x101) # UP { showMove(ROTATE_LEFT) if canMove(ROTATE_LEFT); } elsif($key==0x102) # DOWN { showMove(ROTATE_RIGHT) if canMove(ROTATE_RIGHT); } elsif($key==0x103) # LEFT { showMove(MOVE_LEFT) if canMove(MOVE_LEFT); } elsif($key==0x104) # RIGHT { showMove(MOVE_RIGHT) if canMove(MOVE_RIGHT); } elsif($key==0x20) # SPACE { fall; } } elsif(canMove(MOVE_DOWN)) { showMove(MOVE_DOWN); } else { addFigure; last; } } } } sub scores { return unless $score; open(my $scoresfd, '<', '/var/lib/games/ptetris.scores') or die 'Невозможно открыть файл с результатами: ' .decode_utf8($!)."\n"; my @scores=<$scoresfd>; close($scoresfd) or die 'Невозможно закрыть файл с результатами: ' .decode_utf8($!)."\n"; map { chomp; $_=[split /\t/, $_] } @scores; push @scores, [(getpwuid($<))[0], $score, ''.localtime]; @scores=sort { $b->[1] <=> $a->[1] } @scores; pop @scores if @scores>10; open($scoresfd, '>', '/var/lib/games/ptetris.scores') or die 'Невозможно открыть файл с результатами: ' .decode_utf8($!)."\n"; print "TETRIS top ten:\n\n"; # FIXME for my $ss(@scores) { print $scoresfd ((join "\t", @$ss)."\n"); print ((join "\t", @$ss)."\n"); } print "\n"; close($scoresfd) or die 'Невозможно закрыть файл с результатами: ' .decode_utf8($!)."\n"; } ########## init; game;