algo-progression

#!/usr/bin/env perl

# Play a random rock progression with a randomized walking bassline.
# Example:
# $ perl algo-progression 120 1 Amv-Amc 2
# $ perl algo-progression 70 2 Amv-DMc 1 42 35
# $ timidity %.mid

use strict;
use warnings;

use Music::Chord::Note ();
use Music::Scales qw(get_scale_notes);

use Data::Dataset::ChordProgressions ();
use Music::Bassline::Generator ();
use MIDI::Drummer::Tiny ();
use MIDI::Util qw(set_chan_patch midi_format);
use Music::Duration::Partition ();

my $bpm   = shift || 100;
my $parts = shift || 'Amv-DMc-Emv-DMc'; # <Note><Major|minor><verse|chorus> phrases
my $reps  = shift || 1;                 # The number of times to repeat an individual phrase
my $multi = shift || 1;                 # The number of times the phrases are repeated

my $chords_patch = shift || 89;
my $bass_patch   = shift || 35;

my @parts = split /-/, $parts;

my $channel = 0;
my $octave  = 5;

my @progressions;

my $d = MIDI::Drummer::Tiny->new(
    file   => "$0.mid",
    bpm    => $bpm,
    bars   => 4 * @parts * $reps,
    reverb => 10,
);

$d->sync(
    \&drums,
    \&chords,
    \&bass,
);

$d->write;

sub drums {
    $d->metronome4($multi * $d->bars, 1);
}

sub chords {
    set_chan_patch($d->score, $channel++, $chords_patch);

    my $cn = Music::Chord::Note->new;

    my %data = Data::Dataset::ChordProgressions::as_hash();

    my @accum; # Note accumulator

    for my $part (@parts) {
        my ($note, $section, $scale, $pool);
        # Set the pool of possible progressions given scale and section
        if ($part =~ /^([A-G][#b]?)(M|m)(v|c)$/) {
            ($note, $scale, $section) = ($1, $2, $3);
            $scale   = $scale eq 'M' ? 'major' : 'minor';
            $section = $section eq 'v' ? 'verse' : 'chorus';
            $pool    = $data{rock}{$scale}{$section};
        }

        # Set the transposition map
        my %note_map;
        @note_map{ get_scale_notes('C', $scale) } = get_scale_notes($note, $scale);

        # Get a random progression
        my $progression = $pool->[int rand @$pool];

        # Transpose the progression chords from C
        (my $named = $progression->[0]) =~ s/([A-G][#b]?)/$note_map{$1}/g;

        # Keep track of the progressions used
        push @progressions, $named;

        print "$note $scale: $named, $progression->[1]\n";

        my @chords = split /-/, $named;

        # Add each chord to the score
        for my $j (1 .. $reps) {
            for my $chord (@chords) {
                $chord =~ s/sus2/add9/;
                $chord =~ s/6sus4/sus4/;
                my @notes = $cn->chord_with_octave($chord, $octave);
                @notes = midi_format(@notes);
                push @accum, \@notes;
            }
        }
    }

    for my $j (1 .. $multi) {
        print "\t", join ', ', map { "[@$_]" } @accum;
        for my $n (@accum) {
            $d->note($d->whole, @$n);
        }
        print "\n";
    }
}

sub bass {
    set_chan_patch($d->score, $channel++, $bass_patch);

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

    my $bassline = Music::Bassline::Generator->new(
        octave  => 2,
        guitar  => 1,
        verbose => 0,
        scale   => sub { $_[0] =~ /^[A-G][#b]?m/ ? 'pminor' : 'pentatonic' },
    );

    for (1 .. $reps * $multi) {
        for my $p (@progressions) {
            my @chords = split /-/, $p;

            my $i = 0;

            for my $chord (@chords) {
                $chord =~ s/sus2/add9/;
                $chord =~ s/6sus4/sus4/;

                my $m = $i % 2 == 0 ? $motif2 : $motif1;

                my $notes = $bassline->generate($chord, scalar(@$m));

                $mdp->add_to_score($d->score, $m, $notes);

                $i++;
            }
        }
    }
}