Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
119 lines (95 sloc) 3.28 KB
#!/usr/bin/env perl
use strict;
use warnings;
# Write-up:
# http://techn.ology.net/musical-random-walks-over-weighted-graphs
use Graph::Weighted;
use List::Util::WeightedChoice qw( choose_weighted );
use MIDI::Simple;
use MIDIUtil;
my $n = shift || 4; # Number of notes
my $initial = shift // 0; # Initial graph node
# Treble notes
my $treble = Graph::Weighted->new();
$treble->populate(
{
0 => { label => 'C5', 2 => 0.4, 6 => 0.6 },
1 => { label => 'D5', 3 => 0.4, 4 => 0.6 },
2 => { label => 'Ds5', 1 => 0.5, 3 => 0.5 },
3 => { label => 'F5', 5 => 0.4, 4 => 0.6 },
4 => { label => 'G5', 2 => 0.4, 3 => 0.6 },
5 => { label => 'Gs5', 4 => 0.4, 6 => 0.6 },
6 => { label => 'As5', 0 => 0.4, 3 => 0.6 },
}
);
# Bass notes
my $bass = Graph::Weighted->new();
$bass->populate(
{
0 => { label => 'C3', 2 => 0.4, 3 => 0.6 },
1 => { label => 'Ds3', 2 => 0.5, 3 => 0.5 },
2 => { label => 'F3', 0 => 0.4, 3 => 0.6 },
3 => { label => 'G3', 4 => 0.4, 2 => 0.6 },
4 => { label => 'As3', 0 => 0.4, 1 => 0.6 },
}
);
# Note durations
my $duration = Graph::Weighted->new();
$duration->populate(
{
0 => { label => 'qn', 0 => 0.7, 1 => 0.3 },
1 => { label => 'en', 0 => 0.6, 1 => 0.4 },
}
);
# Note velocities
my $velocity = Graph::Weighted->new();
$velocity->populate(
{
0 => { label => 'mezzo', 0 => 0.7, 1 => 0.3 },
1 => { label => 'mf', 0 => 0.6, 1 => 0.4 },
}
);
# Collect the notes to play
my $notes = collect_notes( $n, $initial, $velocity, $duration, $treble, $bass );
# Invoke MIDI
my $score = MIDIUtil::setup_midi( patch => 42 );
# Add notes to the score
$score->n( @$_ ) for @$notes;
# Write out the MIDI file
$score->write_score( $0 . '.mid' );
sub next_vertex {
my ( $g, $vertex ) = @_;
my $successors = [];
# Collect the vertex successors in the format that choose_weighted understands
for my $successor ( $g->successors($vertex) ) {
push @$successors, {
vertex => $successor,
weight => $g->get_cost( [ $vertex, $successor ] ),
};
}
# Choose the next vertex based on the successor weights
my $choice = choose_weighted( $successors, sub { $_[0]->{weight} } );
return $choice->{vertex};
}
sub collect_notes {
my ( $n, $initial, $velocity, $duration, $treble, $bass ) = @_;
# Set the initial vertices to the given initial node
my ( $t_vertex, $b_vertex, $d_vertex, $v_vertex ) = ($initial) x 4;
my $notes = [];
# Collect MIDI data by randomly walking the graphs
for my $i ( 1 .. $n ) {
my $treb = $treble->get_vertex_attribute( $t_vertex, 'label' );
my $low = $bass->get_vertex_attribute( $b_vertex, 'label' );
my $dura = $duration->get_vertex_attribute( $d_vertex, 'label' );
my $velo = $velocity->get_vertex_attribute( $v_vertex, 'label' );
push @$notes, [ $velo, $dura, $treb, $low ];
# Find the next vertex for each graph
if ( $i < $n ) {
$t_vertex = next_vertex( $treble, $t_vertex );
$b_vertex = next_vertex( $bass, $b_vertex );
$d_vertex = next_vertex( $duration, $d_vertex );
$v_vertex = next_vertex( $velocity, $v_vertex );
}
}
return $notes;
}