blues-progressions

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

# Blues-jazz (Jazz-blues?) chord progression practice tool
# Taken from the chart devised by Dan Haerle
# Available in the Jamey Aebersold "Jazz Handbook"

# My write-up is: https://ology.github.io/2022/11/25/twelve-bar-jazz-practice/


use Data::Dumper::Compact qw(ddc);
use Getopt::Long qw(GetOptions);
use MIDI::Drummer::Tiny ();
use MIDI::Util qw(set_chan_patch midi_format);
use Music::Cadence ();
use Music::Chord::Note ();
use Music::MelodicDevice::Transposition ();
use Music::Note ();

my %opts = (            # defaults:
    tonic   => 'C',     # note to transpose things to
    octave  => 4,       # octave of chord notes
    patch   => 5,       # 0=piano, etc general midi
    bpm     => 90,      # beats per minute
    bars    => 12,      # number of 4/4 bars
    repeat  => 1,       # number of times to repeat
    percent => 25,      # maximum half-note percentage
    hihat   => 'pedal', # pedal, closed, open
    drums   => 0,       # to drum, or not to drum?
    bass    => 0,       # to have a parallel bass or not
    simple  => 0,       # don't randomly choose a transition
    verbose => 0,
);
GetOptions( \%opts,     # abbreviations:
    'tonic=s',          # --t
    'octave=i',         # --o
    'patch=i',          # --pa
    'bpm=i',            # --bp
    'bars=i',           # --bar
    'repeat=i',         # --r
    'percent=i',        # --pe
    'hihat=s',          # --h
    'drums',            # --d
    'bass',             # --bas
    'simple',           # --s
    'verbose',          # --v
);

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

my @bass_notes; # global accumulator

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

$d->write;

sub drums {
    if ($opts{drums}) {
        $d->metronome44swing($d->bars * $opts{repeat});
        $d->note($d->whole, $d->kick, $d->ride1);
    }
    else {
        my $metronome = $opts{hihat} . '_hh';
        $d->count_in({
            bars  => $d->bars * $opts{repeat},
            patch => $d->$metronome(),
        });
    }
}

