Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
392 lines (275 sloc) 8.35 KB
#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use Graph::Weighted;
use List::Util::WeightedChoice qw( choose_weighted );
use Math::Partition::Rand;
use MIDI::Simple;
use MIDI::Simple::Drummer;
use Music::Tempo;
my %opts = (
phrases => 4,
bpm => 100,
volume => 120,
notes => 8,
treble => 'C5 D5 Ds5 F5 G5 Gs5 As5 r',
treble_velocity => 'mezzo mf',
treble_duration => 'qn en',
treble_channel => 0,
treble_patch => 2,
bass => 'C3 Ds3 F3 G3 As3',
bass_velocity => 'mezzo mf f',
bass_duration => 'dqn qn',
bass_channel => 1,
bass_patch => 2,
filename => "$0.mid",
drummer => 0,
selfreference => 0,
resolve => 0,
);
GetOptions( \%opts,
'help|?',
'man',
'phrases=i',
'bpm=i',
'volume=i',
'notes=i',
'treble=s',
'treble_velocity=s',
'treble_duration=s',
'treble_channel=i',
'treble_patch=i',
'bass=s',
'bass_velocity=s',
'bass_duration=s',
'bass_channel=i',
'bass_patch=i',
'filename=s',
'drummer',
'selfreference',
'resolve',
) or pod2usage(2);
pod2usage(1)
if $opts{help};
pod2usage( -exitval => 0, -verbose => 2 )
if $opts{man};
$opts{treble} = [ split /(?:\s+|\s*,\s*)/, $opts{treble} ];
$opts{treble_velocity} = [ split /(?:\s+|\s*,\s*)/, $opts{treble_velocity} ];
$opts{treble_duration} = [ split /(?:\s+|\s*,\s*)/, $opts{treble_duration} ];
$opts{bass} = [ split /(?:\s+|\s*,\s*)/, $opts{bass} ];
$opts{bass_velocity} = [ split /(?:\s+|\s*,\s*)/, $opts{bass_velocity} ];
$opts{bass_duration} = [ split /(?:\s+|\s*,\s*)/, $opts{bass_duration} ];
my $score = MIDI::Simple->new_score();
$score->set_tempo( bpm_to_ms($opts{bpm}) * 1000 );
my @parts = ( \&bassline, \&melody );
push @parts, \&drummer
if $opts{drummer};
$score->synch(@parts)
for 1 .. $opts{phrases};
$score->n( "c$opts{bass_channel}", 'wn', $opts{bass}->[0] )
if $opts{resolve};
$score->write_score($opts{filename});
sub melody {
my $self = shift;
phrase(
score => $self,
channel => $opts{treble_channel},
patch => $opts{treble_patch},
note_list => $opts{treble},
velo_list => $opts{treble_velocity},
dura_list => $opts{treble_duration},
);
}
sub bassline {
my $self = shift;
phrase(
score => $self,
channel => $opts{bass_channel},
patch => $opts{bass_patch},
note_list => $opts{bass},
velo_list => $opts{bass_velocity},
dura_list => $opts{bass_duration},
);
}
sub phrase {
my %params = @_;
$params{score}->patch_change( $params{channel}, $params{patch} );
$params{score}->noop( 'c' . $params{channel} );
my $pitch = Graph::Weighted->new();
$pitch->populate( random_graph($params{note_list}) );
my $velocity = Graph::Weighted->new();
$velocity->populate( random_graph($params{velo_list}) );
my $duration = Graph::Weighted->new();
$duration->populate( random_graph($params{dura_list}) );
my @phrase = collect_notes( $pitch, $velocity, $duration );
my $timing = 0;
for my $event ( @phrase ) {
my $duration = $event->[0];
$timing += $MIDI::Simple::Length{$duration};
last if $timing > $MIDI::Simple::Length{wn};
if ( $event->[2] eq 'r' ) {
$params{score}->r($duration);
}
else {
$params{score}->n( @$event );
}
}
}
sub drummer {
my $d = MIDI::Simple::Drummer->new(
-bpm => $opts{bpm},
-volume => $opts{volume},
-score => $score,
);
for my $beat ( 1 .. $d->beats ) {
$d->note( $d->EIGHTH, $d->backbeat_rhythm( -beat => $beat ) );
if ( $beat == 3 ) {
$d->note( $d->EIGHTH, $d->kick );
}
else {
$d->rest( $d->EIGHTH );
}
}
}
sub collect_notes {
my ( $pitch, $velocity, $duration ) = @_;
my $n = $opts{notes};
my @vs = $pitch->vertices;
my $p_vertex = $vs[ int( rand $pitch->vertices ) ];
@vs = $velocity->vertices;
my $v_vertex = $vs[ int( rand $velocity->vertices ) ];
@vs = $duration->vertices;
my $d_vertex = $vs[ int( rand $duration->vertices ) ];
my $notes = [];
for my $i ( 1 .. $n ) {
my $p = $pitch->get_vertex_attribute( $p_vertex, 'label' );
my $v = $velocity->get_vertex_attribute( $v_vertex, 'label' );
my $d = $duration->get_vertex_attribute( $d_vertex, 'label' );
push @$notes, [ $d, $v, $p ];
if ( $i < $n ) {
$p_vertex = next_vertex( $pitch, $p_vertex );
$v_vertex = next_vertex( $velocity, $v_vertex );
$d_vertex = next_vertex( $duration, $d_vertex );
}
}
return @$notes;
}
sub next_vertex {
my ( $graph, $vertex ) = @_;
my $successors = [];
for my $successor ( $graph->successors($vertex) ) {
push @$successors, {
vertex => $successor,
weight => $graph->get_cost( [ $vertex, $successor ] ),
};
}
my $choice = choose_weighted( $successors, sub { $_[0]->{weight} } );
return $choice->{vertex};
}
sub random_graph {
my $labels = shift;
my $graph = {};
for my $label ( @$labels ) {
$graph->{$label} = { label => $label, choose_n( $labels, $label ) };
}
return $graph;
}
sub choose_n {
my $labels = shift;
my $x = shift;
my $n = @$labels;
my %seen;
if ( !$opts{selfreference} && defined $x && $n > 1 ) {
$n--;
$seen{$x}++;
}
my @labels = map { get_label( $labels, \%seen ) } 1 .. $n;
my %distribution;
my $partition = Math::Partition::Rand->new( top => 1, n => $n );
@distribution{@labels} = @{ $partition->choose() };
return %distribution;
}
sub get_label {
my ( $labels, $seen ) = @_;
my $label = $labels->[ int( rand @$labels ) ];
if ( exists $seen->{$label} ) {
while ( exists $seen->{$label} ) {
$label = $labels->[ int( rand @$labels ) ];
}
}
$seen->{$label} = 1;
return $label;
}
__END__
=head1 NAME
synch-weighted-randomized - Generate phrases of MIDI music by random weighted graphs
=head1 SYNOPSIS
$ perl synch-weighted-randomized [--options]
=head1 OPTIONS
=over 4
=item B<help>
Print a brief help message and exit.
=item B<man>
Print the full manual page and exit.
=item B<phrases>
Number of groups of 4 quarter notes
Default: 4
=item B<bpm>
Beats per minute
Default: 100
=item B<volume>
Default: 120
=item B<notes>
The number of notes to collect before building a phrase.
Default: 8
=item B<treble>
A string of space or comma separated notes that L<MIDI::Simple> understands.
Also, the B<r> symbol can be included to indicate a rest.
Default: 'C5 D5 Ds5 F5 G5 Gs5 As5 r'
=item B<treble_velocity>
A string of velocities
Default: 'mezzo mf'
=item B<treble_duration>
A string of durations
Default: 'qn en'
=item B<treble_channel>
Default: 0
=item B<treble_patch>
Default: 2
=item B<bass>
A string of notes
Default: 'C3 Ds3 F3 G3 As3'
=item B<bass_velocity>
A string of velocities
Default: 'mezzo mf f'
=item B<bass_duration>
A string of durations
Default: 'dqn qn en'
=item B<bass_channel>
Default: 1
=item B<bass_patch>
Default: 2
=item B<filename>
Default: synch-weighted-randomized.mid
=item B<drummer>
Default: Off
=item B<selfreference>
Include transitions from and to the same note (i.e. "Loops").
Default: Off
=item B<resolve>
Play a whole note bar with the first notes in the B<treble> and B<bass> lists, after the generated phrases.
Default: Off
=back
=head1 DESCRIPTION
Generate phrases of MIDI music by means of random weighted graphs.
=head1 EXAMPLES
$ perl synch-weighted-randomized
$ perl synch-weighted-randomized --bass='C3 F3 G3' --selfreference
$ perl synch-weighted-randomized --bass='C3 F3 G3' --selfreference --drummer --phrases=8
$ perl synch-weighted-randomized --treble='C5 D5 E5 F5 G5 A5 B5 C6' --bass='C3 F3 G3 C3' --bass_duration='qn'
$ perl synch-weighted-randomized --treble='C5 Ds5 F5 G5 As5' --treble_duration='tqn' --bass='C3 F3 G3' --bass_duration='wn' --notes=4
$ perl synch-weighted-randomized --treble='C5 Cs5 D5 Ds5 E5 F5 Fs5 G5 Gs5 A5 As5 B5' --bass='C3 F3 G3' --bpm=800
$ timidity synch-weighted-randomized.mid # Or your favorite MIDI player
=cut