File Coverage

blib/lib/Music/Harmonics.pm
Criterion Covered Total %
statement 14 44 31.8
branch 0 14 0.0
condition 1 8 12.5
subroutine 4 8 50.0
pod 4 4 100.0
total 23 78 29.4


line stmt bran cond sub pod time code
1             package Music::Harmonics;
2              
3 1     1   29472 use warnings;
  1         3  
  1         34  
4 1     1   6 use strict;
  1         1  
  1         40  
5 1     1   4245 use MIDI::Pitch qw(name2freq freq2name);
  1         989  
  1         503  
6              
7             =head1 NAME
8              
9             Music::Harmonics - Calculate harmonics for stringed instruments
10              
11             =head1 VERSION
12              
13             Version 0.01
14              
15             =cut
16              
17             our $VERSION = '0.01';
18              
19             =head1 SYNOPSIS
20              
21             use Music::Harmonics;
22            
23             my $h = Music::Harmonics->new();
24             foreach (2..5) {
25             my %harm = $h->GetStringHarmonic(name => 'E2', harmonic => $_);
26             printf("Grab fret %i to play the harmonic #%i. It'll be a %s.\n",
27             $harm{frets}->[0], $_, uc $harm{name});
28             }
29              
30             =head1 DESCRIPTION
31              
32             This module calculates the note names and positions of harmonics and overtones.
33             So far, it is limited to stringed instruments.
34              
35             Note that the first harmonic is the foundational pitch, the second harmonic
36             is the first overtone, and so on.
37              
38             The pitch names used in this module are the sames as used by L.
39              
40             =head1 CONSTRUCTOR
41              
42             =head2 new
43              
44             my $h = Music::Harmonics->new(frets_per_octave => 12);
45              
46             Creates a new C object. The C parameter
47             is optional and defaults to 12.
48              
49             =cut
50              
51             sub new {
52 1     1 1 358 my $class = shift;
53 1         2 my %args = @_;
54              
55 1         3 my $self = {};
56              
57 1   50     10 $self->{frets_per_octave} = $args{frets_per_octave} || 12;
58              
59 1         4 bless $self, $class;
60             }
61              
62             =head1 FUNCTIONS
63              
64             =head2 GetFret
65              
66             my $f = $h->GetFret($position);
67              
68             Given a position on the fingerboard between 0 and 1 (0 being directly at the nut,
69             1 being at the other end of the string at the bridge), returns the fret number
70             as a float (assuming even intonation). For example, C<0.5> refers to the
71             middle of the string, so that C on an
72             instrument with 12 frets per octave returns 12.
73              
74             =cut
75              
76             sub GetFret {
77 0     0 1   my ($self, $pos) = @_;
78              
79 0 0         if ($pos != 1) {
80 0           return log(-1 / ($pos - 1)) / log(2) * $self->{frets_per_octave};
81             } else {
82 0           return 0;
83             }
84             }
85              
86             =head2 GetStringHarmonic
87              
88             %harm = $h->GetStringHarmonic(name => 'E2', harmonic => 2,
89             minfret => 0, maxfret => 12);
90              
91             Returns the positions where a certain harmonic can be played. C and
92             C are optional, their default values are 0 and 12 respectively.
93              
94             The result is a hash. C gives the name of the harmonic, C the
95             frequency and C is a list of fret positions.
96              
97             =cut
98              
99             sub _gcd {
100 0     0     my ($n, $m) = @_;
101 0           while ($m) {
102 0           my $k = $n % $m;
103 0           ($n, $m) = ($m, $k);
104             }
105 0           return $n;
106             }
107              
108             sub GetStringHarmonic {
109 0     0 1   my $self = shift;
110 0           my %params = @_;
111 0           my %defaults = (harmonic => 2, minfret => 0, maxfret => 24);
112 0           foreach (keys %defaults) {
113 0 0         $params{$_} = $defaults{$_} unless defined $params{$_};
114             }
115              
116             return undef
117 0 0 0       unless $params{name}
118             && (my $basefreq = name2freq($params{name}));
119              
120 0           my @frets = ();
121              
122             # loop over fractions: 1/n, 2/n, 3/n, ...
123 0           foreach my $i (1 .. $params{harmonic}) {
124 0 0         next if _gcd($i, $params{harmonic}) > 1;
125              
126 0           my $fret = $self->GetFret($i / $params{harmonic});
127 0 0 0       push @frets, $fret
128             if ($fret >= $params{minfret} && $fret <= $params{maxfret});
129             }
130              
131 0           my $freq = $basefreq * $params{harmonic};
132              
133             return (
134 0           frequency => $freq,
135             name => freq2name($freq),
136             frets => [@frets]);
137             }
138              
139             =head2 GetStringHarmonics
140              
141             $h->GetStringHarmonics(name => 'E2', minharmonic => 2, maxharmonic => 6);
142              
143             Retrieves a list of harmonics from C to C.
144              
145             =cut
146              
147             sub GetStringHarmonics {
148 0     0 1   my $self = shift;
149 0           my %params = @_;
150 0           my %defaults = (minharmonic => 2, maxharmonic => 6);
151 0           foreach (keys %defaults) {
152 0 0         $params{$_} = $defaults{$_} unless defined $params{$_};
153             }
154              
155 0 0         return unless defined $params{name};
156             return
157 0           map { { $self->GetStringHarmonic(harmonic => $_, %params) } }
  0            
158             $params{minharmonic} .. $params{maxharmonic};
159             }
160              
161             =head1 SEE ALSO
162              
163             L
164              
165             =head1 AUTHOR
166              
167             Christian Renz, Ecrenz @ web42.comE
168              
169             =head1 BUGS
170              
171             Please report any bugs or feature requests to
172             C, or through the web interface at
173             L.
174             I will be notified, and then you'll automatically be notified of progress on
175             your bug as I make changes.
176              
177             =head1 COPYRIGHT AND LICENSE
178              
179             Copyright 2005 Christian Renz Ecrenz @ web42.comE, All Rights Reserved.
180              
181             This program is free software; you can redistribute it and/or modify it
182             under the same terms as Perl itself.
183              
184             =cut
185              
186             42;