sub bass {
    if ($opts{bass}) {
        set_chan_patch($d->score, 1, 35);

        for (1 .. $opts{repeat}) {
            for my $n (@bass_notes) {
                $n =~ s/^([A-G][#b]?)\d$/$1 . 3/e; # change to octave 3
                $d->note($d->whole, midi_format($n));
            }
        }
    }
}

sub chords {
    set_chan_patch($d->score, 0, $opts{patch});

    my $md = Music::MelodicDevice::Transposition->new;
    my $cn = Music::Chord::Note->new;
    my $mc = Music::Cadence->new(
        key    => $opts{tonic},
        octave => $opts{octave},
        format => 'midi',
    );

    # all chords in C initially
    my $transpose = $cn->scale($opts{tonic});

    # get the chords - bars and network
    my @bars = bars();
    my %net  = net();

    my @specs; # bucket for the actual MIDI notes to play

    for my $n (0 .. $d->bars - 1) {
        my @pool = $bars[ $n % @bars ]->@*;
        my $chord = $opts{simple} ? $pool[0] : $pool[ int rand @pool ];
        my $new_chord = transposition($transpose, $chord, $md);
        my @notes = $cn->chord_with_octave($new_chord, $opts{octave});

        $_ = accidental($_) for @notes; # convert to flat

        push @bass_notes, $notes[0]; # accumulate the bass notes to play

        my $names = $new_chord; # chord name verbose mode

        my @spec; # for accumulating within the loop

        if (!$opts{simple} && $opts{percent} >= int(rand 100) + 1) {
            push @spec, [ $d->half, @notes ];

            @pool = $net{$chord}->@*;
            $chord = $pool[ int rand @pool ];
            my $new_chord = transposition($transpose, $chord, $md);
            @notes = $cn->chord_with_octave($new_chord, $opts{octave});

            $_ = accidental($_) for @notes; # convert to flat

            $names .= "-$new_chord"; # chord name verbose mode

            push @spec, [ $d->half, @notes ];
        }
        else {
            push @spec, [ $d->whole, @notes ];
        }

        printf '%*d. %13s: %s', length($opts{bars}), $n + 1, $names, ddc(\@spec)
            if $opts{verbose};

        push @specs, @spec; # accumulate the note specifications
    }

    # actually add the MIDI notes to the score
    for (1 .. $opts{repeat}) {
        $d->note(midi_format(@$_)) for @specs;
    }

    # finally end with a cadence chord
    my $cadence = $mc->cadence(type => 'imperfect');
    $d->note($d->whole, $cadence->[0]->@*);
}

sub transposition {
    my ($transpose, $chord, $md) = @_;
    if ($transpose && $chord =~ /^([A-G][#b]?)(.*)$/) {
        my $note = $1;
        my $flav = $2;
        my $transposed = $md->transpose($transpose, [$note]);
        (my $new_note = $transposed->[0]) =~ s/^([A-G][#b]?).*$/$1/;
        $new_note = accidental($new_note); # convert to flat
        $chord = $new_note;
        $chord .= $flav if $flav;
    }
    return $chord;
}

sub accidental {
    my ($string) = @_; # note or chord name
    if ($string =~ /^([A-G]#)(.*)?$/) { # is the note sharp?
        my $note = $1;
        my $flav = $2;
        my $mn = Music::Note->new($note, 'isobase');
        $mn->en_eq('b'); # convert to flat
        $string = $mn->format('isobase');
        $string .= $flav if $flav;
    }
    return $string;
}

sub bars {
    no warnings qw(qw);
    return (                                  # bar
        [qw( C7 CM7 C#m7                  )], #  1
        [qw( C7 F7  Bm7  FM7    C#m7      )], #  2
        [qw( C7 Am7 Em7  BM7              )], #  3
        [qw( C7 Gm7 Dbm7 AbM7             )], #  4
        [qw( F7 FM7                       )], #  5
        [qw( F7 Bb7 Gbm7 Gbdim7 Fm7       )], #  6
        [qw( C7 Em7 EbM7 EM7              )], #  7
        [qw( C7 A7  Bb7  Ebm7   Em7       )], #  8
        [qw( G7 D7  Dm7  Ab7    DbM7 DM7  )], #  9
        [qw( G7 F7  Abm7 Db7    Dm7  DbM7 )], # 10
        [qw( C7 Em7 FM7                   )], # 11
        [qw( C7 G7  Dm7  Ab7    Abm7 DM7  )], # 12
    );
}

sub net {
    no warnings qw(qw);
    return (
        'A7'     => [qw( Ebm7 D7 Dm7 Ab7 DM7 Abm7 )],
        'Ab7'    => [qw( DbM7 Dm7 G7 )],
        'AbM7'   => [qw( GbM7 )],
        'Abm7'   => [qw( Db Gm7 Db7 )],
        'Am7'    => [qw( D7 Abm7 )],
        'B7'     => [qw( C7 Em7 EM7 Bb7 )],
        'BM7'    => [qw( BbM7 )],
        'Bb7'    => [qw( C7 Ebm7 Em7 EbM7 A7 )],
        'Bbm7'   => [qw( Am7 )],
        'Bm7'    => [qw( E7 Bbm7 )],
        'C#m7'   => [qw( Gb7 )],
        'C7'     => [qw( C7 F7 Gm7 FM7 A7 Em7 B7 G7 Dm7 Ab7 )],
        'CM7'    => [qw( Bm7 FM7 C#m7 Ebm7 AbM7 )],
        'D7'     => [qw( Gm7 Dbm7 )],
        'DM7'    => [qw( DbM7 Db )],
        'Db7'    => [qw( C7 CM7 )],
        'DbM7'   => [qw( Dm7 CM7 )],
        'Dbm7'   => [qw( Gb7 )],
        'Dm7'    => [qw( Dbm7 G7 Db7 Db )],
        'E7'     => [qw( Am7 )],
        'EM7'    => [qw( Em7 )],
        'EbM7'   => [qw( Ebm7 DM7 )],
        'Ebm7'   => [qw( Ab7 Dm7 Ebm7 )],
        'Em7'    => [qw( Dm7 A7 Ebm7 Edim7 )],
        'Edim7'  => [qw( Dm7 )],
        'F7'     => [qw( C7 Bb7 Eb7 Gbm7 Gbdim7 Em7 )],
        'FM7'    => [qw( Em7 Fm7 Gbm7 )],
        'Fm7'    => [qw( Em7 Bb7 )],
        'G7'     => [qw( G7 F7 Abm7 C7 Em7 )],
        'Gb7'    => [qw( Bm7 BM7 FM7 )],
        'GbM7'   => [qw( FM7 )],
        'Gbm7'   => [qw( B7 )],
        'Gbdim7' => [qw( Em7 )],
        'Gm7'    => [qw( C7 Gb7 )],
    );
}