astrophysics

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

use lib '/Users/gene/sandbox/MIDI-Util/lib';
use MIDI::Util qw(setup_score set_chan_patch);
use Music::Scales;
use Music::Voss qw/ powers /;

my $max = shift || 16;
my $bpm = shift || 100;

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

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,
);

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

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

    my ( $scale, $genf ) = get_genf( 'A', 5, 'minor' );

    my @sections = ();

    for my $i ( 0 .. 3 ) {
        my @section = map { $scale->[ $genf->($_) % @$scale ] } 0 .. 3;
        push @sections, \@section;
    }

    for ( 0 .. 1 ) {
        for my $section (
            $sections[0], $sections[0], # A
            $sections[1], $sections[1], # B
            $sections[0], $sections[0], # A
            $sections[2], $sections[2], # C
            $sections[3], $sections[3], # D
            $sections[1], $sections[1], # B
            $sections[0], $sections[0], # A
            $sections[2], $sections[2], # C
        ) {
            for my $n ( @$section ) {
                $score->n( $half, $n );
            }
        }
    }
}

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 bottom {
    set_chan_patch( $score, 1, $bottom_patch );

    my %equiv = (
        i   => 'A',
        ii  => 'B',
        III => 'C',
        iv  => 'D',
        v   => 'E',
        VI  => 'F',
        VII => 'G',
    );

    my @phrases = ();

    while ( my $line = readline(DATA) ) {
        chomp $line;

        my $section = [];

        for my $item ( split /\s+/, $line ) {
            push @$section, $equiv{$item} . 3;
        }

        push @phrases, $section;
    }

    for my $i ( 1 .. $max ) {
        for my $n ( @{ $phrases[ int rand @phrases ] } ) {
            $score->n( $whole, $n );
        }
    }
}

# Data taken from the most common Bach corale basslines
__DATA__
III III III III
III ii i iv
VI VI v iv
VII VII III III
VII i i VII
VII i i v
VII iv v VI
i ii III i
i v VI III
iv III iv v
iv v VI VII
iv v v i
iv v v v
v i ii III
v v i i
v v iv III
v v v i