chordal

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

use v5.24.0;

use Data::Dumper::Compact 'ddc';
use MIDI::Drummer::Tiny;
use MIDI::Praxis::Variation qw(transposition);
use MIDI::Util qw(set_chan_patch);
use Music::Duration::Partition;
use Music::Note;
use Music::Scales qw(get_scale_MIDI);
use Music::VoiceGen;

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

# 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 => '4/4',
);

my $count = 0;

my @bass; # List of initial bottom notes

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

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

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

    my $beats = 4;

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

    # 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}->$#*) {
            push @bass, $voices->[$n] if $n == 0;
            $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 ten)], # Solo mode
        weights => [2, 3, 3, 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(-5 -4 -3 -2 -1 1 2 3 4 5)],
    );

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

    my $x = 0;
    for my $i (1 .. int($count / $beats)) {
        if ($i % 2) {
            my $phrase = $phrases[int rand @phrases];
            my $voices = ($phrase->{voices}->@*)[int rand $phrase->{voices}->@*];
            for my $n (0 .. $phrase->{motif}->$#*) {
                my $vol = 'v' . (96 + int(rand 32)); # f-fff
                $d->note($phrase->{motif}[$n], $voices->[$n], $vol);
            }
        }
        else {
            if ($x % 2 == 0) {
                $d->note($d->whole, $voice->rand);
            }
            else {
                $d->note($d->half, $voice->rand);
                $d->note($d->half, $voice->rand);
            }
            $x++;
        }
    }

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

sub dyads {
    set_chan_patch($d->score, 2, 0);

    my @transp = transposition(12, @bass);

    my @notes = map { [ $_, $_ + 7 ] } @transp;
    print 'Dyads: ', ddc(\@notes);

    for my $i (@notes) {
        $d->note($d->whole, @$i);
    }
}

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