The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;

BEGIN { use_ok('MIDI::Simple::Drummer') }

my $d = eval { MIDI::Simple::Drummer->new };
isa_ok $d, 'MIDI::Simple::Drummer';
ok !$@, 'created with no arguments';

my $f1 = 'Drummer.mid';
my $f2 = 'Buddy-Rich.mid';

# Define test durations.
my @v = (
    [qw(WHOLE         _1ST wn 4)],
    [qw(HALF          _2ND hn 2)],
    [qw(QUARTER       _4TH qn 1)],
    [qw(EIGHTH        _8TH en 0.5)],
    [qw(SIXTEENTH    _16TH sn 0.25)],
    [qw(THIRTYSECOND _32ND yn 0.125)],
    [qw(SIXTYFOURTH  _64TH xn 0.0625)],
);

# Test durations.
for my $v (@v) {
    my($m, $n, $i, $j) = @$v;
    is $d->$m(), $i, $m;
    is $d->$n(), $i, $n;
    is $d->_durations->{$i}, $j, "duration=$j";
}

# Test accessors...
my $x = $d->channel;
is $x, 9, 'get default channel';
$x = $d->channel(2);
is $x, 2, 'set channel';
$d->channel(9); # Ok enough of that.

$x = $d->bpm;
is $x, 120, 'get default bpm';
$x = $d->bpm(111);
is $x, 111, 'set bpm';

$x = $d->volume;
is $x, 100, 'get default volume';
$x = $d->volume(101);
is $x, 101, 'set volume';

$x = $d->phrases;
is $x, 4, 'get default phrases';
$x = $d->phrases(2);
is $x, 2, 'set phrases';

$x = $d->bars;
is $x, 4, 'get default bars';
$x = $d->bars(2);
is $x, 2, 'set bars';

$x = $d->beats;
is $x, 4, 'get default beats';
$x = $d->beats(2);
is $x, 2, 'set beats';

$x = $d->divisions;
is $x, 4, 'get default divisions';
$x = $d->divisions(2);
is $x, 2, 'set divisions';

$x = $d->signature;
is $x, '4/4', 'get default signature';
$x = $d->signature('7/4');
is $x, '7/4', 'set signature';

$x = $d->file;
is $x, $f1, 'get default file';
$x = $d->file($f2);
is $x, $f2, 'set file';

$x = $d->score;
isa_ok $x, 'MIDI::Simple', 'score';

$x = $d->accent;
is $x, 127, 'get default accent';
$x = $d->accent(20);
is $x, 121, 'set accent';

$x = $d->kit;
isa_ok $x, 'HASH';
$x = $d->kit('clank');
is $x, undef, 'kit clank undef';
$x = $d->kit(clunk => ['Foo','Bar']);
is_deeply $x, ['Foo','Bar'], 'kit set clunk';

$x = $d->name_of('kick');
is $x, 'Acoustic Bass Drum', 'kick is Acoustic Bass Drum';

$x = $d->snare;
is $x, 'n38', 'snare';
$x = $d->kick;
is $x, 'n35', 'kick';
$x = $d->tick;
is $x, 'n42', 'tick';
$x = $d->backbeat;
like $x, qr/n3[58]/, 'backbeat';
$x = $d->hhat;
like $x, qr/n4[246]/, 'hhat';
$x = $d->crash;
like $x, qr/n(?:5[257]|49)/, 'crash';
$x = $d->ride;
like $x, qr/n5[139]/, 'ride';
$x = $d->tom;
like $x, qr/n(?:4[13578]|50)/, 'tom';

$x = $d->strike;
is $x, 'n38', 'strike default';
$x = $d->strike('Cowbell');
is $x, 'n56', 'strike patch';
$x = $d->strike('Cowbell', 'Tambourine');
is $x, 'n56,n54', 'strike patches string';
$x = [$d->strike('Cowbell', 'Tambourine')];
is_deeply $x, ['n56', 'n54'], 'strike patches list';

$x = $d->option_strike;
like $x, qr/n(?:5[257]|49)/, 'option_strike default';
$x = $d->option_strike('Cowbell');
is $x, 'n56', 'option_strike patch';
$x = $d->option_strike('Cowbell', 'Tambourine');
like $x, qr/n5[46]/, 'option_strike options';

