File Coverage

blib/lib/Music/PitchNum.pm

Criterion	Covered	Total	%
statement	54	56	96.4
branch	34	36	94.4
condition	25	29	86.2
subroutine	7	7	100.0
pod	2	2	100.0
total	122	130	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.08';

##############################################################################
#
# ATTRIBUTES
#
# TODO this code is (sometimes) duplicated in the other modules in this
# distribution, might be nice to "extend" this one into the other roles
# and override things as necessary, but it's not clear how or whether
# that can be done in the Moo::Role docs.

# These probably should be 'ro' but there could be cases where someone
# wants to set their own note names, so...
has NOTE2NUM => (
  is      => 'rw',
  default => sub {
    { C => 0,
      D => 2,
      E => 4,
      F => 5,
      G => 7,
      A => 9,
      B => 11,
    };
  },
);

has NUM2NOTE => (
  is => 'rw',
  # ASPN-style by default
  default => sub {
    { 0  => 'C',
      1  => 'C#',
      2  => 'D',
      3  => 'D#',
      4  => 'E',
      5  => 'F',
      6  => 'F#',
      7  => 'G',
      8  => 'G#',
      9  => 'A',
      10 => 'A#',
      11 => 'B',
    };
  },
);

# Option to omit the octave info, for when you need just a plain "C#"
# from pitchname and not "C#4" or worse "C#-1" if you're dealing with
# integers in the 0..11 range.
#
# TODO this probably should be a "Bool" type
has ignore_octave => (
  is     => 'rw',
  coerce => sub {
    $_[0] ? 1 : 0;
  },
  default => 0,
);

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

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

  return $self->NUM2NOTE->{ $number % 12 }
    . ( $self->ignore_octave ? '' : ( 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 = $self->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__