algo-rock

#!/usr/bin/env perl

# Play a random rock progression with a randomized bassline.
# The patches are jazzy, but are the best defaults imho.
# Unfortunately, certain chords are unknown (e.g. 6sus4) yet.

use strict;
use warnings;

use List::MoreUtils qw(first_index);
use Data::Dataset::ChordProgressions;
use lib map { "$ENV{HOME}/sandbox/$_/lib" } qw(MIDI-Bassline-Walk MIDI-Util MIDI-Drummer-Tiny Music-Duration Music-Duration-Partition);
use MIDI::Util qw(set_chan_patch midi_format);
use MIDI::Bassline::Walk;
use MIDI::Drummer::Tiny;
use Music::Duration::Partition;
use Music::Chord::Note;
use Music::Scales qw(get_scale_notes);

my $reps  = shift || 1;
my $sects = shift || 'Amv-DMc-Emv-DMc'; # <note><major|minor><verse|chorus>

my @sections = split /-/, $sects;

my $chords_patch = 5;
my $bass_patch = 35;
my $channel = 0;
my $octave = 4;

my @progressions;

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

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

$d->write;

sub drums {
    $d->count_in($d->bars);
}

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

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

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

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

        # 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) {
                my @notes = $cn->chord_with_octave($chord, $octave);
                @notes = midi_format(@notes);
                $d->note($d->whole, @notes);
            }
        }
    }
}

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

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

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

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

            my $i = 0;

            for my $chord (@chords) {
                my $m;
                if ($i % 2 == 0) {
                    $m = $motif2;
                }
                else {
                    $m = $motif1;
                }
                my $notes = $bassline->generate($chord, scalar(@$m));

                for my $j (0 .. $#$m) {
                    $d->note($m->[$j], $notes->[$j]);
                }

                $i++;
            }
        }
    }
}