figured-syncopation

#!/usr/bin/env perl

# My write-up: https://ology.github.io/2023/03/10/realistic-drum-grooves/

# Usage: perl figured-syncopation --options
# Examples:
# perl figured-syncopation # just go with the defaults
# perl figured-syncopation --bpm=200 # speed it up
# perl figured-syncopation --patch=35 # make up a bass part
# perl figured-syncopation --max=3 # number of phrases to generate
# perl figured-syncopation --euclid=2,3 --euclid=5,3 # specify the phrases
# perl figured-syncopation --eu=2,3 --eu=3,2 # abbreviate
# perl figured-syncopation --ph=12 # try a different phrase length

use strict;
use warnings;

# use my local author libraries

use Getopt::Long qw(GetOptions);
use Data::Dumper::Compact qw(ddc);
use MIDI::Drummer::Tiny ();
use MIDI::Util qw(set_chan_patch);
use Music::CreatingRhythms ();
use Music::Duration::Partition ();
use Music::Scales qw(get_scale_MIDI);
use Music::VoiceGen ();

my %opts = (
    bpm     => 90, # beats per minute
    size    => 16, # changing this will make the bass player have a bad day
    euclid  => [], # list of "kick,snare" onsets, eg: --euclid=2,3 --euclid=3,2
    max     => 2,  # number of random grooves to generate unless given euclids
    patch   => -1,       # 0 or 35 or 42, etc. Bass patch : -1 = off
    note    => 'A',      # bass scale starting note
    scale   => 'pminor', # bass scale name
    duel    => 0, # alternate with the hihat-only, counterpart section
    countin => 0, # play 4 hihat notes to start things off
    verbose => 0, # be overly snoopy
    quiet   => 0, # be silent
);
GetOptions(\%opts,
    'bpm=i',
    'size=i',
    'euclid=s@',
    'max=i',
    'patch=i',
    'note=s',
    'scale=s',
    'duel',
    'countin',
    'verbose',
    'quiet',
) or die "Error in command line arguments\n";

# initialize the kick and snare onsets
my @grooves;
for my $item ($opts{euclid}->@*) {
    my ($kick, $snare) = split /,/, $item;
    push @grooves, {
        kick  => $kick,
        snare => $snare,
    };
}
unless (@grooves) {
    for my $i (1 .. $opts{max}) {
        my $kick = kick_onsets();
        push @grooves, {
            kick  => $kick,
            snare => snare_onsets(0, $kick),
        };
    }
    # slower grooves go first
    @grooves = sort { $a->{kick} <=> $b->{kick} || $a->{snare} <=> $b->{snare} } @grooves;
}
print 'Onsets: ', ddc(\@grooves) unless $opts{quiet};

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

$d->count_in(1) if $opts{countin};

for my $groove (@grooves) {
    euclidean_part($groove->{snare}, $groove->{kick});
    counterpart() if $opts{duel};
}

$d->write;

sub kick_onsets {
    my ($onsets) = @_;
    unless ($onsets) {
        $onsets = rand_onset();
        while ($onsets < 3) {
            $onsets = rand_onset();
        }
    }
    return $onsets;
}

sub snare_onsets {
    my ($onsets, $kick) = @_;
    unless ($onsets) {
        $onsets = rand_onset();
        while ($onsets >= $kick) {
            $onsets = rand_onset();
        }
    }
    return $onsets;
}

sub rand_onset {
    my ($n) = @_;
    $n ||= $opts{size} / 2;
    return 1 + int rand($n - 1);
}

sub counterpart {
    set_chan_patch($d->score, 9, 0);
    $d->count_in($d->bars);
}

sub rotate_sequence {
    my ($onsets) = @_;
    my $mcr = Music::CreatingRhythms->new;
    my $sequence = $mcr->euclid($onsets, $opts{size});
    $sequence = $mcr->rotate_n(2, $sequence);
    my $sequence_string = join '', @$sequence;
    return $sequence_string;
}

sub euclidean_part {
    my ($snare_ons, $kick_ons) = @_;
    set_chan_patch($d->score, 9, 0);
    my $bars = $d->bars - 1;
    my $hh = '1' x ($opts{size} / 2);
    $d->sync(
        sub { $d->pattern( instrument => $d->closed_hh, patterns => [ ($hh) x $bars ] ) },
        sub { $d->pattern( instrument => $d->snare,     patterns => [ (rotate_sequence($snare_ons)) x $bars ] ) },
        sub { $d->pattern( instrument => $d->kick,      patterns => [ ($d->euclidean($kick_ons, $opts{size})) x $bars ] ) },
        sub { bottom($bars) },
    );
    $d->sync(
        sub { fill($snare_ons, $kick_ons) },
        sub { bottom(1) },
    );
}

sub fill {
    my ($snare_onset, $kick_onset) = @_;
    set_chan_patch($d->score, 9, 0);
    my $hh = '1' x ($opts{size} / 2);
    $d->add_fill(
        \&_fill,
        $d->closed_hh => [ $hh ],
        $d->snare     => [ rotate_sequence($snare_onset) ],
        $d->kick      => [ $d->euclidean($kick_onset, $opts{size}) ],
    );
}

sub _fill {
    my ($self) = @_;
    my $snare_ons = 1 + int rand($opts{size} / 2);
    my $hh = '0' x ($opts{size} / 2);
    (my $kick = $hh) =~ s/^0/1/;
    return {
        duration         => $opts{size},
        $self->closed_hh => $hh,
        $self->snare     => $d->euclidean($snare_ons, $opts{size} / 2),
        $self->kick      => $kick,
    };
}

sub bottom {
    my ($bars) = @_;

    return if $opts{patch} < 0;

    $bars ||= $d->bars;

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

    my $size = 3;#$opts{size} / 4 - 1; # number of beats to play over

    my $mdp1 = Music::Duration::Partition->new(
        size    => $size,
        pool    => [qw/qn en sn/],
        group   => [   1, 2, 4  ],
        verbose => $opts{verbose},
    );
    my $motif1 = $mdp1->motif;

    my $mdp2 = Music::Duration::Partition->new(
        size    => $size,
        pool    => [qw/qn en/],
        verbose => $opts{verbose},
    );
    my $motif2 = $mdp2->motif;

    my @pitches = get_scale_MIDI($opts{note}, 1, $opts{scale});

    my $voice = Music::VoiceGen->new(
        pitches   => \@pitches,
        intervals => [qw/-4 -3 -2 2 3 4/],
    );

    my @notes1 = map { $voice->rand } @$motif1;

    for my $i (1 .. $bars) {
        if ($i % 2) {
            $mdp1->add_to_score($d->score, $motif1, \@notes1);
        }
        else {
            my @notes2 = map { $voice->rand } @$motif2;
            $mdp2->add_to_score($d->score, $motif2, \@notes2);
        }

        $d->rest($d->quarter);
    }
}