File Coverage

blib/lib/Music/MelodicDevice/Inversion.pm
Criterion Covered Total %
statement 56 56 100.0
branch 12 16 75.0
condition n/a
subroutine 12 12 100.0
pod 2 2 100.0
total 82 86 95.3


line stmt bran cond sub pod time code
1             package Music::MelodicDevice::Inversion;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Apply melodic inversion to a series of notes
5              
6             our $VERSION = '0.0504';
7              
8 2     2   663428 use Moo;
  2         22080  
  2         15  
9 2     2   5289 use strictures 2;
  2         4607  
  2         124  
10 2     2   2576 use Data::Dumper::Compact qw(ddc);
  2         39528  
  2         10  
11 2     2   1633 use List::SomeUtils qw(first_index);
  2         33788  
  2         316  
12 2     2   1199 use Music::Scales qw(get_scale_MIDI is_scale);
  2         14079  
  2         214  
13 2     2   1327 use namespace::clean;
  2         27582  
  2         18  
14              
15             with('Music::PitchNum');
16              
17 2     2   876 use constant OCTAVES => 10;
  2         4  
  2         2471  
18              
19              
20             has scale_note => (
21             is => 'ro',
22             isa => sub { die "$_[0] is not a valid note" unless $_[0] =~ /^[A-G][#b]?$/ },
23             default => sub { 'C' },
24             );
25              
26              
27             has scale_name => (
28             is => 'ro',
29             isa => sub { die "$_[0] is not a valid scale name" unless is_scale($_[0]) },
30             default => sub { 'chromatic' },
31             );
32              
33             has _scale => (
34             is => 'lazy',
35             init_args => undef,
36             );
37              
38             sub _build__scale {
39 2     2   22 my ($self) = @_;
40              
41 2         7 my @scale = map { get_scale_MIDI($self->scale_note, $_, $self->scale_name) } -1 .. OCTAVES - 1;
  22         1396  
42 2 50       125 print 'Scale: ', ddc(\@scale) if $self->verbose;
43              
44 2         19 return \@scale;
45             }
46              
47              
48             has verbose => (
49             is => 'ro',
50             isa => sub { die "$_[0] is not a valid boolean" unless $_[0] =~ /^[01]$/ },
51             default => sub { 0 },
52             );
53              
54              
55             sub intervals {
56 12     12 1 15741 my ($self, $notes) = @_;
57              
58 12         23 my @pitches;
59              
60 12         34 for my $note (@$notes) {
61 84         212 my ($i, $pitch) = $self->_find_pitch($note);
62 84         282 push @pitches, $i;
63             }
64 12 50       60 print 'Pitches: ', ddc(\@pitches) if $self->verbose;
65              
66 12         25 my @intervals;
67             my $last;
68              
69 12         25 for my $pitch (@pitches) {
70 84 100       173 if (defined $last) {
71 72         142 push @intervals, $pitch - $last;
72             }
73 84         173 $last = $pitch;
74             }
75 12 50       33 print 'Intervals: ', ddc(\@intervals) if $self->verbose;
76              
77 12         56 return \@intervals;
78             }
79              
80              
81             sub invert {
82 6     6 1 5967 my ($self, $note, $notes) = @_;
83              
84 6 100       40 my $named = $note =~ /[A-G]/ ? 1 : 0;
85              
86 6         19 my @inverted = ($note);
87              
88 6         19 my $intervals = $self->intervals($notes);
89              
90 6         13 for my $interval (@$intervals) {
91             # Find the note that is the opposite interval away from the original note
92 36         105 (my $i, $note) = $self->_find_pitch($note);
93 36         993 my $pitch = $self->_scale->[ $i - $interval ];
94              
95 36 100       407 $note = $named ? $self->pitchname($pitch) : $pitch;
96              
97 36         641 push @inverted, $note;
98             }
99              
100 6 50       26 print 'Inverted: ', ddc(\@inverted) if $self->verbose;
101              
102 6         31 return \@inverted;
103             }
104              
105             sub _find_pitch {
106 120     120   262 my ($self, $pitch) = @_;
107              
108 120 100       826 $pitch = $self->pitchnum($pitch)
109             if $pitch =~ /[A-G]/;
110              
111 120     7015   7679 my $i = first_index { $_ eq $pitch } @{ $self->_scale };
  7015         12659  
  120         3646  
112              
113 120         779 return $i, $pitch;
114             }
115              
116             1;
117              
118             __END__