File Coverage

blib/lib/MIDI/Util.pm

Criterion	Covered	Total	%
statement	126	154	81.8
branch	38	58	65.5
condition	2	17	11.7
subroutine	20	23	86.9
pod	13	13	100.0
total	199	265	75.0

package MIDI::Util;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: MIDI Utilities

our $VERSION = '0.1305';

use strict;
use warnings;

use File::Slurper qw(write_text);
use List::Util qw(first);
use MIDI ();
use MIDI::Simple ();
use Music::Tempo qw(bpm_to_ms);
use Exporter 'import';

our @EXPORT = qw(
    midi_dump
    reverse_dump
    midi_format
    set_chan_patch
    set_time_signature
    setup_score
    dura_size
    ticks
    timidity_conf
    play_timidity
    play_fluidsynth
    get_microseconds
    score2events
);

use constant TICKS => 96;


sub setup_score {
    my %args = (
        lead_in   => 4,
        volume    => 120,
        bpm       => 100,
        channel   => 0,
        patch     => 0,
        octave    => 4,
        signature => '4/4',
        @_,
    );

    my $score = MIDI::Simple->new_score();

    set_time_signature($score, $args{signature});

    $score->set_tempo( bpm_to_ms($args{bpm}) * 1000 );

    $score->Channel(9);
    $score->n( 'qn', 42 ) for 1 .. $args{lead_in};

    $score->Volume($args{volume});
    $score->Channel($args{channel});
    $score->Octave($args{octave});
    $score->patch_change( $args{channel}, $args{patch} );

    return $score;
}


sub set_chan_patch {
    my ( $score, $channel, $patch ) = @_;

    $channel //= 0;

    $score->patch_change( $channel, $patch )
        if defined $patch;

    $score->noop( 'c' . $channel );
}


sub midi_dump {
    my ($key) = @_;

    if ( lc $key eq 'volume' ) {
        return {
            map { $_ => $MIDI::Simple::Volume{$_} }
                sort { $MIDI::Simple::Volume{$a} <=> $MIDI::Simple::Volume{$b} }
                    keys %MIDI::Simple::Volume
        };
    }
    elsif ( lc $key eq 'length' ) {
        return {
            map { $_ => $MIDI::Simple::Length{$_} }
                sort { $MIDI::Simple::Length{$a} <=> $MIDI::Simple::Length{$b} }
                    keys %MIDI::Simple::Length
        };
    }
    elsif ( lc $key eq 'ticks' ) {
        return {
            map { $_ => $MIDI::Simple::Length{$_} * TICKS }
                sort { $MIDI::Simple::Length{$a} <=> $MIDI::Simple::Length{$b} }
                    keys %MIDI::Simple::Length
        };
    }
    elsif ( lc $key eq 'note' ) {
        return {
            map { $_ => $MIDI::Simple::Note{$_} }
                sort { $MIDI::Simple::Note{$a} <=> $MIDI::Simple::Note{$b} }
                    keys %MIDI::Simple::Note
        };
    }
    elsif ( lc $key eq 'note2number' ) {
        return {
            map { $_ => $MIDI::note2number{$_} }
                sort { $MIDI::note2number{$a} <=> $MIDI::note2number{$b} }
                    keys %MIDI::note2number
        };
    }
    elsif ( lc $key eq 'number2note' ) {
        return {
            map { $_ => $MIDI::number2note{$_} }
                sort { $a <=> $b }
                    keys %MIDI::number2note
        };
    }
    elsif ( lc $key eq 'patch2number' ) {
        return {
            map { $_ => $MIDI::patch2number{$_} }
                sort { $MIDI::patch2number{$a} <=> $MIDI::patch2number{$b} }
                    keys %MIDI::patch2number
        };
    }
    elsif ( lc $key eq 'number2patch' ) {
        return {
            map { $_ => $MIDI::number2patch{$_} }
                sort { $a <=> $b }
                    keys %MIDI::number2patch
        };
    }
    elsif ( lc $key eq 'notenum2percussion' ) {
        return {
            map { $_ => $MIDI::notenum2percussion{$_} }
                sort { $a <=> $b }
                    keys %MIDI::notenum2percussion
        };
    }
    elsif ( lc $key eq 'percussion2notenum' ) {
        return {
            map { $_ => $MIDI::percussion2notenum{$_} }
                sort { $MIDI::percussion2notenum{$a} <=> $MIDI::percussion2notenum{$b} }
                    keys %MIDI::percussion2notenum
        };
    }
    elsif ( lc $key eq 'all_events' ) {
        return \@MIDI::Event::All_events;
    }
    elsif ( lc $key eq 'midi_events' ) {
        return \@MIDI::Event::MIDI_events;
    }
    elsif ( lc $key eq 'meta_events' ) {
        return \@MIDI::Event::Meta_events;
    }
    elsif ( lc $key eq 'text_events' ) {
        return \@MIDI::Event::Text_events;
    }
    elsif ( lc $key eq 'nontext_meta_events' ) {
        return \@MIDI::Event::Nontext_meta_events;
    }
    else {
        return [];
    }
}


