File Coverage

blib/lib/Game/Life/NDim/Dim.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Game::Life::NDim::Dim;
2              
3             # Created on: 2010-01-08 18:43:32
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 2     2   32831 use Moose;
  0            
  0            
10             use warnings;
11             use version;
12             use Carp;
13             use Data::Dumper qw/Dumper/;
14             use English qw/ -no_match_vars /;
15              
16             use overload
17             '""' => sub { '[' . ( join ',', @{ $_[0]->elements } ) . ']' },
18             '@{}' => sub { $_[0]->elements },
19             '==' => sub { for (0..@{$_->[0]}-1) { return 0 if $_[0][$_] != $_[1][$_] } return 1 },
20             '+' => \&sum_list;
21              
22             our $VERSION = version->new('0.0.2');
23             our @EXPORT_OK = qw//;
24             our %EXPORT_TAGS = ();
25              
26             has elements => (
27             is => 'rw',
28             isa => 'ArrayRef',
29             required => 1,
30             );
31              
32             has max => (
33             is => 'rw',
34             isa => 'ArrayRef[Int]',
35             weak_ref => 1,
36             );
37              
38             around new => sub {
39             my ($new, $class, @args) = @_;
40              
41             if ( @args == 1 && ref $args[0] eq 'ARRAY' ) {
42             @args = ( elements => $args[0] );
43             }
44             else {
45             my %params = @args;
46             if (!exists $params{elements} && exists $params{max}) {
47             $params{elements} = [ @{ $params{max} } ];
48             return $new->($class, %params)->zero;
49             }
50             }
51              
52             return $new->($class, @args);
53             };
54              
55             sub increment {
56             my ($self, $max) = @_;
57             my $last;
58              
59             for my $i ( reverse 0 .. @{ $max } - 1 ) {
60             die "max[$i] == 0 which is not allowed!" if $max->[$i] == 0;
61             if ( $self->[$i] + 1 <= $max->[$i] ) {
62             $self->[$i]++;
63             $last = $i;
64             last;
65             }
66             $self->[$i] = 0;
67             }
68              
69             return if !defined $last;
70              
71             return $self;
72             }
73              
74             sub clone {
75             my ($self) = @_;
76              
77             return $self->new(elements => [ @{ $self } ]);
78             }
79              
80             sub zero {
81             my ($self) = @_;
82              
83             for my $item (@{ $self }) {
84             $item = 0;
85             }
86              
87             return $self;
88             }
89              
90             sub sum_list {
91             my ($self, $list) = @_;
92              
93             my @new;
94             for my $i ( 0 .. @{ $self } - 1 ) {
95             die Dumper $i, $self, $list if !defined $self->[$i] || !defined $list->[$i];
96             $new[$i] = $self->[$i] + $list->[$i];
97             }
98              
99             return __PACKAGE__->new(\@new);
100             }
101              
102             1;
103              
104             __END__
105              
106             =head1 NAME
107              
108             Game::Life::NDim::Dim - The dimension of a board?
109              
110             =head1 VERSION
111              
112             This documentation refers to Game::Life::NDim::Dim version 0.0.2.
113              
114              
115             =head1 SYNOPSIS
116              
117             use Game::Life::NDim::Dim;
118              
119             # Brief but working code example(s) here showing the most common usage(s)
120             # This section will be as far as many users bother reading, so make it as
121             # educational and exemplary as possible.
122              
123              
124             =head1 DESCRIPTION
125              
126             =head1 SUBROUTINES/METHODS
127              
128             =head2 C<increment ( )>
129              
130             =head2 C<clone ( )>
131              
132             =head2 C<zero ( )>
133              
134             =head2 C<sum_list ( )>
135              
136             =head1 DIAGNOSTICS
137              
138             =head1 CONFIGURATION AND ENVIRONMENT
139              
140             =head1 DEPENDENCIES
141              
142             =head1 INCOMPATIBILITIES
143              
144             =head1 BUGS AND LIMITATIONS
145              
146             There are no known bugs in this module.
147              
148             Please report problems to Ivan Wills (ivan.wills@gmail.com).
149              
150             Patches are welcome.
151              
152             =head1 AUTHOR
153              
154             Ivan Wills - (ivan.wills@gmail.com)
155              
156             =head1 LICENSE AND COPYRIGHT
157              
158             Copyright (c) 2010 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
159             All rights reserved.
160              
161             This module is free software; you can redistribute it and/or modify it under
162             the same terms as Perl itself. See L<perlartistic>. This program is
163             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
164             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
165             PARTICULAR PURPOSE.
166              
167             =cut