follow

#!/usr/bin/env perl

# Examples: https://youtu.be/NITwAFaw7B4
# perl follow 12
# perl follow 9 120 '4,16,69,70' pminor A
# perl follow 9 100 '4,16,69' dorian D

use strict;
use warnings;

use MIDI::Util qw(setup_score set_chan_patch); # https://metacpan.org/pod/MIDI::Util
use Music::Scales;

# User definable parameters
my $group   = shift || 1; # Groups of 3 bars
my $bpm     = shift || 100; # Beats per minute
my $patches = shift || '89,90,91,93,95'; # 4,16,69,70
my $name    = shift || 'pentatonic'; # Scale name
my $note    = shift || 'C'; # Bf, Cs, etc.

# Global parameters
my $octave = 4;  # Octave number to append to notes
my $bass   = 35; # Fretless bass patch
my $hihat  = 44; # Pedal hi-hat patch
my $size   = 3;  # The number of measures in a phrase
my $drums  = 9;  # Drum channel
my $max    = 14; # Maximum number of channels allowed

# 9 possible 3 bar phrases
my $possibles = [         #   |   |   |   |  <- 3 measures
    [qw/ wn wr wr /],     # 0 ####.   .   .  <- Whole note
    [qw/ qr wn dhr wr /], # 1 .####   .   .
    [qw/ hr wn hr wr /],  # 2 . ####  .   .
    [qw/ dhr wn qr wr /], # 3 .  #### .   .
    [qw/ wr wn wr /],     # 4 .   ####.   .
    [qw/ wr qr wn dhr /], # 5 .   .####   .
    [qw/ wr hr wn hr /],  # 6 .   . ####  .
    [qw/ wr dhr wn qr /], # 7 .   .  #### .
    [qw/ wr wr wn /],     # 8 .   .   ####.
];

# Convert the CSV patches to an arrayref
$patches = [ split /,/, $patches ];
die "Can't have more than $max patches"
    if @$patches > $max;

my @scale = get_scale_notes($note, $name);

my $score = setup_score(bpm => $bpm);

my $channel = 0;

$score->synch(
    (map { \&roll } 1 .. @$patches), # Roll as many times as there are patches
    \&drums,
    \&bass,
);

# Write the tonic to the end of the bass track
$score->n('wn', $scale[0]);

$score->write_score("$0.mid");

sub roll {
    # Choose a patch based on the incrementing channel value
    my $patch = $patches->[ $channel > $drums ? $channel - 1 : $channel ];
    die 'Non-digit patch not allowed'
        unless $patch =~ /^\d+$/;
    $channel++
        if $channel == $drums; # Skip the drum channel
    set_chan_patch($score, $channel++, $patch);

    for my $i (1 .. $group) {
        my $roll = int rand @$possibles;
        print "$channel.$i. Adding roll #", $roll, " for patch: $patch\n";
        print "\t";
        for my $duration (@{ $possibles->[$roll] }) {
            my $trigger = substr $duration, length($duration) - 1, 1;
            if ($trigger eq 'n') {
                _add_note($duration, $octave);
            }
            else {
                (my $dura = $duration) =~ s/r/n/;
                $score->r($dura);
            }
        }
        print "\n";
    }
}

sub bass {
    $channel++
        if $channel == $drums; # Skip the drum channel
    set_chan_patch($score, $channel++, $bass);

    for my $i (1 .. $group) {
        print "$channel.$i. Adding bass with patch: $bass\n";
        print "\t";
        for my $duration (('hn') x ($size * 2)) { # Measures of half-notes
            _add_note($duration, $octave - 1);
        }
        print "\n";
    }
}

sub drums {
    set_chan_patch($score, $drums, 0);

    for my $i (1 .. $group) {
        for my $duration (('qn') x ($size * 4)) { # Measures of quarter-notes
            $score->n($duration, $hihat, 'mp');
        }
    }
}

sub _add_note {
    my ($duration, $octave) = @_;
    my $n = $scale[int rand @scale] . $octave;
    print "$n ";
    $score->n($duration, $n, 'f');
}