File Coverage

blib/lib/MIDI/Util.pm
Criterion Covered Total %
statement 105 114 92.1
branch 34 40 85.0
condition 2 9 22.2
subroutine 14 15 93.3
pod 8 8 100.0
total 163 186 87.6


line stmt bran cond sub pod time code
1             package MIDI::Util;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: MIDI Utilities
5              
6             our $VERSION = '0.1101';
7              
8 1     1   756 use strict;
  1         2  
  1         28  
9 1     1   4 use warnings;
  1         1  
  1         25  
10              
11 1     1   328 use MIDI ();
  1         9756  
  1         27  
12 1     1   591 use MIDI::Simple ();
  1         5959  
  1         33  
13 1     1   398 use Music::Tempo qw(bpm_to_ms);
  1         377  
  1         63  
14 1     1   6 use Exporter 'import';
  1         2  
  1         37  
15              
16             our @EXPORT = qw(
17             midi_dump
18             reverse_dump
19             midi_format
20             set_chan_patch
21             set_time_signature
22             setup_score
23             dura_size
24             ticks
25             );
26              
27 1     1   4 use constant TICKS => 96;
  1         2  
  1         1032  
28              
29              
30             sub setup_score {
31 1     1 1 569 my %args = (
32             lead_in => 4,
33             volume => 120,
34             bpm => 100,
35             channel => 0,
36             patch => 0,
37             octave => 4,
38             signature => '4/4',
39             @_,
40             );
41              
42 1         7 my $score = MIDI::Simple->new_score();
43              
44 1         111 set_time_signature($score, $args{signature});
45              
46 1         22 $score->set_tempo( bpm_to_ms($args{bpm}) * 1000 );
47              
48 1         64 $score->Channel(9);
49 1         16 $score->n( 'qn', 42 ) for 1 .. $args{lead_in};
50              
51 1         192 $score->Volume($args{volume});
52 1         10 $score->Channel($args{channel});
53 1         8 $score->Octave($args{octave});
54 1         45 $score->patch_change( $args{channel}, $args{patch} );
55              
56 1         23 return $score;
57             }
58              
59              
60             sub set_chan_patch {
61 1     1 1 3004 my ( $score, $channel, $patch ) = @_;
62              
63 1   50     4 $channel //= 0;
64              
65 1 50       8 $score->patch_change( $channel, $patch )
66             if defined $patch;
67              
68 1         23 $score->noop( 'c' . $channel );
69             }
70              
71              
72             sub midi_dump {
73 15     15 1 6517 my ($key) = @_;
74              
75 15 100       116 if ( lc $key eq 'volume' ) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
76             return {
77 10         19 map { $_ => $MIDI::Simple::Volume{$_} }
78 1         11 sort { $MIDI::Simple::Volume{$a} <=> $MIDI::Simple::Volume{$b} }
  24         27  
79             keys %MIDI::Simple::Volume
80             };
81             }
82             elsif ( lc $key eq 'length' ) {
83             return {
84 20         34 map { $_ => $MIDI::Simple::Length{$_} }
85 1         11 sort { $MIDI::Simple::Length{$a} <=> $MIDI::Simple::Length{$b} }
  66         65  
86             keys %MIDI::Simple::Length
87             };
88             }
89             elsif ( lc $key eq 'ticks' ) {
90             return {
91 20         31 map { $_ => $MIDI::Simple::Length{$_} * TICKS }
92 1         5 sort { $MIDI::Simple::Length{$a} <=> $MIDI::Simple::Length{$b} }
  66         62  
93             keys %MIDI::Simple::Length
94             };
95             }
96             elsif ( lc $key eq 'note' ) {
97             return {
98 27         40 map { $_ => $MIDI::Simple::Note{$_} }
99 1         10 sort { $MIDI::Simple::Note{$a} <=> $MIDI::Simple::Note{$b} }
  100         91  
100             keys %MIDI::Simple::Note
101             };
102             }
103             elsif ( lc $key eq 'note2number' ) {
104             return {
105 128         199 map { $_ => $MIDI::note2number{$_} }
106 1         39 sort { $MIDI::note2number{$a} <=> $MIDI::note2number{$b} }
  741         685  
107             keys %MIDI::note2number
108             };
109             }
110             elsif ( lc $key eq 'number2note' ) {
111             return {
112 128         214 map { $_ => $MIDI::number2note{$_} }
113 1         24 sort { $a <=> $b }
  726         614  
114             keys %MIDI::number2note
115             };
116             }
117             elsif ( lc $key eq 'patch2number' ) {
118             return {
119 128         196 map { $_ => $MIDI::patch2number{$_} }
120 1         27 sort { $MIDI::patch2number{$a} <=> $MIDI::patch2number{$b} }
  738         654  
121             keys %MIDI::patch2number
122             };
123             }
124             elsif ( lc $key eq 'number2patch' ) {
125             return {
126 128         210 map { $_ => $MIDI::number2patch{$_} }
127 1         23 sort { $a <=> $b }
  736         604  
128             keys %MIDI::number2patch
129             };
130             }
131             elsif ( lc $key eq 'notenum2percussion' ) {
132             return {
133 47         71 map { $_ => $MIDI::notenum2percussion{$_} }
134 1         12 sort { $a <=> $b }
  209         172  
135             keys %MIDI::notenum2percussion
136             };
137             }
138             elsif ( lc $key eq 'percussion2notenum' ) {
139             return {
140 47         67 map { $_ => $MIDI::percussion2notenum{$_} }
141 1         12 sort { $MIDI::percussion2notenum{$a} <=> $MIDI::percussion2notenum{$b} }
  210         190  
142             keys %MIDI::percussion2notenum
143             };
144             }
145             elsif ( lc $key eq 'all_events' ) {
146 1         7 return \@MIDI::Event::All_events;
147             }
148             elsif ( lc $key eq 'midi_events' ) {
149 1         4 return \@MIDI::Event::MIDI_events;
150             }
151             elsif ( lc $key eq 'meta_events' ) {
152 1         3 return \@MIDI::Event::Meta_events;
153             }
154             elsif ( lc $key eq 'text_events' ) {
155 1         3 return \@MIDI::Event::Text_events;
156             }
157             elsif ( lc $key eq 'nontext_meta_events' ) {
158 1         4 return \@MIDI::Event::Nontext_meta_events;
159             }
160             else {
161 0         0 return [];
162             }
163             }
164              
165              
166             sub reverse_dump {
167 0     0 1 0 my ($name, $precision) = @_;
168              
169 0   0     0 $precision //= -1;
170              
171 0         0 my %by_value;
172              
173 0         0 my $dump = midi_dump($name); # dumps an arrayref
174              
175 0         0 for my $key (keys %$dump) {
176             my $val = $name eq 'length' && $precision >= 0
177             ? sprintf('%.*f', $precision, $dump->{$key})
178 0 0 0     0 : $dump->{$key};
179 0         0 $by_value{$val} = $key;
180             }
181              
182 0         0 return \%by_value;
183             }
184              
185              
186             sub midi_format {
187 1     1 1 364 my (@notes) = @_;
188 1         2 my @formatted;
189 1         2 for my $note (@notes) {
190 4         5 $note =~ s/C##/D/;
191 4         5 $note =~ s/D##/E/;
192 4         5 $note =~ s/F##/G/;
193 4         5 $note =~ s/G##/A/;
194              
195 4         4 $note =~ s/Dbb/C/;
196 4         3 $note =~ s/Ebb/D/;
197 4         4 $note =~ s/Abb/G/;
198 4         5 $note =~ s/Bbb/A/;
199              
200 4         5 $note =~ s/E#/F/;
201 4         3 $note =~ s/B#/C/;
202              
203 4         5 $note =~ s/Cb/B/;
204 4         5 $note =~ s/Fb/E/;
205              
206 4         6 $note =~ s/#/s/;
207 4         7 $note =~ s/b/f/;
208              
209 4         5 push @formatted, $note;
210             }
211 1         5 return @formatted;
212             }
213              
214              
215             sub set_time_signature {
216 1     1 1 3 my ($score, $signature) = @_;
217 1         6 my ($beats, $divisions) = split /\//, $signature;
218 1 50       11 $score->time_signature(
    50          
219             $beats,
220             ($divisions == 8 ? 3 : 2),
221             ($divisions == 8 ? 24 : 18 ),
222             8
223             );
224             }
225              
226              
227             sub dura_size {
228 4     4 1 477 my ($duration, $ppqn) = @_;
229 4   50     19 $ppqn ||= TICKS;
230 4         6 my $size = 0;
231 4 100       15 if ($duration =~ /^d(\d+)$/) {
232 2         22 $size = sprintf '%0.f', $1 / $ppqn;
233             }
234             else {
235 2         5 $size = $MIDI::Simple::Length{$duration};
236             }
237 4         13 return $size;
238             }
239              
240              
241             sub ticks {
242 1     1 1 3 my ($score) = @_;
243 1         2 return ${ $score->{Tempo} };
  1         5  
244             }
245              
246             1;
247              
248             __END__