File Coverage

blib/lib/Music/MelodicDevice/Transposition.pm
Criterion Covered Total %
statement 47 47 100.0
branch 10 12 83.3
condition n/a
subroutine 12 12 100.0
pod 1 1 100.0
total 70 72 97.2


line stmt bran cond sub pod time code
1             package Music::MelodicDevice::Transposition;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Apply chromatic and diatonic transposition to notes
5              
6             our $VERSION = '0.0501';
7              
8 1     1   1132 use Data::Dumper::Compact qw(ddc);
  1         11212  
  1         3  
9 1     1   552 use List::SomeUtils qw(first_index);
  1         10927  
  1         59  
10 1     1   415 use Music::Note;
  1         1419  
  1         33  
11 1     1   395 use Music::Scales qw(get_scale_MIDI is_scale);
  1         4355  
  1         58  
12 1     1   1066 use Moo;
  1         6976  
  1         6  
13 1     1   1661 use strictures 2;
  1         1343  
  1         35  
14 1     1   539 use namespace::clean;
  1         6661  
  1         8  
15              
16 1     1   254 use constant OCTAVES => 10;
  1         2  
  1         625  
17              
18              
19             has scale_note => (
20             is => 'ro',
21             isa => sub { die "$_[0] is not a valid note" unless $_[0] =~ /^[A-G][#b]?$/ },
22             default => sub { 'C' },
23             );
24              
25              
26             has scale_name => (
27             is => 'ro',
28             isa => sub { die "$_[0] is not a valid scale name" unless is_scale($_[0]) },
29             default => sub { 'chromatic' },
30             );
31              
32             has _scale => (
33             is => 'lazy',
34             init_args => undef,
35             );
36              
37             sub _build__scale {
38 2     2   15 my ($self) = @_;
39              
40 2         4 my @scale = map { get_scale_MIDI($self->scale_note, $_, $self->scale_name) } -1 .. OCTAVES - 1;
  22         829  
41 2 50       78 print 'Scale: ', ddc(\@scale) if $self->verbose;
42              
43 2         12 return \@scale;
44             }
45              
46              
47             has verbose => (
48             is => 'ro',
49             isa => sub { die "$_[0] is not a valid boolean" unless $_[0] =~ /^[01]$/ },
50             default => sub { 0 },
51             );
52              
53              
54             sub transpose {
55 18     18 1 8229 my ($self, $offset, $notes) = @_;
56              
57 18 100       79 my $named = $notes->[0] =~ /[A-G]/ ? 1 : 0;
58              
59 18         28 my @transposed;
60              
61 18         31 for my $n (@$notes) {
62 90         1729 my ($i, $pitch) = $self->_find_pitch($n);
63 90 100       178 if ($i == -1) {
64 2         5 push @transposed, undef;
65             }
66             else {
67 88 100       133 if ($named) {
68 44         613 push @transposed, Music::Note->new($self->_scale->[ $i + $offset ], 'midinum')->format('ISO');
69             }
70             else {
71 44         579 push @transposed, $self->_scale->[ $i + $offset ];
72             }
73             }
74             }
75 18 50       450 print 'Transposed: ', ddc(\@transposed) if $self->verbose;
76              
77 18         52 return \@transposed;
78             }
79              
80             sub _find_pitch {
81 90     90   157 my ($self, $pitch) = @_;
82              
83 90 100       264 $pitch = Music::Note->new($pitch, 'ISO')->format('midinum')
84             if $pitch =~ /[A-G]/;
85              
86 90     4660   2113 my $i = first_index { $_ == $pitch } @{ $self->_scale };
  4660         5643  
  90         1360  
87              
88 90         270 return $i, $pitch;
89             }
90              
91             1;
92              
93             __END__