phrase-context

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

use MIDI::Drummer::Tiny;
use MIDI::Praxis::Variation qw/diminution transposition/;
use MIDI::Util qw(set_chan_patch);
use Music::Scales;
use Music::VoiceGen;
use Music::Duration::Partition;

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 @context;

my $d = MIDI::Drummer::Tiny->new(
    file      => "$0.mid",
    bpm       => $bpm,
    signature => $beats . '/4',
    bars      => $bars,
    kick      => 'n36', # Override default patch
    snare     => 'n40', # "
);

$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;

    push @context, { motif => $motif1, notes => \@notes1 };
    push @context, { motif => $motif2, notes => \@notes2 };

    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 $motif1 = $mdp->motif;
    my $motif2 = $mdp->motif;

    my @pitches = (
        get_scale_MIDI($note, $octave + 1, $tscale),
        get_scale_MIDI($note, $octave + 2, $tscale)
    );
    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 } @$motif1;
    my @notes3 = map { $voice->rand } @$motif2;
    my @notes4 = map { $voice->rand } @$motif2;
    my @notes5 = transposition(24, @{ $context[0]->{notes} });

    my $cm = $context[0]->{motif};

    for my $n (1 .. $d->bars * 2) {
        if ($n % 4 == 0 || $n % 6 == 0) {
            $mdp->add_to_score($d->score, $cm, \@notes5);
        }
        else {
            for my $i (0 .. $#$motif1) {
                $d->note($motif1->[$i], $n % 2 == 0 ? $notes2[$i] : $notes1[$i]);
            }
        }

        if ($n % 3 == 0 || $n % 7 == 0 || $n % 9 == 0) {
            for my $i (0 .. $#$cm) {
                $d->note($cm->[$i], $notes5[$i]);
            }
        }
        else {
            for my $i (0 .. $#$motif2) {
                my @halved = diminution($motif2->[$i]);
                $d->note($halved[0], $n % 4 == 0 ? $notes4[$i] : $notes3[$i]);
                $d->rest($halved[0]);
            }
        }
    }

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

sub drums {
    my $x = $d->bars * 4;
    if ($beats == 3) {
        $d->metronome34($x);
    }
    elsif ($beats == 4) {
        $d->metronome44($x);
    }
    elsif ($beats == 5) {
        $d->metronome54($x);
    }
    elsif ($beats == 7) {
        $d->metronome74($x);
    }
    else {
        die 'Invalid beats';
    }

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