Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
193 lines (162 sloc) 5.62 KB
#!/usr/bin/env perl
use strict;
use warnings;
use Graph::Weighted;
use List::Util::WeightedChoice qw( choose_weighted );
use MIDI::Simple;
use Music::AtonalUtil;
use Readonly;
Readonly my $MIDDLE_C => 60;
Readonly my $RANDOM_PARAMETER => 6;
Readonly my $RANDOM_TRANSFORM => 3;
my $max = shift || 4; # Number of notes
my $initial = shift // 0; # Initial graph node. -1=random
my $transform = shift // 0; # 0=invert, 1=retrograde, 2=rotate. -1=random
my $param = shift // 0; # Used for invert & rotate, -1=random
my $repeat = shift // 0; # For reapplication of transformation
my $treble = Graph::Weighted->new();
$treble->populate(
{
0 => { label => 60, 2 => 0.4, 3 => 0.6 }, # C
1 => { label => 61, 0 => 0.4, 2 => 0.6 }, # Cs
2 => { label => 62, 3 => 0.4, 5 => 0.6 }, # D
3 => { label => 63, 5 => 0.4, 7 => 0.6 }, # Ds
4 => { label => 64, 3 => 0.4, 5 => 0.6 }, # E
5 => { label => 65, 7 => 0.4, 8 => 0.6 }, # F
6 => { label => 66, 5 => 0.4, 7 => 0.6 }, # Fs
7 => { label => 67, 8 => 0.4, 10 => 0.6 }, # G
8 => { label => 68, 10 => 0.4, 7 => 0.6 }, # Gs
9 => { label => 69, 9 => 0.4, 10 => 0.6 }, # A
10 => { label => 70, 0 => 0.4, 8 => 0.6 }, # As
11 => { label => 71, 0 => 0.4, 10 => 0.6 }, # B
}
);
my $bass = Graph::Weighted->new();
$bass->populate(
{
0 => { label => 36, 3 => 0.4, 5 => 0.6 }, # C
1 => { label => 37, 0 => 0.4, 2 => 0.6 }, # Cs
2 => { label => 38, 2 => 0.4, 3 => 0.6 }, # D
3 => { label => 39, 5 => 0.4, 7 => 0.6 }, # Ds
4 => { label => 40, 3 => 0.4, 5 => 0.6 }, # E
5 => { label => 41, 7 => 0.4, 10 => 0.6 }, # F
6 => { label => 42, 5 => 0.4, 7 => 0.6 }, # Fs
7 => { label => 43, 10 => 0.4, 5 => 0.6 }, # G
8 => { label => 44, 7 => 0.4, 9 => 0.6 }, # Gs
9 => { label => 45, 8 => 0.4, 10 => 0.6 }, # A
10 => { label => 46, 0 => 0.4, 7 => 0.6 }, # As
11 => { label => 47, 10 => 0.4, 0 => 0.6 }, # B
}
);
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 },
}
);
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 },
}
);
my $notes = collect_notes( $max, $initial, $velocity, $duration, $treble, $bass );
for ( 1 .. $repeat ) {
$notes = transform_treble( $notes, $transform, $param );
}
score_midi( notes => $notes );
sub score_midi {
my %args = (
notes => [],
lead_in => 4,
channel => 1,
patch => 42,
volume => 120,
@_,
);
my $score = MIDI::Simple->new_score();
$score->Volume($args{volume});
# Lead-in
$score->Channel(9);
$score->n( 'qn', $args{patch} ) for 1 .. $args{lead_in};
# Passage
$score->Channel($args{channel});
$score->patch_change( $args{channel}, $args{patch} );
# Add notes to the score
$score->n( @$_ ) for @{ $args{notes} };
# Write out the score
$score->write_score( $0 . '.mid' );
}
sub next_vertex {
my ( $g, $vertex ) = @_;
my $successors = [];
for my $successor ( $g->successors($vertex) ) {
push @$successors, {
vertex => $successor,
weight => $g->get_cost( [ $vertex, $successor ] ),
};
}
my $choice = choose_weighted( $successors, sub { $_[0]->{weight} } );
return $choice->{vertex};
}
sub collect_notes {
my ( $max, $initial, $velocity, $duration, $treble, $bass ) = @_;
my ( $t_vertex, $b_vertex, $d_vertex, $v_vertex );
if ( $initial == -1 ) {
$t_vertex = $treble->random_vertex;
$b_vertex = $bass->random_vertex;
$d_vertex = $duration->random_vertex;
$v_vertex = $velocity->random_vertex;
}
else {
( $t_vertex, $b_vertex, $d_vertex, $v_vertex ) = ($initial) x 4;
}
my $notes = [];
for my $i ( 1 .. $max ) {
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 ];
if ( $i < $max ) {
$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;
}
sub transform_treble {
my ( $phrase, $transform, $param ) = @_;
my $pitches = [ map { $_->[2] - $MIDDLE_C } @$phrase ];
my $mau = Music::AtonalUtil->new;
my $new;
if ( $param == -1 ) {
$param = int rand $RANDOM_PARAMETER;
}
if ( $transform == -1 ) {
$transform = int rand $RANDOM_TRANSFORM;
}
if ( $transform == 0 ) {
print "Transform: invert $param\n";
$new = $mau->invert( $param, $pitches );
}
elsif ( $transform == 1 ) {
print "Transform: retrograde\n";
$new = $mau->retrograde($pitches);
}
elsif ( $transform == 2 ) {
print "Transform: rotate $param\n";
$new = $mau->rotate( $param, $pitches );
}
my $tansformed = [
map {
[ $phrase->[$_][0], $phrase->[$_][1], $MIDDLE_C + $new->[$_], $phrase->[$_][3] ]
} 0 .. @$phrase - 1
];
$phrase = [ @$phrase, @$tansformed ];
return $phrase;
}