micro-themed

#!/usr/bin/env perl

# * This program produces unsavory things. YMMV :\

use strict;
use warnings;

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

my $max    = shift || 4;
my $bpm    = shift || 105;
my $note   = shift || 'C';
my $tscale = shift || 'major';
my $tpatch = shift || 0;
my $transp = shift || 3;    # up a 3rd
my $invert = shift || 'E4'; # 3rd of the scale

my $inv = Music::Note->new($invert, 'ISO')->format('midinum');

my $octave  = 1;
my $channel = 0;
my @original; # the initial note phrases

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

$score->synch(
    \&top,
    \&chords,
);

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

sub top {
    set_chan_patch($score, $channel++, $tpatch);

    my @pitches = (
        get_scale_MIDI($note, $octave + 1, $tscale),
        get_scale_MIDI($note, $octave + 2, $tscale)
    );

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

    my $quarter = 'qn';
    my $minimum = 4;  # number of voices per phrase
    my $maximum = 10; # "

    for my $i (1 .. $max) {
        my $n = $minimum + int(rand($maximum + 1 - $minimum));
        push @original, [ map { $voice->rand } 1 .. $n ];
    }
    #print ddc(\@original);

    my @motifs = _collect_motifs(\@original);

    _apply($score, \@motifs, \@original);

    my @reversed = map { [ reverse @$_ ] } @original;
    _apply($score, \@motifs, \@reversed);

    my $mdt = Music::MelodicDevice::Transposition->new(scale_name => $tscale);
    my @transposed = map { $mdt->transpose($transp, $_) } @original;
    _apply($score, \@motifs, \@transposed);

    my $mdi = Music::MelodicDevice::Inversion->new(scale_name => $tscale);
    my @inverted = map { $mdi->invert($inv, $_) } @original;
    _apply($score, \@motifs, \@inverted);
}

sub _collect_motifs {
    my ($notes) = @_;

    my @motifs;

    my $mdp = Music::Duration::Partition->new(
        size => 4, # one measure in 4/4
        pool => [qw(qn en sn)],
    );

    for my $phrase (@$notes) {
        my $motif;
        my $limit = 100;
        my $size = 0;
        my $found = 0;
        my $i = 0;

        while (!$found) {
            $i++;
            $motif = $mdp->motif;
            $size = @$motif;
            #warn __PACKAGE__,' L',__LINE__,' ',,"$i. $size == ",scalar(@$phrase),"\n";
            if ($size == @$phrase) {
                $found = 1;
                last;
            }
            last if $i > $limit;
        }
        die "Can't find a motif of $size\n" unless $found;
        push @motifs, $motif;
    }
    print ddc(\@motifs);

    return @motifs;
}

sub _apply {
    my ($score, $durations, $phrases) = @_;
    print ddc($phrases);
    my $i = 0;
    for my $phrase (@$phrases) {
        for my $n (0 .. $#$phrase) {
            $score->n($durations->[$i][$n], $phrase->[$n]);
        }
        $i++;
    }
}

sub chords {
    my $cn = Music::Chord::Note->new;
    for my $i (1 .. 4) {
        for my $phrase (@original) {
            my $note = Music::Note->new($phrase->[0], 'midinum');
            my @chord = $cn->chord_with_octave($note->format('isobase'), 5);
            $score->n('wn', midi_format(@chord));
        }
    }
}