# Test the metronome.
$d = eval { MIDI::Simple::Drummer->new };
$d->metronome;
$d = eval { MIDI::Simple::Drummer->new(-signature => '3/4') };
$x = $d->beats;
is $x, 3, 'get beats';
$x = $d->divisions;
is $x, 4, 'get divisions';
$d->metronome;
$x = grep { $_->[0] eq 'note' } @{$d->score->{Score}};
ok $x == $d->beats * $d->phrases, 'metronome';

# Test the machinations.
$d = eval { MIDI::Simple::Drummer->new };
$d->count_in;
$x = grep { $_->[0] eq 'note' } @{$d->score->{Score}};
ok $x == $d->beats, 'count_in';

$x = $d->rotate;
is $x, 'n35', 'rotate';
$x = $d->rotate(1);
is $x, 'n35', 'rotate 1';
$x = $d->rotate(2);
is $x, 'n38', 'rotate 2';
$x = $d->rotate(3);
is $x, 'n35', 'rotate 3';
$x = $d->rotate(1, ['Cowbell', 'Tambourine']);
is $x, 'n54', 'rotate 1 options';
$x = $d->rotate(2, ['Cowbell', 'Tambourine']);
is $x, 'n56', 'rotate 2 options';
$x = $d->rotate(3, ['Cowbell', 'Tambourine']);
is $x, 'n54', 'rotate 3 options';

$x = $d->backbeat_rhythm;
is $x, 'n35,n42', 'backbeat_rhythm';
$x = $d->backbeat_rhythm(-beat => 1);
is $x, 'n35,n42', 'backbeat_rhythm 1';
$x = $d->backbeat_rhythm(-beat => 2);
is $x, 'n38,n42', 'backbeat_rhythm 2';
$x = $d->backbeat_rhythm(-beat => 3);
is $x, 'n35,n42', 'backbeat_rhythm 3';
$x = $d->backbeat_rhythm(-beat => 1, -fill => 0);
is $x, 'n35,n42', 'backbeat_rhythm 1 no fill';
$x = $d->backbeat_rhythm(-beat => 1, -fill => 1);
like $x, qr/n35,n(?:5[257]|49)/, 'backbeat_rhythm 1 fill';
$x = $d->backbeat_rhythm(-beat => 2, -fill => 1);
is $x, 'n38,n42', 'backbeat_rhythm 2 fill';
$x = $d->backbeat_rhythm(-beat => 3, -fill => 1);
is $x, 'n35,n42', 'backbeat_rhythm 3 fill';

$d->patterns;
$x = $d->patterns(0);
is $x, undef, 'get unknown pattern is undef';
my $y = sub { $d->note($d->EIGHTH, $d->strike) };
$x = $d->patterns('y', $y);
is_deeply $x, $y, 'set y pattern';
$x = $d->patterns('y fill', $y);
is_deeply $x, $y, 'set y fill pattern';

$x = $d->beat;
ok $x, 'beat';
$x = $d->fill;
like $x, qr/ fill$/, 'fill';
$x = $d->beat(-name => 'y');
is $x, 'y', 'named y beat';
$x = $d->beat(-type => 'fill');
like $x, qr/ fill$/, 'fill';
$x = $d->beat(-name => 'y', -type => 'fill');
is $x, 'y fill', 'named fill';
$x = $d->beat(-last => 'y');
isnt $x, 'y', 'last known beat';
$x = $d->beat(-last => 'y fill');
isnt $x, 'y fill', 'last known fill';

# Write the score to disk.
$x = $d->write;
ok $x eq $f1 && -e $x, 'write';
$x = $d->write($f2);
ok $x eq $f2 && -e $x, 'named write';

# TODO sync_tracks() tests with score notes instead.
$d = eval { MIDI::Simple::Drummer->new };
$d->patterns(b1 => \&b1);
$d->patterns(b2 => \&b2);
$d->sync_tracks(
    sub { $d->beat(-name => 'b1') },
);
$d->write($f1);
$d->sync_tracks(
    sub { $d->beat(-name => 'b1') },
    sub { $d->beat(-name => 'b2') },
);
$d->write($f2);
ok -s $f1 < -s $f2, 'multi-track';
sub b1 { # tick
    my $self = shift;
    my %args = @_;
    my $strike = $self->tick;
    $self->note($self->QUARTER(), $strike) for 1 .. $self->beats;
    return $strike;
}
sub b2 { # kick
    my $self = shift;
    my %args = @_;
    my $strike = $self->kick;
    $self->note($self->QUARTER(), $strike) for 1 .. $self->beats;
    return $strike;
}

done_testing();