File Coverage

blib/lib/Music/PitchNum/ABC.pm

Criterion	Covered	Total	%
statement	37	37	100.0
branch	22	24	91.6
condition	2	2	100.0
subroutine	7	7	100.0
pod	2	2	100.0
total	70	72	97.2

# -*- Perl -*-
#
# Pitch numbers from the ABC notation for notes, in a distinct module as
# the format is Case Sensitive, and the accidentals very different from
# those seen in other notation formats.
#
# Run perldoc(1) on this file for additional documentation.

package Music::PitchNum::ABC;

use 5.010000;
use Moo::Role;
use POSIX qw/floor/;
use Scalar::Util qw/looks_like_number/;

our $VERSION = '0.09';

my %NOTE2NUM = (
  C => 0,
  D => 2,
  E => 4,
  F => 5,
  G => 7,
  A => 9,
  B => 11,
);

# ABC is like ASPN only for some N+1 reason it uses a different
# accidental form, sigh
my %NUM2NOTE = (
  0  => 'C',
  1  => '^C',
  2  => 'D',
  3  => '^D',
  4  => 'E',
  5  => 'F',
  6  => '^F',
  7  => 'G',
  8  => '^G',
  9  => 'A',
  10 => '^A',
  11 => 'B',
);

##############################################################################
#
# METHODS

sub pitchname {
  my ( $self, $number, %params ) = @_;
  die "need a number for pitchname\n" if !looks_like_number $number;

  $params{ignore_octave} //= 0;

  my $note = $NUM2NOTE{ $number % 12 };

  if ( !$params{ignore_octave} ) {
    my $octave = floor( $number / 12 ) - 1;
    $note = lc $note if $octave > 4;
    $note .= (q{'}) x ( $octave - 5 ) if $octave > 5;
    $note .= (q{,}) x ( 4 - $octave ) if $octave < 4;
  }

  return $note;
}

sub pitchnum {
  my ( $self, $name ) = @_;

  # already a pitch number, but nix the decimal foo
  return int $name if looks_like_number $name;

  my $pitchnum;

  if ( $name =~
    m/ (? (?: [_]{1,2} | [\^]{1,2} ) )? (?: (?[A-G])(?[,]+)? | (?[a-g])(?[']+)? ) /x
    ) {
    my $octave = $+{octave};
    my $chrome = $+{chrome};
    my $note   = $+{note};

    $pitchnum = $NOTE2NUM{ uc $note } + 12 * ( $note =~ m/[A-G]/ ? 5 : 6 );

    if ( defined $octave ) {
      $pitchnum += 12 * length($octave) * ( $octave =~ m/[,]/ ? -1 : 1 );
    }

    if ( defined $chrome ) {
      $pitchnum += length($chrome) * ( $chrome =~ m/[_]/ ? -1 : 1 );
    }
  }

  return $pitchnum;
}

1;
__END__