gravity-well

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

# Prefer my local libraries

use MIDI::Util qw(setup_score set_chan_patch);
use MIDI::Drummer::Tiny;
use Music::Cadence;
use Music::Scales;
use Music::Voss qw/ powers /;

my $max   = shift || 16;
my $note  = shift || 'C';
my $bpm   = shift || 100;
my $leads = shift || '2 7';

my $top_scale    = 'minor';
my $bottom_scale = 'pminor';

my $top_patch    = 0;
my $bottom_patch = 42;

my $bottom_notes = [];

my $eighth  = 'en';
my $quarter = 'qn';
my $half    = 'hn';
my $whole   = 'wn';

my $score = setup_score( lead_in => 0, bpm => $bpm );

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

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

sub top {
    set_chan_patch( $score, 0, $top_patch );

    my ( $scale, $genf ) = get_genf( $note, 5, $top_scale );

    my @leaders = split /\s+/, $leads;

    my $mc = Music::Cadence->new(
        key    => $note,
        scale  => $top_scale,
        octave => 4,
        format => 'midi',
    );

    my $i = 0; # Cadence alternation
    my $j = 0; # Imperfect variation/inversion

    for my $n ( 1 .. $max ) {
        if ( $i % 2 == 0 ) {
            $score->n( $eighth, $scale->[ $genf->($n) ] ) for 1 .. 2;
            $score->n( $quarter, $scale->[ $genf->($n) ] );
        }
        else {
            $score->n( $quarter, $scale->[ $genf->($n) ] ) for 1 .. 2;
        }

        # Add a cadence after every 4th iteration
        if ( $n % 4 == 0 ) {
            my $chords;

            if ( $i % 2 == 0 ) {
                $chords = $mc->cadence(
                    type    => 'half',
                    leading => $leaders[ int rand @leaders ],
                );
            }
            else {
                $chords = $mc->cadence(
                    type => 'imperfect',
                    $j % 2 == 0
                        ? ( variation => 2 )
                        : ( inversion => { 1 => 1, 2 => 1 } ),
                );

                $j++;
            }

            ( $i, $bottom_notes ) = truncate_start( $bottom_notes, $chords, $score, $half, $i );
        }
    }

    my $chords = $mc->cadence(
        type      => 'deceptive',
        variation => int( rand 2 ) + 1,
    );

    ( $i, $bottom_notes ) = truncate_start( $bottom_notes, $chords, $score, $half );

    $chords = $mc->cadence( type => 'plagal' );

    ( $i, $bottom_notes ) = truncate_start( $bottom_notes, $chords, $score, $half );
}

sub bottom {
    set_chan_patch( $score, 1, $bottom_patch );

    s/4/3/ for @$bottom_notes;

    my ( $scale, $genf ) = get_genf( $note, 3, $bottom_scale );

    my $i = 0;

    for my $n ( 1 .. $max ) {
        $score->n( $half, $scale->[ $genf->($n) ] );

        if ( $n % 4 == 0 ) {
            $score->n( $half, $bottom_notes->[$i] );
            $score->n( $half, $bottom_notes->[ ++$i ] );
            $i++;
        }
    }

    $score->n( $half, $bottom_notes->[$i] );
    $score->n( $half, $bottom_notes->[ ++$i ] ) for 1 .. 3;
}

sub get_genf {
    my ( $note, $octave, $type ) = @_;

    my @scale = map { $_ . $octave } get_scale_notes( $note, $type );
    # Transform to MIDI accidentals
    for ( @scale ) {
        s/#/s/;
        s/b/f/;
    }

    my $seed = [ map { sub { int rand 2 } } @scale ];
    my $genf = powers( calls => $seed );

    return \@scale, $genf;
}

sub truncate_start {
    my ( $notes, $chords, $score, $duration, $i ) = @_;

    push @$notes, $chords->[0][0], $chords->[1][0];

    # Remove the first note of each chord
    shift @$_ for @$chords;

    $score->n( $duration, @$_ ) for @$chords;

    $i++;

    return $i, $notes;
}

sub drums {
    my $d = MIDI::Drummer::Tiny->new(
        score => $score,
        bpm   => $bpm,
    );

    for my $n ( 1 .. $max * 3 ) {
        $d->note( $d->quarter, $d->open_hh, $n % 2 ? $d->kick : $d->snare )
    }
}