File Coverage

blib/lib/Music/MelodicDevice/Arpeggiation.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	9	12	75.0
condition	7	12	58.3
subroutine	9	9	100.0
pod	2	2	100.0
total	69	77	89.6

package Music::MelodicDevice::Arpeggiation;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Apply arpeggiation patterns to groups of notes

our $VERSION = '0.0302';

use Moo;
use strictures 2;
use Array::Circular ();
use Data::Dumper::Compact qw(ddc);
use namespace::clean;

use constant TICKS => 96;

my $DISPATCH = {
    up     => sub { my ($notes) = @_; return [ 0 .. $#$notes ] },
    down   => sub { my ($notes) = @_; return [ reverse(0 .. $#$notes) ] },
    updown => sub { my ($notes) = @_; return [ 0 .. $#$notes, reverse(1 .. $#$notes - 1) ] },
    random => sub { my ($notes) = @_; return [ map { rand @$notes } @$notes ] },
};


has type => (
    is      => 'rw',
    isa     => sub { die "$_[0] is not a known named type" unless exists $DISPATCH->{$_[0]} },
    default => sub { 'up' },
);


has duration => (
    is      => 'rw',
    isa     => sub { die "$_[0] is not a valid duration" unless $_[0] =~ /^\d+\.?(\d+)?$/ },
    default => sub { 1 },
);


has repeats => (
    is      => 'rw',
    isa     => sub { die "$_[0] is not a positive integer" unless $_[0] =~ /^\d+$/ },
    default => sub { 1 },
);


has verbose => (
    is      => 'rw',
    isa     => sub { die "$_[0] is not a valid boolean" unless $_[0] =~ /^[01]$/ },
    default => sub { 0 },
);



sub arp {
    my ($self, $notes, $duration, $type, $repeats) = @_;

    $duration ||= $self->duration;
    $type     ||= $self->type;
    $repeats  ||= $self->repeats;

    my $pattern = ref $type eq 'ARRAY' ? $type : $self->_build_pattern($type, $notes);

    my $pat = Array::Circular->new(@$pattern);

    # compute the arp durations
    my $x = $duration * TICKS;
    my $z = sprintf '%0.f', $x / @$pattern;
    print "Durations: $x, $z\n" if $self->verbose;
    $z = 'd' . $z;

    my @arp;
    for my $i (1 .. $repeats) {
        for my $j (1 .. @$pattern) {
            push @arp, [ $z, $notes->[ $pat->current ] ]
                if $pat->current < @$notes;
            $pat->next;
        }
    }
    print 'Arp: ', ddc(\@arp) if $self->verbose;

    return \@arp;
}

sub _build_pattern {
    my ($self, $type, $notes) = @_;
    return $self->arp_type($type)->($notes);
}


sub arp_type {
    my ($self, $type, $coderef) = @_;
    if ($type && $coderef) {
        $DISPATCH->{$type} = $coderef;
    }
    elsif ($type) {
        return $DISPATCH->{$type};
    }
    else {
        return $DISPATCH;
    }
}

1;

__END__