chord-melody

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

use Data::Dumper::Compact qw(ddc);
use MIDI::Util qw(midi_format setup_score set_chan_patch);
use Music::Cadence ();
use Music::Chord::Progression ();
use Music::Duration::Partition ();
use Music::MelodicDevice::Inversion ();
use Music::MelodicDevice::Ornamentation ();
use Music::Note ();
use Music::Scales qw(get_scale_MIDI);
use Music::ToRoman ();
use Music::VoiceGen ();

my $scale_note = shift || 'C';
my $scale_name = shift || 'major';

my $max_phrase = 28; # Number of melody phrases
my $num_notes  = 8;  # Number of notes for the melody
my $max_chords = 8;  # Number of progression chords
my $phrase_num = 4;  # Number of progression phrases

my @bass_notes;

my $score = setup_score();

$score->synch(
    \&progression,
    \&bottom,
    \&melody,
);

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

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

    my $mdi = Music::MelodicDevice::Inversion->new(
        scale_note => $scale_note,
        scale_name => $scale_name,
#        verbose => 1,
    );

    my $mdo = Music::MelodicDevice::Ornamentation->new(
        scale_note => $scale_note,
        scale_name => $scale_name,
#        verbose => 1,
    );

    my @pitches = get_scale_MIDI($scale_note, 5, $scale_name);
    my @intervals = qw(-4 -3 -2 -1 1 2 3 4);
    my $voice = Music::VoiceGen->new(
        pitches   => \@pitches,
        intervals => \@intervals,
    );

    my $mdp = Music::Duration::Partition->new(
        size => 4,
        pool => [qw(dqn qn en)],
    );
    my @motifs = map { $mdp->motif } 1 .. 3;

    my @notes;

    for my $i (1 .. $max_phrase) {
        my @spec;

        if ($i % 2 == 0) {
            @notes = @{ $mdi->invert($notes[0], \@notes) };
            for my $n (0 .. 4) {
                if ($n > 0 && $n % 3 == 0) {
                    my $roll = int rand 5;
                    if ($roll == 0) {
                        print "Ornament: trill\n";
                        push @spec, @{ $mdo->trill('qn', $notes[$n], 2, 1) };
                    }
                    elsif ($roll == 1) {
                        print "Ornament: mordent\n";
                        push @spec, @{ $mdo->mordent('qn', $notes[$n], 1) };
                    }
                    elsif ($roll == 2) {
                        print "Ornament: turn\n";
                        push @spec, @{ $mdo->turn('qn', $notes[$n], 1) };
                    }
                    else {
                        push @spec, [ 'qn', $notes[$n] ];
                    }
                }
                else {
                    push @spec, [ 'qn', $notes[$n] ];
                }
            }
        }
        else {
            @notes = map { Music::Note->new($voice->rand, 'midinum')->format('ISO') } 1 .. $num_notes;
            @spec = ();
            my $motif = $motifs[int rand @motifs];
            for my $n (0 .. $#$motif) {
                my $note = $notes[$n] || $voice->rand;
                my $vol = 'v' . (96 + int(rand 32)); # f-fff
                push @spec, [ $motif->[$n], $note, $vol ];
            }
        }

        @spec = map { [ midi_format(@$_) ] } @spec;
#        print 'Spec: ', ddc(\@spec);

        $score->n(@$_) for @spec;
    }

    $score->n('wn', $pitches[0] - 12);
}

sub progression {
    set_chan_patch($score, 1, 0);

    my $octave = 4;

    my $mtr = Music::ToRoman->new(
        scale_note => $scale_note,
        scale_name => $scale_name,
        chords     => 0,
#        verbose    => 1,
    );

    my @pitches = get_scale_MIDI($scale_note, $octave, $scale_name);
    my @intervals = qw(-4 -3 -2 -1 1 2 3 4);
    my $voice = Music::VoiceGen->new(
        pitches   => \@pitches,
        intervals => \@intervals,
    );
    my @notes = map { Music::Note->new($voice->rand, 'midinum')->format('isobase') } 1 .. $phrase_num;

    for my $n (@notes) {
        my $roman = $mtr->parse($n);
        my $name;
        my $chords;
        if ($roman =~ /^[A-Z]+$/) {
            $name = 'major';
            $chords = ['','m','m','','','m','dim'];
        }
        else {
            $name = 'minor';
            $chords = ['m','dim','','m','m','',''];
        }

        my $prog = Music::Chord::Progression->new(
            max        => $max_chords,
            scale_note => $n,
            scale_name => $name,
            chord_map  => $chords,
            resolve    => 0,
#            substitute => 1,
#            verbose    => 1,
        );
        my $notes = $prog->generate;

        for my $chord (@$notes) {
            $chord = [ midi_format(@$chord) ];
            $score->n('wn', @$chord);
            push @bass_notes, $chord->[0];
        }
        print "$n ($roman): ", ddc($notes);
    }

    my $mc = Music::Cadence->new(
        key    => $scale_note,
        octave => $octave,
        format => 'midi',
    );
    my $notes = $mc->cadence(type => 'plagal');
    push @bass_notes, $notes->[0][0], $notes->[1][0];
    $score->n('wn', @$_) for @$notes;
}

sub bottom {
    set_chan_patch($score, 2, 35);

    for my $n (0 .. $#bass_notes) {
        $bass_notes[$n] =~ s/[45]/3/; # Make everything one octave
        my $note = $bass_notes[$n];
        if ($n % 2 == 1) {
            $score->n('hn', $note);
            $score->n('hn', $note);
        }
        else {
            $score->n('wn', $note);
        }
    }
    print 'Bottom: ', ddc(\@bass_notes);
}