duration-selection

#!/usr/bin/env perl
use strict;
use warnings;

use Data::Dumper::Compact 'ddc';
use MIDI::Drummer::Tiny;
use MIDI::Util qw(set_chan_patch);
use Music::Duration::Partition;
use Music::Scales;
use Music::VoiceGen;

my $beats  = shift || 4;
my $bars   = shift || 4;
my $bpm    = shift || 105;
my $note   = shift || 'A';
my $bscale = shift || 'pminor';
my $tscale = shift || 'minor';
my $bpatch = shift || 35;
my $tpatch = shift || 0;

my $octave = 1;

my $d = MIDI::Drummer::Tiny->new(
    file      => "$0.mid",
    bpm       => $bpm,
    signature => $beats . '/4',
    bars      => $bars,
    kit       => 25,
);

$d->score->synch(
    \&drums,
    \&bass,
    \&top,
);

$d->write;

sub bass {
    set_chan_patch($d->score, 1, $bpatch);

    my $mdp = Music::Duration::Partition->new(
        size => $beats,
        pool => [qw/ hn qn /],
        weights => [2, 1],
    );
    my $motif1 = $mdp->motif;
    my $motif2 = $mdp->motif;

    my @pitches = (
        get_scale_MIDI($note, $octave, $bscale),
        get_scale_MIDI($note, $octave + 1, $bscale),
    );
    my @intervals = qw(-4 -3 -2 -1 1 2 3 4);
    my $voice = Music::VoiceGen->new(
        pitches   => \@pitches,
        intervals => \@intervals,
    );

    my @notes1 = map { $voice->rand } @$motif1;
    my @notes2 = map { $voice->rand } @$motif2;

    for my $n (1 .. $d->bars * 2) {
        for my $i (0 .. $#$motif1) {
            $d->note($motif1->[$i], $n % 2 ? $notes1[$i] : $notes2[$i]);
        }

        for my $i (0 .. $#$motif2) {
            $d->note($motif2->[$i], $n % 2 ? $notes1[$i] : $notes2[$i]);
        }
    }

    $d->note($d->whole, $pitches[0]);
}

sub top {
    set_chan_patch($d->score, 0, $tpatch);

    my $mdp = Music::Duration::Partition->new(
        size => $beats,
        pool => [qw/ dqn qn en /],
    );
    my @motifs = map { $mdp->motif } 1 .. 4;

    my @pitches = (
        get_scale_MIDI($note, $octave + 1, $tscale),
        get_scale_MIDI($note, $octave + 2, $tscale)
    );
    my $voice = Music::VoiceGen->new(
        pitches   => \@pitches,
        intervals => [qw(-4 -3 -2 -1 1 2 3 4)],
    );
    my @notes = map { [ map { $voice->rand } $motifs[$_]->@* ] } 0 .. 3;

    for my $n (1 .. $d->bars * 2) {
        my $motif = $motifs[ int rand @motifs ];
        my $notes = $notes[ int rand @notes ];
        for my $i (0 .. $#$motif) {
            if (defined $notes->[$i]) {
                $d->note($motif->[$i], $notes->[$i]);
            }
            else {
                $d->rest($motif->[$i]);
            }
        }
        $d->rest($d->whole);
    }

    $d->note($d->whole, $pitches[0]);
}

sub drums {
    my $x = $d->bars * 4;
    if ($beats == 3) {
        $d->metronome3($x);
    }
    elsif ($beats == 4) {
        $d->metronome4($x);
    }
    elsif ($beats == 5) {
        $d->metronome5($x);
    }
    elsif ($beats == 7) {
        $d->metronome7($x);
    }
    else {
        die 'Invalid beats';
    }

    $d->note($d->whole, $d->crash1, $d->kick);
}