polygenic

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

use v5.24.0;

use Data::Dumper::Compact 'ddc';
use lib map { "$ENV{HOME}/sandbox/$_/lib" } qw(MIDI-Drummer-Tiny MIDI-Praxis-Variation MIDI-Util Music-Duration-Partition);
use MIDI::Drummer::Tiny;
use MIDI::Praxis::Variation qw(diminution);
use MIDI::Util qw(set_chan_patch);
use Music::Duration::Partition;
use Music::Scales qw(get_scale_MIDI);
use Music::VoiceGen;

my $bars   = shift || 16;
my $bpm    = shift || 105;
my $note   = shift || 'D';
my $bscale = shift || 'pminor';
my $tscale = shift || 'dorian';
my $bpatch = shift || 35;
my $tpatch = shift || 4;

# Start off in the bass register
my $octave = 1;

# Someone find the drummer!
my $d = MIDI::Drummer::Tiny->new(
    file      => "$0.mid",
    bpm       => $bpm,
    bars      => $bars,
    signature => '5/4',
);

my $count = 0;

# Play the parts simultaneously
$d->score->synch(
    \&drums,
    \&bottom,
    \&top,
);

# Write the score to a MIDI file
$d->write;

sub bottom {
    set_chan_patch($d->score, 0, $bpatch);

    my $beats = 5;

    # Create a rhythmic phrase generator
    my $mdp = Music::Duration::Partition->new(
        size => $beats,
        pool => [qw(hn dqn qn en)],
    );

    # Create 3 phrases
    my @phrases = map { { motif => $mdp->motif } } 1 .. 3;

    # Create 2 bass octaves
    my @pitches = (
        get_scale_MIDI($note, $octave, $bscale),
        get_scale_MIDI($note, $octave + 1, $bscale),
    );

    # Create a pitch generator
    my $voice = Music::VoiceGen->new(
        pitches   => \@pitches,
        intervals => [qw(-4 -3 -2 -1 1 2 3 4)],
    );

    # Start the pitch generation in the middle of the register
    $voice->context($pitches[12]);

    # Create two voice mappings for each phrase
    for my $phrase (@phrases) {
        push $phrase->{voices}->@*, [ map { $voice->rand } $phrase->{motif}->@* ];
        push $phrase->{voices}->@*, [ map { $voice->rand } $phrase->{motif}->@* ];
    }
    print 'Bottom: ', ddc(\@phrases);

    # Add the bass notes to the score
    for my $i (1 .. sprintf('%.0f', $count / $beats)) {
        # Select a random phrase
        my $phrase = $phrases[int rand @phrases];
        # Select a random voice mapping
        my $voices = ($phrase->{voices}->@*)[int rand $phrase->{voices}->@*];
        # Add the voiced motif to the score
        for my $n (0 .. $phrase->{motif}->$#*) {
            $d->note($phrase->{motif}[$n], $voices->[$n]);
        }
    }

    # Add a final resolving whole note to the score
    $d->note($d->whole, $pitches[0]);
}

sub top {
    set_chan_patch($d->score, 1, $tpatch);

    my $beats = 4;

    my $mdp = Music::Duration::Partition->new(
        size => $beats,
#        pool => [qw(hn qn en)],
#        weights => [1, 2, 3],
        pool => [qw(hn qn en ten)], # Solo mode
        weights => [2, 3, 4, 1],
        groups => [0, 0, 0, 3],
    );

    my @phrases = map { { motif => $mdp->motif } } 1 .. 4;

    my @pitches = (
        get_scale_MIDI($note, $octave + 2, $tscale),
        get_scale_MIDI($note, $octave + 3, $tscale),
    );
    my $voice = Music::VoiceGen->new(
        pitches   => \@pitches,
        intervals => [qw(-4 -3 -2 -1 1 2 3 4)],
    );

    for my $phrase (@phrases) {
        push $phrase->{voices}->@*, [ map { $voice->rand } $phrase->{motif}->@* ];
        push $phrase->{voices}->@*, [ map { $voice->rand } $phrase->{motif}->@* ];
    }
    print 'Top: ', ddc(\@phrases);

    for my $i (1 .. int($count / $beats)) {
        my $phrase = $phrases[int rand @phrases];
        my $voices = ($phrase->{voices}->@*)[int rand $phrase->{voices}->@*];
        if ($i % 2 == 0) {
            for my $n (0 .. $phrase->{motif}->$#*) {
                # Get a fluctuating velocity between f and fff
                my $vol = 'v' . (96 + int(rand 32));
                my @halved = diminution($phrase->{motif}[$n]);
                $d->note($halved[0], $voices->[$n], $vol);
                $d->rest($halved[0]);
            }
        }
        else {
            for my $n (0 .. $phrase->{motif}->$#*) {
                my $vol = 'v' . (96 + int(rand 32)); # f-fff
                $d->note($phrase->{motif}[$n], $voices->[$n], $vol);
            }
        }
    }

    $d->note($d->whole, $pitches[0]);
}

sub drums {
    $count = $d->bars * $d->beats;
    $d->metronome54;
    $d->note($d->whole, $d->crash1, $d->kick);
}