File Coverage

blib/lib/Games/Tetris/Shape.pm
Criterion Covered Total %
statement 28 31 90.3
branch 4 4 100.0
condition n/a
subroutine 4 5 80.0
pod 1 3 33.3
total 37 43 86.0


line stmt bran cond sub pod time code
1 1     1   5 use strict;
  1         1  
  1         45  
2             package Games::Tetris::Shape;
3 1     1   5 use base 'Class::Accessor::Fast';
  1         1  
  1         995  
4             __PACKAGE__->mk_accessors(qw( shape width depth center ));
5              
6             =head1 NAME
7              
8             Games::Tetris::Shape - representation of a tetris shape
9              
10             =head1 SYNOPSIS
11              
12             =head1 METHODS
13              
14             =head2 new( @rows )
15              
16             Construct a new shape
17              
18             =cut
19              
20             sub new {
21 2     2 1 4 my $class = shift;
22 2         5 my @rows = @_;
23              
24 2         563 my $self = $class->SUPER::new;
25 2 100       25 $self->shape( [ map { [ map { / / ? undef : $_ } split // ] } @rows ] );
  5         14  
  10         35  
26 2         18 $self->width( scalar @{ $self->shape->[0] } );
  2         5  
27 2         13 $self->depth( scalar @{ $self->shape } );
  2         4  
28 2         15 $self->center([ int($self->width / 2), int($self->depth / 2) ]);
29 2         24 return $self;
30             }
31              
32             sub print {
33 0     0 0 0 my $self = shift;
34 0         0 print join('', @$_), "\n"
35 0         0 for @{ $self->shape };
36             }
37              
38              
39             =head1 covers( $offset_x, $offset_y )
40              
41             return a list of points that the shape covers, offset by $offset_x,
42             $offset_y.
43              
44             Each point is an anonymous array containing $x, $y, and what's in the
45             cell
46              
47             =cut
48              
49             sub covers {
50 66     66 0 1200 my $self = shift;
51 66         78 my ($x, $y) = @_;
52 66         69 my ($cx, $cy) = @{ $self->center };
  66         179  
53 66         290 my @points;
54              
55 66         170 for (my $iy = 0; $iy < $self->depth; $iy++) {
56 143         1628 for (my $ix = 0; $ix < $self->width; $ix++) {
57 286         1432 my $point = $self->shape->[ $iy ][ $ix ];
58 286 100       2075 push @points, [ $x + ($ix - $cx), $y + ($iy - $cy), $point ]
59             if $point;
60             }
61             }
62 66         1381 return @points;
63             }
64              
65             1;
66              
67             __END__