sub reverse_dump {
    my ($name, $precision) = @_;

    $precision //= -1;

    my %by_value;

    my $dump = midi_dump($name); # dumps an arrayref

    for my $key (keys %$dump) {
        my $val = $name eq 'length' && $precision >= 0
            ? sprintf('%.*f', $precision, $dump->{$key})
            : $dump->{$key};
        $by_value{$val} = $key;
    }

    return \%by_value;
}


sub midi_format {
    my (@notes) = @_;
    my $flag = 1;
    if ($notes[0] =~ /^(\d)$/) {
        $flag = shift @notes;
    }
    my @formatted;
    for my $note (@notes) {
        $note =~ s/C##/D/;
        $note =~ s/D##/E/;
        $note =~ s/F##/G/;
        $note =~ s/G##/A/;

        $note =~ s/Dbb/C/;
        $note =~ s/Ebb/D/;
        $note =~ s/Abb/G/;
        $note =~ s/Bbb/A/;

        $note =~ s/E#/F/;
        $note =~ s/B#/C/;

        $note =~ s/Cb/B/;
        $note =~ s/Fb/E/;

        if ($flag) {
            $note =~ s/#/s/;
            $note =~ s/b/f/;
        }

        push @formatted, $note;
    }
    return @formatted;
}


sub set_time_signature {
    my ($score, $signature) = @_;
    my ($beats, $divisions) = split /\//, $signature;
    $score->time_signature(
        $beats,
        ($divisions == 8 ? 3 : 2),
        ($divisions == 8 ? 24 : 18 ),
        8
    );
}


sub dura_size {
    my ($duration, $ppqn) = @_;
    $ppqn ||= TICKS;
    my $size = 0;
    if ($duration =~ /^d(\d+)$/) {
        $size = sprintf '%0.f', $1 / $ppqn;
    }
    else {
        $size = $MIDI::Simple::Length{$duration};
    }
    return $size;
}


sub ticks {
    my ($score) = @_;
    return ${ $score->{Tempo} };
}


sub timidity_conf {
    my ($soundfont, $config_file) = @_;
    my $config = "soundfont $soundfont\n";
    write_text($config_file, $config) if $config_file;
    return $config;
}


sub play_timidity {
    my ($score, $midi, $soundfont, $config) = @_;
    $score->write_score($midi);
    my @cmd;
    if ($soundfont) {
        $config ||= 'timidity-midi-util.cfg';
        timidity_conf($soundfont, $config);
        @cmd = ('timidity', '-c', $config, '-Od', $midi);
    }
    else {
        @cmd = ('timidity', '-Od', $midi);
    }
    system(@cmd) == 0 or die "system(@cmd) failed: $?";
}


sub play_fluidsynth {
    my ($score, $midi, $soundfont, $config) = @_;
    $score->write_score($midi);
    if (!$config && $^O eq 'darwin') {
        $config = [qw(-a coreaudio -m coremidi -i)];
    }
    elsif (!$config && $^O eq 'MSWin32') {
        $config = [];
    }
    elsif (!$config) { # linux
        $config = [qw(-a alsa -m alsa_seq -i)];
    }
    my @cmd;
    @cmd = ('fluidsynth', @$config, $soundfont, $midi);
    system(@cmd) == 0 or die "system(@cmd) failed: $?";
}


sub get_microseconds {
    my ($score) = @_;
    my $tempo = first { $_->[0] eq 'set_tempo' } @{ $score->{Score} };
    return $tempo->[2] / ${ $score->{Tempo} };
}


sub score2events {
    my ($score) = @_;
    return MIDI::Score::score_r_to_events_r($score->{Score});
}

1;

__END__