File Coverage

blib/lib/MIDI/Util.pm

Criterion	Covered	Total	%
statement	127	155	81.9
branch	38	58	65.5
condition	2	17	11.7
subroutine	21	24	87.5
pod	14	14	100.0
total	202	268	75.3

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

# ABSTRACT: MIDI and music utilities

our $VERSION = '0.1307';

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

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


sub scale_names {
    return [qw(
        ionian major
        hypolydian
        dorian
        hypomyxolydian
        phrygian
        hypoaeolian
        lydian
        hypolocrian
        mixolydian
        hypoionian
        aeolian minor m
        hypodorian
        locrian
        hypophrygian
        harmonicminor hm
        melodicminor mm
        blues
        pentatonic pmaj
        chromatic
        diminished
        wholetone
        augmented
        hungarianminor
        3semitone
        4semitone
        neapolitanminor nmin
        neapolitanmajor nmaj
        todi
        marva
        persian
        oriental
        romanian
        pelog
        iwato
        hirajoshi
        egyptian
        pminor pentatonicminor
    )];
}

1;

__END__