view release on metacpan or  search on metacpan

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

=cut

sub valid {
    my $self = shift;
    my $pattern = $self->{pattern};

    my @throws;
    eval { @throws = _pattern_to_throws($pattern) };
    if ($@) {
        $self->{error} = $@;
        return 0;
    }

    # Check that the numbers / throws == # of balls
    my $total = 0;
    for my $t (@throws) {
        if (ref $t eq 'ARRAY') {
            foreach my $m_t (@$t) {
                $total += $m_t;
            }
        }
        else {
            $total += $t;
        }
    }

    my $avg = $total / @throws;
    unless ($avg == $self->{balls}) {
        $self->{error} = "sum of throws / # of throws does not equal # of balls!";
        return 0;
    }
	
    return $self->_check_timing(@throws);
}

sub _check_timing {
    my ($self, @throws) = @_;
    
    # foreach non-zero throw, mark where the ball will next be

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

        
        foreach my $throw (@subthrows) {
            next if $throws[$i] == 0;
            my $next_thrown = ($i + $throw) % scalar @throws;
            $feeds[$next_thrown]++;
        }
    }

    for my $i (0 .. $#throws) {
        if ($feeds[$i] != $throw_map[$i]) {
            $self->{error} = "Multiple throws would land at the same time.";
            return 0;
        }
    }
    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

t/siteswaps.t  view on Meta::CPAN

sub test_siteswaps {
    my $patterns = shift;
    for my $test (@$patterns) {
        my $siteswap = Acme::Siteswap->new(
            pattern => $test->{pattern},
            balls => $test->{balls},
        );
        if ($test->{valid}) {
            ok $siteswap->valid, "'$test->{pattern}' is valid";
            if (!$siteswap->valid) {
                diag $siteswap->error;
            }
        }
        else {
            ok !$siteswap->valid, "'$test->{pattern}' is invalid";
            like $siteswap->error, $test->{reason}, 'reason is correct';
        }
    }
}