File Coverage

blib/lib/MIDI/Tab.pm

Criterion	Covered	Total	%
statement	107	109	98.1
branch	30	38	78.9
condition	5	9	55.5
subroutine	13	13	100.0
pod	3	3	100.0
total	158	172	91.8

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

# ABSTRACT: Generate MIDI from ASCII tablature

use strict;
use warnings;

use MIDI::Simple qw(is_absolute_note_spec);

our $VERSION = '0.0402';

use base 'Exporter';
our @ISA    = qw(Exporter);
our @EXPORT = qw(
    from_guitar_tab
    from_drum_tab
    from_piano_tab
);

use constant CONTROL => 'CTL';


# TODO Make a mutator method for this list.
# TODO Don't require an made-up "line name" - just use the patch number.
our %drum_notes = (
    ABD => 'n35',  # Acoustic Bass Drum
    BD  => 'n36',  # Bass Drum 1
    CA  => 'n69',  # Cabasa
    CB  => 'n56',  # Cowbell
    CC  => 'n52',  # Chinese Cymbal
    CL  => 'n75',  # Claves
    CY2 => 'n57',  # Crash Cymbal 2
    CYM => 'n49',  # Crash Cymbal 1
    CYS => 'n55',  # Splash Cymbal
    ESD => 'n40',  # Electric Snare
    HA  => 'n67',  # High Agogo
    HB  => 'n60',  # Hi Bongo
    HC  => 'n39',  # Hand Clap
    HFT => 'n43',  # High Floor Tom
    HH  => 'n42',  # Closed Hi-Hat
    HMT => 'n48',  # Hi-Mid Tom
    HT  => 'n50',  # High Tom
    HTI => 'n65',  # High Timbale
    HWB => 'n76',  # Hi Wood Block
    LA  => 'n68',  # Low Agogo
    LB  => 'n61',  # Low Bongo
    LC  => 'n64',  # Low Conga
    LFT => 'n41',  # Low Floor Tom
    LG  => 'n74',  # Long Guiro
    LMT => 'n47',  # Low-Mid Tom
    LT  => 'n45',  # Low Tom
    LTI => 'n66',  # Low Timbale
    LW  => 'n72',  # Long Whistle
    LWB => 'n77',  # Low Wood Block
    MA  => 'n70',  # Maracas
    MC  => 'n78',  # Mute Cuica
    MHC => 'n62',  # Mute Hi Conga
    MT  => 'n80',  # Mute Triangle
    OC  => 'n79',  # Open Cuica
    OHC => 'n63',  # Open Hi Conga
    OHH => 'n46',  # Open Hi-Hat
    OT  => 'n81',  # Open Triangle
    PH  => 'n44',  # Pedal Hi-Hat
    RB  => 'n53',  # Ride Bell
    RI2 => 'n59',  # Ride Cymbal 2
    RID => 'n51',  # Ride Cymbal 1
    SD  => 'n38',  # Acoustic Snare
    SG  => 'n73',  # Short Guiro
    SS  => 'n37',  # Side Stick
    SW  => 'n71',  # Short Whistle
    TAM => 'n54',  # Tambourine
    VS  => 'n58',  # Vibraslap
);


sub from_guitar_tab {
    my ($score, $tab, @noop) = @_;

    # TODO Set $patch = 24 unless another is provided.

    # Add the no-ops to the score.
    $score->noop(@noop);

    # Grab the tab lines.
    my %lines = _parse_tab($tab);

    # Create routines for each line.
    my @subs;
    for my $line (keys %lines) {
        my ($base_note_number) = is_absolute_note_spec($line);
        die "Invalid base type: $line"
            unless $base_note_number || $line eq CONTROL();

        my $_sub = sub {
            my $score = shift;

            # Split tab lines into notes and control.
            my @notes = ();
            @notes = _split_lines(\%lines, $line, $base_note_number)
                unless $line eq CONTROL();

            # Collect the noop controls.
            my @control = ();
            @control = _split_lines(\%lines, CONTROL())
                if exists $lines{CONTROL()};

            # Keep track of the beat.
            my $i = 0;

            # Add each note, rest and control noop to the score.
            for my $n (@notes) {
                # Set the note noop.
                my @ctl = @noop;
                @ctl = ($control[$i]) if @control;

                # Add to the score.
                if (defined $n) {
                    $score->n($n, @ctl);
                }
                else {
                    $score->r(@ctl);
                }

                # Increment the note we are inspecting.
                $i++;
            }
        };

        # Collect the performace subroutines.
        push @subs, $_sub;
    }

    # XXX This line looks suspiciously unnecessary. Hmmmmm
    # Add the part to the score.
    $score->synch(@subs);
}


