package Music::Note; use strict; BEGIN { use vars qw ($VERSION); $VERSION = 0.01; } =head1 NAME Note - representation of a single musical note, and various manipulation routines =head1 SYNOPSIS use Music::Note; my $note = Music::Note->new("C#4","ISO"); # 'simple' style - notename/type $note->transpose->(-16); # to A2 $note->alter(1); # to A#2 $note->en_eq('flat'); # to Bb2 print $note->format("kern"); # BB- $note = Music::Note->new({step=>'C',octave=>'4',alter=>1}); print $note->octave(); # 4 print $note->step(); # C =head1 DESCRIPTION An OO encapsulation of a single musical note. Includes methods for transposition, enharmonic equivalence, and creation/output in a range of formats. =head1 METHODS =head2 new($notename,$type) Creates a new Note object. See below for a list of types. $type defaults to "ISO" if omitted. $notename defaults to "C4". =head2 new({%params}) Creates a new Note object. Parameters are MusicXML compliant - viz. "step" (A-G), 'octave' (+/- integer) and 'alter' (+/- integer). The 'octave' parameter is based upon standard usage, where C4=Middle C and the number changes between B and C. The 'alter' parameter indicates accidentals, where '1' is sharp, '-1' is flat, '2' is double-sharp and so on. =head2 format($type) Returns the note object formatted in one of the styles named below. =head2 transpose($amount) Transposes the note by $amount semitones (+/-), keeping accidental types where possible (eg. - Ab + 2 = Bb, not A#). Returns the note object. =head2 en_eq($type) Changes the Note into an enharmonic equivalent (C#->Db, for instance). $type can be either 'sharp' (or 's'/'#') or 'flat'('f'/'b'). Double accidentals are naturalised - so 'Bbb' will become 'A' if sharpened, and 'Fx' becomes 'G' if flattened. Returns the note object. =head1 STYLES ISO (C3, D#4, Ab5) isobase (C, Ds, Af (as ISO, but no octave number) ) midi (C3, Ds4, Af5) midinum (0-127) kern (CC, d+, aa-) MusicXML (D41) pdl (c3, ds4, af5) 'xml' can be used as a synonym for 'MusicXML'. =head1 TODO more types - abc, solfa (do,re,mi,fa,so,la,ti), Indian (sa,re,ga,ma,pa,da,ni) length manipulation =head1 AUTHOR Ben Daglish (bdaglish@cpan.org) =head1 BUGS None known All feedback most welcome. =head1 COPYRIGHT Copyright (c) 2003, Ben Daglish. All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =head1 SEE ALSO perl(1). =cut my %midinotes = qw(0 C 1 CS 2 D 3 DS 4 E 5 F 6 FS 7 G 8 GS 9 A 10 AS 11 B); my %stepnums = qw(C 0 D 2 E 4 F 5 G 7 A 9 B 11); my @numsteps = qw(C C D D E F F G G A A B C C D D E F F G G A A B C C D D E F F G G A A B); sub new { my ($class) = shift(); my %self = ('step'=>'C','alter'=>0,'octave'=>4); my ($note) = shift(); if (ref($note) =~ /HASH/) { %self = (%self,%$note); } else { my $type = lc(shift() || "iso"); if ($type eq 'iso' || $type eq 'isobase' || $type eq 'midi' || $type eq 'pdl') { $note =~ /([A-Ga-g])([bn\#xfs]\b?)?([+-]?\d+)?/; $self{step} = uc($1) if $1; $self{octave} = $3 if defined $3; my $alt = $2 || ''; $alt =~ s/f(?:lat)?/b/g; $alt =~ s/s(?:harp)?/\#/g; $self{alter} = -2 if $alt eq 'bb'; $self{alter} = -1 if $alt eq 'b'; $self{alter} = 1 if $alt eq '#'; $self{alter} = 2 if ($alt eq 'x' || $alt eq '##'); } elsif ($type eq 'musicxml' || $type eq 'xml') { if ($note =~ /(.*?)<\/step>/){$self{step} = $1 if $1;} if ($note =~ /(.*?)<\/octave>/){$self{octave} = $1 if $1;} if ($note =~ /(.*?)<\/alter>/){$self{alter} = $1 if $1;} } elsif ($type eq 'midinum') { ($self{step},$self{octave},$self{alter}) = from_midinum($note); } elsif ($type eq 'kern') { $note =~ /([a-gA-G]+)([\#-]*)/; my ($step,$alt) = ($1,$2); $self{alter} = length($alt) * (($alt =~/-/) ? -1 : 1); $self{step} = uc(substr($step,0,1)); my $l = length($step) - 1; if ($step eq uc($step)) {$l = -(++$l)} $self{octave} = 4 + $l; } } bless \%self,$class; } sub step { my $self = shift(); $self->{step} = shift() if (@_ && $_[0] =~ /^[A-G]$/); $self->{step}; } sub octave { my $self = shift(); $self->{octave} = shift() if (@_ && $_[0] =~ /[+-]?\d+/); $self->{octave}; } sub alter { my $self = shift(); $self->{alter} = shift() if (@_ && $_[0] =~ /[+-]?\d+/); $self->{alter}; } sub format { my ($self,$format) = @_; $format = lc($format) || "iso"; my %isofs = (-3,'bbb',-2,'bb',-1,'b',0,'',1,'#',2,'x',3,'x#'); my %midifs = (-3,'fff',-2,'ff',-1,'f',0,'',1,'s',2,'ss',3,'sss'); my %kernfs = (-3,'---',-2,'--',-1,'-',0,'',1,'#',2,'##',3,'###'); if ($format eq 'iso') { return $self->{step}.$isofs{$self->{alter}}.$self->{octave}; } if ($format eq 'isobase') { return $self->{step}.$isofs{$self->{alter}}; } elsif ($format eq 'midi') { return $self->{step}.$midifs{$self->{alter}}.$self->{octave}; } elsif ($format eq 'pdl') { return lc($self->{step}).$midifs{$self->{alter}}.$self->{octave}; } elsif ($format eq 'midinum') { return $self->to_midinum; } elsif ($format eq 'kern') { my $s = $self->{step}; my $o = $self->{octave} - 4; if ($o >= 0) {$s = lc($s);} else {$o = -(++$o);} $s.($s x $o).$kernfs{$self->{alter}}; } elsif ($format eq 'xml' || $format eq 'musicxml') { return "$self->{step}$self->{octave}$self->{alter}"; } else {warn ("Incorrect format ($format) passed to Music::Note->format");} } sub transpose { my ($self,$amount) = @_; my $num = $self->to_midinum; my $alt = $self->{alter}; $num += int($amount); ($self->{step},$self->{octave},$self->{alter}) = from_midinum($num); if ($alt < 0 && $self->{alter}) { $self->en_eq('f'); } $self; } sub en_eq { my ($self,$type) = @_; my $stepnum = $stepnums{$self->{step}} + 12; if ($type =~ /^[s\#]/) { $self->{alter} += 2; $stepnum -= 2; $self->{step} = $numsteps[$stepnum]; $self->{octave}-- if ($stepnum < 12); } elsif ($type =~ /^[fb]/) { $self->{alter} -= 2; $stepnum += 2; $self->{step} = $numsteps[$stepnum]; $self->{octave}++ if ($stepnum > 24); } else {warn ("Incorrect type ($type) passed to Music::Note->en_hq");} } sub to_midinum { my $self = shift(); return (12 * ($self->{octave}+1)) + $stepnums{$self->{step}} + $self->{alter}; } sub from_midinum { my $num = shift(); my $step = $midinotes{$num % 12}; my $octave = int($num / 12) - 1; my $alter = 0; if ($step =~ s/S$//) {$alter = 1;} ($step,$octave,$alter); } 1;