progressive

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

use Data::Dumper::Compact qw(ddc);
use MIDI::Drummer::Tiny;
use MIDI::Praxis::Variation qw(transposition);
use MIDI::Util qw(set_chan_patch midi_format);
use Music::Cadence;
use Music::Chord::Progression;
use Music::Duration::Partition;
use Music::Scales qw(get_scale_notes get_scale_MIDI);
use Music::VoiceGen;

my $bars   = shift || 16;
my $bpm    = shift || 105;
my $note   = shift || 'C';
my $tscale = shift || 'major'; # or minor, etc
my $bpatch = shift || 35;

my $bscale = $tscale eq 'major' ? 'pentatonic' : 'pminor';

# General MIDI patches that are tones
my @patches =
    # soft:
    qw(4 5 12 16 20 21 32 33 35 39 40 42 44 46 49 50 51 52 53 58 65 68 69 70 72 73 74 75 76 77 85 89 90 91 93 94 95)
    # hard:
#    qw(0 7 8 13 17 18 25 27 28 29 31 41 48 54 56 59 66 67 71 83 84)
    # all:
#    (0 .. 95)
;

my $rand_patch = sub { $patches[int rand @patches] };

my $tpatch = $rand_patch->();
my $ppatch = $rand_patch->();
print "Patches: Top=$tpatch, Progression=$ppatch, Bottom=$bpatch\n";

my $d = MIDI::Drummer::Tiny->new(
    file => "$0.mid",
    bpm  => $bpm,
    bars => $bars,
);

my @bass; # List of initial bottom notes
my @notes; # List of chord named notes with octave

$d->score->synch(
#    \&drums,
    \&progression,
    \&bottom,
    \&top,
);

$d->write;

sub drums {
    $d->count_in($bars * 2);
#    $d->metronome4($bars * 2);
    $d->note($d->whole, $d->crash1, $d->kick);
}

sub progression {
    set_chan_patch($d->score, 2, $ppatch);

    my @pitches = get_scale_notes($note, $bscale); # Use the bass scale to generate the progression

    # Get a list of notes that don't repeat
    my $last = '';
    for my $n (1 .. 4) {
        my $note = $pitches[int rand @pitches];
        while ($last eq $note) {
            $note = $pitches[int rand @pitches];
        }
        push @notes, $note;
        $last = $note;
    }

    my $chords;
    if ($tscale eq 'major') {
        $chords = ['','m','m','','','m'];
    }
    else {
        $chords = ['m','','m','m','',''];
    }

    for my $x (@notes) {
        my $prog = Music::Chord::Progression->new(
            scale_note => $x,
            scale_name => $tscale,
            chords     => $chords,
#            substitute => 1,
#            verbose    => 1,
        );
        my $notes = $prog->generate;

        for my $chord (@$notes) {
            $chord = [ midi_format(@$chord) ];
            $d->score->n('wn', @$chord);
            push @bass, $chord->[0];
        }
        print $x, ': ', ddc($notes);
    }
    my $mc = Music::Cadence->new(
        key    => $notes[-1],
        scale  => $tscale,
        octave => 4,
    );
    my $cadence = $mc->cadence;
    @$cadence = map { [ midi_format(@$_) ] } @$cadence;
    $d->score->n('wn', @$_) for @$cadence;
    $cadence = $mc->cadence(type => 'plagal');
    @$cadence = map { [ midi_format(@$_) ] } @$cadence;
    $d->score->n('wn', @$_) for @$cadence;
}

sub bottom {
    set_chan_patch($d->score, 0, $bpatch);

    my @transp = transposition(-12, @bass);

    my $mdp = Music::Duration::Partition->new(
        size => 4,
        pool => [qw(dhn hn qn)],
    );

    my @phrases = map { $mdp->motif } 1 .. 4;

    for my $x (@transp) {
        my $phrase = $phrases[int rand @phrases];
        for my $n (0 .. $#$phrase) {
            if ($n % 2 == 0) {
                $d->score->n($phrase->[$n], $x);
            }
            else {
                $d->score->n($phrase->[$n], $x + 7);
            }
        }
    }

    $d->score->n('wn', $transp[0]);
    $d->score->n('wn', $transp[0]);
    $d->score->n('wn', $transp[0]);
    $d->score->n('wn', $transp[0]);
}

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

    my $mdp = Music::Duration::Partition->new(
        size => 4,
#        pool => [qw(dhn hn qn)], # "plaintive"
        pool => [qw(hn qn dqn en)],
    );

    my @phrases = map { $mdp->motif } 1 .. 4;

    my @intervals = qw(-4 -3 -2 -1 1 2 3 4);

    for my $x (@notes) {
        my @pitches = (
            get_scale_MIDI($x, 4, $tscale),
            get_scale_MIDI($x, 5, $tscale),
        );
        my $voice = Music::VoiceGen->new(
            pitches   => \@pitches,
            intervals => \@intervals,
        );

        for my $i (1 .. 8) { # NOTE 8 is the default Music::Chord::Progression max
            my $phrase = $phrases[int rand @phrases];
            for my $n (0 .. $#$phrase) {
                $d->score->n($phrase->[$n], $voice->rand);
            }
        }
    }
}