view release on metacpan or  search on metacpan

lib/Acme/Siteswap.pm  view on Meta::CPAN

    }
    return 1;
}

=head2 error

Returns an error message or empty string.

=cut

sub error { $_[0]->{error} || '' }

sub _pattern_to_throws {
    my $pattern = shift;

    my @throw_set = ();

    while ($pattern =~ m/
			# next block of non-multiplex throws
			(?: \G (\d+) ) 
			# or the next multiplex throw
			| (?: \G \[(\d+)\] )
			# or the end of the pattern
			| (?: \G \z )
			/xmg) {
        if ( defined $1 ) {
            push (@throw_set,  split (//, $1));
        }
        elsif ( defined $2 ) {
            push (@throw_set, [ split(//, $2) ]);
        }
        else {
            # if we never get here, the pattern had an issue
            return @throw_set;
        }
    }
		
    die "unable to parse pattern: $pattern";
}

sub _max_throw {
    my ($throws) = @_;

    my $max_throw = reduce { 
        my $a_1 = ( ref $a eq 'ARRAY' ? max(@$a) : $a );
        my $b_1 = ( ref $b eq 'ARRAY' ? max(@$b) : $b );
        $a_1 >= $b_1 ? $a_1 : $b_1;
    } @$throws;

    # if our pattern is a 1-length multiplex pattern, 
    # reduce returns the first element, so correct for
    # that here
    $max_throw = max(@$max_throw) if ref $max_throw eq 'ARRAY';

    return $max_throw;
}

# extend the pattern by the number of throws equal to the biggest
# throw in the pattern, to ensure that every throw in the pattern
# lands at least once.
sub _expand_throws {
    my ($throws) = @_;
    my $max_throw = _max_throw($throws);
	
    foreach my $i (0 .. $max_throw) {
        # if it's a multiplex throw, we want to copy it
        my $t = ref $throws->[$i] eq 'ARRAY' ? [@{$throws->[$i]}] 
                                             : $throws->[$i];
        push @$throws, $t; 
    }
    return $throws;
}

=head1 AUTHORS

Luke Closs, C<< <cpan at 5thplane dut com> >>
Multiplex support by Seamus Campbell, C<< <conform at deadgeek rot com >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-acme-siteswap at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Acme-Siteswap>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 COPYRIGHT

Copyright 2007 Luke Closs, all rights reserved.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;