File Coverage

blib/lib/Music/PitchNum.pm

Criterion	Covered	Total	%
statement	55	57	96.4
branch	32	34	94.1
condition	25	29	86.2
subroutine	7	7	100.0
pod	2	2	100.0
total	121	129	93.8

# -*- Perl -*-
#
# Musical note name and pitch number utility roles, mostly motivated by not
# wanting to drag in my huge and crufty Music::LilyPondUtil module just to
# figure out what pitch number fis'' is, and providing for such as a Role. Also
# an excuse for me to learn more about Roles as part of a Moo rewrite of
# various modules.
#
# Run perldoc(1) on this file for additional documentation.

package Music::PitchNum;

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

our $VERSION = '0.06';

# for pitchnum (TODO make these attributes or otherwise f(x) calls?)
my %NOTE2NUM = (
  C => 0,
  D => 2,
  E => 4,
  F => 5,
  G => 7,
  A => 9,
  B => 11,
);
# ASPN-style note-fu for pitchname
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 ) = @_;
  die "need a number for pitchname\n" if !looks_like_number $number;

  return $NUM2NOTE{ $number % 12 } . ( floor( $number / 12 ) - 1 );
}

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

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

  my ( $octave, $note, $chrome );
SIRLEXALOT: {
    last SIRLEXALOT
      if $name =~ m/\G \z /cgx
      or ( defined $octave and defined $note and defined $chrome );

    # Leading ,C as allowed by Helmholtz
    if ( !defined $octave and $name =~ m/ \G ( [,]{1,10} ) /cgx ) {
      $octave = $1;
      redo SIRLEXALOT;
    }

    # Simple note name support; insensitive, so supporting ABC notation not
    # possible here; see ::German for H support, as this just matches A through
    # G, and does not match solfege or the like.
    if ( !defined $note
      and $name =~
      m/ \G (?: (?[A-G])(?\k{1,10}) | (?[A-Ga-g])) /cgx ) {
      $note = $NOTE2NUM{ uc $+{note} };
      # Optional "English multiple C notation" where C, is written CC (only for
      # upper case as need to sometimes match "f" as "flat" as an accidental).
      if ( defined $+{multi} and !defined $octave ) {
        $octave = (',') x length $+{multi};
      }
      redo SIRLEXALOT;
    }

    if ( defined $note
      and !defined $octave ) {

      if ( $name =~ m/ \G ( [+-]?[0-9]{1,2} ) /cgx ) {
        # ASPN octave number (hard: C4 is in no way relative to anything)
        $octave = $1;
        redo SIRLEXALOT;
      }
      if ( $name =~ m/ \G ( [,']{1,10} ) /cgx ) {
        # Post-note a''' or b,, octave indications (soft; might be relative
        # to something).
        $octave = $1;
        redo SIRLEXALOT;
      }
    }

    # Accidental (NOTE there is no microtonal support, e.g. lilypond beh);
    # flat, sharp, doubleflat, doublesharp in various forms, mostly taken from
    # MIDI::Simple and the "Note names in other languages" section of the
    # lilypond notation documentation.
    if ( defined $note and !defined $chrome ) {
      my @howmany;
      if ( @howmany = $name =~ m/ \G (ess|es|flat|[bf]) /cgx ) {
        $chrome = -1 * @howmany;
        redo SIRLEXALOT;
      } elsif ( @howmany = $name =~ m/ \G (iss|is|sharp|[#dks]) /cgx ) {
        $chrome = @howmany;
        redo SIRLEXALOT;
      }
    }

    # nothing matched; nom something and try again at new position
    if ( $name =~ m/ \G (?: \s+ | . ) /cgsx ) {
      redo SIRLEXALOT;
    }
  }
  return if !defined $note;

  my $pitchnum;

  if ( defined $octave and looks_like_number $octave ) {
    # "hard" octave
    $pitchnum = int( 12 * $octave + 12 + $note );

  } else {
    # calculate the "hard" octave given the context...

    $octave //= '';    # equivalent to C3 under ASPN, if not relative
    my $sign = ( $octave =~ m/,/ ) ? -1 : 1;
    $octave = int( $sign * length $octave );

    # TODO support $relative as additional argument, but that's extra
    # complication (and too much work for just getting the module out the
    # door), as then must deal with which direction the tritone goes (see
    # Music::LilyPondUtil).
    #if ( defined $relative ) {
    #  ...
    $pitchnum = int( 12 * $octave + 48 + $note );
  }

  $pitchnum += $chrome if defined $chrome;

  return $pitchnum;
}

1;
__END__