sub from_drum_tab {
    my ($score, $tab, @noop) = @_;

    # Set the drum channel if none has been provided.
    my $channel = 'c9';
    for (@noop) {
        if (/^(c\d+)$/) {
            $channel = $1;
            unshift @noop, $channel;
        }
    }

    # Add the no-ops to the score.
    $score->noop(@noop);

    # Grab the tab lines.
    my %lines = _parse_tab($tab, 'drum');

    # Create routines for each line.
    my @subs;
    for my $line (keys %lines) {
        my $_sub = sub {
            my $score = shift;

            die "Invalid drum type: $line"
                unless $drum_notes{$line} || $line eq CONTROL();
            my $drum = $drum_notes{$line};

            # Split tab lines into notes and control.
            my @notes = ();
            @notes = _split_lines(\%lines, $line)
                unless $line eq CONTROL();

            # Collect the noop controls.
            my @control = ();
            @control = _split_lines(\%lines, CONTROL())
                if exists $lines{CONTROL()};

            # Keep track of the beat.
            my $i = 0;

            # Add each note, rest and control noop to the score.
            for my $n (@notes) {
                # Set the note noop.
                my @ctl = @noop;
                @ctl = ($control[$i]) if @control;

                # Add to the score.
                if (defined $n) {
                    $score->n($channel, $drum, $n, @ctl);
                }
                else {
                    $score->r(@ctl);
                }

                # Increment the note we are inspecting.
                $i++;
            }
        };

        # Collect the performace subroutines.
        push @subs, $_sub;
    }

    # XXX This line looks suspiciously unnecessary. Hmmmmm
    # Add the part to the score.
    $score->synch(@subs);
}


sub from_piano_tab {
    my ($score, $tab, @noop) = @_;

    # Add the no-ops to the score.
    $score->noop(@noop);

    # Grab the tab lines.
    my %lines = _parse_tab($tab);

    # Create routines for each line.
    my @subs;
    for my $line (keys %lines) {
        my $_sub = sub {
            my $score = shift;
            #die "Invalid note: $line" unless ???;

            # Split tab lines into notes and control.
            my @notes = ();
            @notes = _split_lines(\%lines, $line);

            # Collect the noop controls.
            my @control = ();
            @control = _split_lines(\%lines, CONTROL())
                if exists $lines{CONTROL()};

            # Keep track of the beat.
            my $i = 0;

            # Add each note, rest and control noop to the score.
            for my $n (@notes) {
                # Set the note noop.
                my @ctl = @noop;
                @ctl = ($control[$i]) if @control;

                # Add to the score.
                if (defined $n) {
                    $score->n($line, $n, @ctl);
                }
                else {
                    $score->r(@ctl);
                }

                # Increment the note we are inspecting.
                $i++;
            }
        };

        # Collect the performace subroutines.
        push @subs, $_sub;
    }

    # XXX This line looks suspiciously unnecessary. Hmmmmm
    # Add the part to the score.
    $score->synch(@subs);
}

sub _parse_tab {
    my($tab, $type) = @_;

    # Remove bar lines.
    $tab =~ s/\|//g;

    # Set a regular expression to capture parts of the tab.
    my $re = qr/^\s*([A-Za-z0-9]+)\:\s*([0-9+-]+)\s+(.*)$/s;
    $re = qr/^\s*([A-Z]{2,3})\:\s*([0-9+-]+)\s+(.*)$/s
        if $type && $type eq 'drum';

    # Build lines from the tablature.
    my %lines;
    while($tab =~ /$re/g) {
        my ($note, $line, $remainder) = ($1, $2, $3);
        $lines{$note} = $line;
        $tab = $remainder;
    }

    return %lines;
}

sub _split_lines {
    my($lines, $line, $base) = @_;

    # Construct a list of notes, volumes or noop controls.
    my @items = ();

    for my $n (split '', $lines->{$line}) {
        # Grab the control noop.
        if ($line eq CONTROL()) {
            if ($n eq '3') {
                push @items, 'ten';
            }
            else {
                push @items, undef;
            }
        }
        # Grab the note, itself.
        elsif ($n =~ /^[0-9]$/) {
            if ($base) {
                push @items, 'n' . ($base + $n);
            }
            else {
                # XXX This x12 bit looks suspiciously wrong.
                push @items, 'V' . ($n * 12);
            }
        }
        else {
            push @items, undef;
        }
    }

    return @items;
}

1;

__END__