File Coverage

blib/lib/MIDI/Drummer/Tiny/Syncopate.pm

Criterion	Covered	Total	%
statement	12	50	24.0
branch	0	12	0.0
condition	0	24	0.0
subroutine	4	9	44.4
pod	2	2	100.0
total	18	97	18.5

package MIDI::Drummer::Tiny::Syncopate;
$MIDI::Drummer::Tiny::Syncopate::VERSION = '0.7013';
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Syncopation logic

use MIDI::Util qw(dura_size);

use Moo;
use strictures 2;
use namespace::clean;

extends 'MIDI::Drummer::Tiny';

#pod =head1 SYNOPSIS
#pod
#pod  use MIDI::Drummer::Tiny::Syncopate;
#pod
#pod  my $d = MIDI::Drummer::Tiny::Syncopate->new(
#pod     file   => 'syncopate.mid',
#pod     reverb => 15,
#pod  );
#pod
#pod  $d->combinatorial( $d->snare, {
#pod     repeat   => 2,
#pod     patterns => [qw(0101 1001)],
#pod  });
#pod
#pod  # Play parts simultaneously
#pod  $d->sync( \&snare, \&kick, \&hhat );
#pod  sub snare { $d->combinatorial( $d->snare, { count => 1 } ) }
#pod  sub kick { $d->combinatorial( $d->kick, { negate => 1 } ) }
#pod  sub hhat { $d->steady( $d->closed_hh ) }
#pod
#pod  $d->write;
#pod
#pod =head1 DESCRIPTION
#pod
#pod C provides methods to use in the
#pod F lessons.
#pod
#pod =cut

#pod =head1 ATTRIBUTES
#pod
#pod =head2 duration
#pod
#pod   $duration = $d->duration;
#pod
#pod Default: C
#pod
#pod =cut

has duration => (
    is      => 'ro',
    default => sub { 'qn' },
);

#pod =head2 repeat
#pod
#pod   $repeat = $d->repeat;
#pod
#pod Default: C<4>
#pod
#pod =cut

has repeat => (
    is      => 'ro',
    default => sub { 4 },
);

#pod =head1 METHODS
#pod
#pod =head2 new
#pod
#pod   $d = MIDI::Drummer::Tiny::Syncopate->new(%arguments);
#pod
#pod Return a new C object.
#pod
#pod =head2 steady
#pod
#pod   $d->steady;
#pod   $d->steady( $d->kick );
#pod   $d->steady( $d->kick, { duration => $d->eighth } );
#pod
#pod Play a steady beat with the given B and optional
#pod B, for the number of beats accumulated in the object's
#pod B attribute.
#pod
#pod Defaults:
#pod
#pod   instrument: closed_hh
#pod   Options:
#pod     duration: given by constructor
#pod
#pod =cut

sub steady {
    my ( $self, $instrument, $opts ) = @_;

    $instrument ||= $self->closed_hh;

    $opts->{duration} ||= $self->duration;

    # XXX This is not right
    for my $n ( 1 .. $self->counter ) {
        $self->note( $opts->{duration}, $instrument );
    }
}

#pod =head2 combinatorial
#pod
#pod   $d->combinatorial;
#pod   $d->combinatorial( $d->kick );
#pod   $d->combinatorial( $d->kick, \%options );
#pod
#pod Play a beat pattern with the given B, given by
#pod L.
#pod
#pod This method accumulates beats in the object's B attribute if
#pod the B option is set.
#pod
#pod The B option is a hashref of coderefs, keyed by single character
#pod tokens, like the digits, 0-9.  The coderef durations should add up to
#pod the B option.
#pod
#pod Defaults:
#pod
#pod   instrument: snare
#pod   Options:
#pod     duration: given by constructor
#pod     count: 0
#pod     negate: 0
#pod     beats: given by constructor
#pod     repeat: given by constructor
#pod     vary:
#pod         0 => sub { $self->rest( $options->{duration} ) },
#pod         1 => sub { $self->note( $options->{duration}, $instrument ) },
#pod     patterns: undef
#pod
#pod =cut

sub combinatorial {
    my ( $self, $instrument, $opts ) = @_;

    $instrument ||= $self->snare;

    $opts->{negate}   ||= 0;
    $opts->{count}    ||= 0;
    $opts->{beats}    ||= $self->beats;
    $opts->{repeat}   ||= $self->repeat;
    $opts->{duration} ||= $self->duration;
    $opts->{vary}     ||= {
        0 => sub { $self->rest( $opts->{duration} ) },
        1 => sub { $self->note( $opts->{duration}, $instrument ) },
    };

    my $size = dura_size( $opts->{duration} );

    my @items = $opts->{patterns}
        ? @{ $opts->{patterns} }
        : sort map { join '', @$_ }
            @{ _variations_with_repetition( [ keys %{ $opts->{vary} } ], $opts->{beats} ) };

    for my $pattern (@items) {
        next if $pattern =~ /^0+$/;

        $pattern =~ tr/01/10/ if $opts->{negate};

        for ( 1 .. $opts->{repeat} ) {
            for my $bit ( split //, $pattern ) {
                $opts->{vary}{$bit}->($self);
                $self->counter( $self->counter + $size ) if $opts->{count};
            }
        }
    }
}

sub _variations_with_repetition {
    my ($elements, $k) = @_;
    # Base case: if k is 0, return a single empty variation
    return [""] if $k == 0;
    # Base case: if k is 1, return each element as a variation
    return [map { [$_] } @$elements] if $k == 1;
    # Recursive step
    my @result;
    my $sub_variations = _variations_with_repetition($elements, $k - 1);
    for my $element (@$elements) {
        for my $sub (@$sub_variations) {
            push @result, [ $element, @$sub ];
        }
    }
    return \@result;
}

1;

__END__