File Coverage

blib/lib/MIDI/Drummer/Tiny.pm
Criterion Covered Total %
statement 33 149 22.1
branch 6 22 27.2
condition 0 32 0.0
subroutine 10 24 41.6
pod 16 17 94.1
total 65 244 26.6


line stmt bran cond sub pod time code
1             package MIDI::Drummer::Tiny;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Glorified metronome
5              
6             our $VERSION = '0.1604';
7              
8 1     1   940 use Math::Bezier;
  1         702  
  1         22  
9 1     1   533 use MIDI::Simple;
  1         16719  
  1         182  
10 1     1   396 use Music::Duration;
  1         471  
  1         24  
11 1     1   424 use Moo;
  1         9098  
  1         4  
12 1     1   1658 use strictures 2;
  1         1284  
  1         33  
13 1     1   583 use namespace::clean;
  1         9098  
  1         6  
14              
15 1     1   722 use constant TICKS => 96; # Per quarter note
  1         2  
  1         2945  
16              
17              
18             sub BUILD {
19 1     1 0 13 my ( $self, $args ) = @_;
20              
21 1         58 $self->score->noop( 'c' . $self->channel, 'V' . $self->volume );
22              
23 1         55 $self->score->set_tempo( int( 60_000_000 / $self->bpm ) );
24              
25 1         21 $self->set_time_sig;
26             }
27              
28              
29             has channel => ( is => 'ro', default => sub { 9 } );
30             has volume => ( is => 'ro', default => sub { 100 } );
31             has bpm => ( is => 'ro', default => sub { 120 } );
32             has file => ( is => 'ro', default => sub { 'MIDI-Drummer.mid' } );
33             has bars => ( is => 'ro', default => sub { 4 } );
34             has score => ( is => 'ro', default => sub { MIDI::Simple->new_score } );
35             has signature => ( is => 'rw', default => sub { '4/4' });
36             has beats => ( is => 'rw' );
37             has divisions => ( is => 'rw' );
38              
39              
40             has click => ( is => 'ro', default => sub { 'n33' } );
41             has bell => ( is => 'ro', default => sub { 'n34' } );
42             has kick => ( is => 'ro', default => sub { 'n35' } ); # Alt: 36
43             has acoustic_bass => ( is => 'ro', default => sub { 'n35' } );
44             has electric_bass => ( is => 'ro', default => sub { 'n36' } );
45             has side_stick => ( is => 'ro', default => sub { 'n37' } );
46             has snare => ( is => 'ro', default => sub { 'n38' } ); # Alt: 40
47             has acoustic_snare => ( is => 'ro', default => sub { 'n38' } );
48             has electric_snare => ( is => 'ro', default => sub { 'n40' } );
49             has clap => ( is => 'ro', default => sub { 'n39' } );
50             has open_hh => ( is => 'ro', default => sub { 'n46' } );
51             has closed_hh => ( is => 'ro', default => sub { 'n42' } );
52             has pedal_hh => ( is => 'ro', default => sub { 'n44' } );
53             has crash1 => ( is => 'ro', default => sub { 'n49' } );
54             has crash2 => ( is => 'ro', default => sub { 'n57' } );
55             has splash => ( is => 'ro', default => sub { 'n55' } );
56             has china => ( is => 'ro', default => sub { 'n52' } );
57             has ride1 => ( is => 'ro', default => sub { 'n51' } );
58             has ride2 => ( is => 'ro', default => sub { 'n59' } );
59             has ride_bell => ( is => 'ro', default => sub { 'n53' } );
60             has hi_tom => ( is => 'ro', default => sub { 'n50' } );
61             has hi_mid_tom => ( is => 'ro', default => sub { 'n48' } );
62             has low_mid_tom => ( is => 'ro', default => sub { 'n47' } );
63             has low_tom => ( is => 'ro', default => sub { 'n45' } );
64             has hi_floor_tom => ( is => 'ro', default => sub { 'n43' } );
65             has low_floor_tom => ( is => 'ro', default => sub { 'n41' } );
66             has tambourine => ( is => 'ro', default => sub { 'n54' } );
67             has cowbell => ( is => 'ro', default => sub { 'n56' } );
68             has vibraslap => ( is => 'ro', default => sub { 'n58' } );
69             has hi_bongo => ( is => 'ro', default => sub { 'n60' } );
70             has low_bongo => ( is => 'ro', default => sub { 'n61' } );
71             has mute_hi_conga => ( is => 'ro', default => sub { 'n62' } );
72             has open_hi_conga => ( is => 'ro', default => sub { 'n63' } );
73             has low_conga => ( is => 'ro', default => sub { 'n64' } );
74             has high_timbale => ( is => 'ro', default => sub { 'n65' } );
75             has low_timbale => ( is => 'ro', default => sub { 'n66' } );
76             has high_agogo => ( is => 'ro', default => sub { 'n67' } );
77             has low_agogo => ( is => 'ro', default => sub { 'n68' } );
78             has cabasa => ( is => 'ro', default => sub { 'n69' } );
79             has maracas => ( is => 'ro', default => sub { 'n70' } );
80             has short_whistle => ( is => 'ro', default => sub { 'n71' } );
81             has long_whistle => ( is => 'ro', default => sub { 'n72' } );
82             has short_guiro => ( is => 'ro', default => sub { 'n73' } );
83             has long_guiro => ( is => 'ro', default => sub { 'n74' } );
84             has claves => ( is => 'ro', default => sub { 'n75' } );
85             has hi_wood_block => ( is => 'ro', default => sub { 'n76' } );
86             has low_wood_block => ( is => 'ro', default => sub { 'n77' } );
87             has mute_cuica => ( is => 'ro', default => sub { 'n78' } );
88             has open_cuica => ( is => 'ro', default => sub { 'n79' } );
89             has mute_triangle => ( is => 'ro', default => sub { 'n80' } );
90             has open_triangle => ( is => 'ro', default => sub { 'n81' } );
91              
92              
93             has whole => (is => 'ro', default => sub { 'wn' });
94             has triplet_whole => (is => 'ro', default => sub { 'twn' });
95             has dotted_whole => (is => 'ro', default => sub { 'dwn' });
96             has double_dotted_whole => (is => 'ro', default => sub { 'ddwn' });
97             has half => (is => 'ro', default => sub { 'hn' });
98             has triplet_half => (is => 'ro', default => sub { 'thn' });
99             has dotted_half => (is => 'ro', default => sub { 'dhn' });
100             has double_dotted_half => (is => 'ro', default => sub { 'ddhn' });
101             has quarter => (is => 'ro', default => sub { 'qn' });
102             has triplet_quarter => (is => 'ro', default => sub { 'tqn' });
103             has dotted_quarter => (is => 'ro', default => sub { 'dqn' });
104             has double_dotted_quarter => (is => 'ro', default => sub { 'ddqn' });
105             has eighth => (is => 'ro', default => sub { 'en' });
106             has triplet_eighth => (is => 'ro', default => sub { 'ten' });
107             has dotted_eighth => (is => 'ro', default => sub { 'den' });
108             has double_dotted_eighth => (is => 'ro', default => sub { 'dden' });
109             has sixteenth => (is => 'ro', default => sub { 'sn' });
110             has triplet_sixteenth => (is => 'ro', default => sub { 'tsn' });
111             has dotted_sixteenth => (is => 'ro', default => sub { 'dsn' });
112             has double_dotted_sixteenth => (is => 'ro', default => sub { 'ddsn' });
113             has thirtysecond => (is => 'ro', default => sub { 'yn' });
114             has triplet_thirtysecond => (is => 'ro', default => sub { 'tyn' });
115             has dotted_thirtysecond => (is => 'ro', default => sub { 'dyn' });
116             has double_dotted_thirtysecond => (is => 'ro', default => sub { 'ddyn' });
117             has sixtyfourth => (is => 'ro', default => sub { 'xn' });
118             has triplet_sixtyfourth => (is => 'ro', default => sub { 'txn' });
119             has dotted_sixtyfourth => (is => 'ro', default => sub { 'dxn' });
120             has double_dotted_sixtyfourth => (is => 'ro', default => sub { 'ddxn' });
121             has onetwentyeighth => (is => 'ro', default => sub { 'on' });
122             has triplet_onetwentyeighth => (is => 'ro', default => sub { 'ton' });
123             has dotted_onetwentyeighth => (is => 'ro', default => sub { 'don' });
124             has double_dotted_onetwentyeighth => (is => 'ro', default => sub { 'ddon' });
125              
126              
127 1     1 1 2420 sub note { return shift->score->n(@_) }
128              
129              
130             sub accent_note {
131 0     0 1 0 my $self = shift;
132 0         0 my $accent = shift;
133 0         0 my $resume = $self->score->Volume;
134 0         0 $self->score->Volume($accent);
135 0         0 $self->note(@_);
136 0         0 $self->score->Volume($resume);
137             }
138              
139              
140 0     0 1 0 sub rest { return shift->score->r(@_) }
141              
142              
143             sub count_in {
144 0     0 1 0 my $self = shift;
145 0   0     0 my $bars = shift || $self->bars;
146 0         0 for my $i ( 1 .. $self->beats * $bars ) {
147 0         0 $self->note( $self->quarter, $self->closed_hh );
148             }
149             }
150              
151              
152             sub metronome34 {
153 0     0 1 0 my $self = shift;
154 0   0     0 my $bars = shift || $self->bars;
155              
156 0         0 for ( 1 .. $bars ) {
157 0         0 $self->note( $self->quarter, $self->ride1, $self->kick );
158 0         0 $self->note( $self->quarter, $self->ride1 );
159 0         0 $self->note( $self->quarter, $self->ride1, $self->snare );
160             }
161             }
162              
163              
164             sub metronome44 {
165 0     0 1 0 my $self = shift;
166 0   0     0 my $bars = shift || $self->bars;
167 0   0     0 my $flag = shift || 0;
168              
169 0         0 my $i = 0;
170              
171 0         0 for my $n ( 1 .. $self->beats * $bars ) {
172 0 0       0 if ( $n % 2 == 0 )
173             {
174 0         0 $self->note( $self->quarter, $self->closed_hh, $self->snare );
175             }
176             else {
177 0 0       0 if ( $flag == 0 )
178             {
179 0         0 $self->note( $self->quarter, $self->closed_hh, $self->kick );
180             }
181             else
182             {
183 0 0       0 if ( $i % 2 == 0 )
184             {
185 0         0 $self->note( $self->quarter, $self->closed_hh, $self->kick );
186             }
187             else
188             {
189 0         0 $self->note( $self->eighth, $self->closed_hh, $self->kick );
190 0         0 $self->note( $self->eighth, $self->kick );
191             }
192             }
193              
194 0         0 $i++;
195             }
196             }
197             }
198              
199              
200             sub metronome54 {
201 0     0 1 0 my $self = shift;
202 0   0     0 my $bars = shift || $self->bars;
203 0         0 for my $n (1 .. $bars) {
204 0         0 $self->note($self->quarter, $self->closed_hh, $self->kick);
205 0         0 $self->note($self->quarter, $self->closed_hh);
206 0         0 $self->note($self->quarter, $self->closed_hh, $self->snare);
207 0         0 $self->note($self->quarter, $self->closed_hh);
208 0 0       0 if ($n % 2) {
209 0         0 $self->note($self->quarter, $self->closed_hh);
210             }
211             else {
212 0         0 $self->note($self->eighth, $self->closed_hh);
213 0         0 $self->note($self->eighth, $self->kick);
214             }
215             }
216             }
217              
218              
219             sub metronome58 {
220 0     0 1 0 my $self = shift;
221 0   0     0 my $bars = shift || $self->bars;
222 0         0 for my $n (1 .. $bars) {
223 0         0 $self->note($self->eighth, $self->closed_hh, $self->kick);
224 0         0 $self->note($self->eighth, $self->closed_hh);
225 0         0 $self->note($self->eighth, $self->closed_hh, $self->snare);
226 0         0 $self->note($self->eighth, $self->closed_hh);
227 0         0 $self->note($self->eighth, $self->closed_hh);
228             }
229             }
230              
231              
232             sub metronome68 {
233 0     0 1 0 my $self = shift;
234 0   0     0 my $bars = shift || $self->bars;
235 0         0 for my $n (1 .. $bars) {
236 0         0 $self->note($self->eighth, $self->closed_hh, $self->kick);
237 0         0 $self->note($self->eighth, $self->closed_hh);
238 0         0 $self->note($self->eighth, $self->closed_hh);
239 0         0 $self->note($self->eighth, $self->closed_hh, $self->snare);
240 0         0 $self->note($self->eighth, $self->closed_hh);
241 0         0 $self->note($self->eighth, $self->closed_hh);
242             }
243             }
244              
245              
246             sub metronome74 {
247 0     0 1 0 my $self = shift;
248 0   0     0 my $bars = shift || $self->bars;
249 0         0 for my $n (1 .. $bars) {
250 0         0 $self->note($self->quarter, $self->closed_hh, $self->kick);
251 0         0 $self->note($self->quarter, $self->closed_hh);
252 0         0 $self->note($self->quarter, $self->closed_hh, $self->snare);
253 0         0 $self->note($self->eighth, $self->closed_hh);
254 0         0 $self->note($self->eighth, $self->kick);
255 0         0 $self->note($self->quarter, $self->closed_hh, $self->kick);
256 0         0 $self->note($self->quarter, $self->closed_hh, $self->snare);
257 0         0 $self->note($self->quarter, $self->closed_hh);
258             }
259             }
260              
261              
262             sub metronome78 {
263 0     0 1 0 my $self = shift;
264 0   0     0 my $bars = shift || $self->bars;
265 0         0 for my $n (1 .. $bars) {
266 0         0 $self->note($self->eighth, $self->closed_hh, $self->kick);
267 0         0 $self->note($self->eighth, $self->closed_hh);
268 0         0 $self->note($self->eighth, $self->closed_hh);
269 0         0 $self->note($self->sixteenth, $self->closed_hh, $self->kick);
270 0         0 $self->note($self->sixteenth, $self->kick);
271 0         0 $self->note($self->eighth, $self->closed_hh, $self->snare);
272 0         0 $self->note($self->eighth, $self->closed_hh);
273 0         0 $self->note($self->eighth, $self->closed_hh);
274             }
275             }
276              
277              
278             sub flam {
279 0     0 1 0 my ($self, $spec, $patch) = @_;
280 0         0 my $x = $MIDI::Simple::Length{$spec};
281 0         0 my $y = $MIDI::Simple::Length{ $self->sixtyfourth };
282 0         0 my $z = sprintf '%0.f', ($x - $y) * TICKS;
283 0         0 my $accent = sprintf '%0.f', $self->score->Volume / 2;
284 0         0 $self->accent_note($accent, $self->sixtyfourth, $patch);
285 0         0 $self->note('d' . $z, $patch);
286             }
287              
288              
289             sub roll {
290 0     0 1 0 my ($self, $length, $spec, $patch) = @_;
291 0   0     0 $patch ||= $self->snare;
292 0         0 my $x = $MIDI::Simple::Length{$length};
293 0         0 my $y = $MIDI::Simple::Length{$spec};
294 0         0 my $z = sprintf '%0.f', $x / $y;
295 0         0 $self->note($spec, $patch) for 1 .. $z;
296             }
297              
298              
299             sub crescendo_roll {
300 0     0 1 0 my ($self, $span, $length, $spec, $patch) = @_;
301 0   0     0 $patch ||= $self->snare;
302 0         0 my ($i, $j, $k) = @$span;
303 0         0 my $x = $MIDI::Simple::Length{$length};
304 0         0 my $y = $MIDI::Simple::Length{$spec};
305 0         0 my $z = sprintf '%0.f', $x / $y;
306 0 0       0 if ($k) {
307 0         0 my $bezier = Math::Bezier->new(
308             1, $i,
309             $z, $i,
310             $z, $j,
311             );
312 0         0 for (my $n = 0; $n <= 1; $n += (1 / ($z - 1))) {
313 0         0 my (undef, $v) = $bezier->point($n);
314 0         0 $v = sprintf '%0.f', $v;
315             # warn(__PACKAGE__,' ',__LINE__," $n INC: $v\n");
316 0         0 $self->accent_note($v, $spec, $patch);
317             }
318             }
319             else {
320 0         0 my $v = sprintf '%0.f', ($j - $i) / ($z - 1);
321             # warn(__PACKAGE__,' ',__LINE__," VALUE: $v\n");
322 0         0 for my $n (1 .. $z) {
323 0 0       0 if ($n == $z) {
324 0 0       0 if ($i < $j) {
    0          
325 0         0 $i += $j - $i;
326             }
327             elsif ($i > $j) {
328 0         0 $i -= $i - $j;
329             }
330             }
331             # warn(__PACKAGE__,' ',__LINE__," $n INC: $i\n");
332 0         0 $self->accent_note($i, $spec, $patch);
333 0         0 $i += $v;
334             }
335             }
336             }
337              
338              
339             sub set_time_sig {
340 2     2 1 803 my $self = shift;
341 2 100       7 if (@_) {
342 1         4 $self->signature(shift);
343             }
344 2         9 my ($beats, $divisions) = split /\//, $self->signature;
345 2         7 $self->beats($beats);
346 2         4 $self->divisions($divisions);
347 2 100       22 $self->score->time_signature(
    100          
348             $self->beats,
349             ( $self->divisions == 8 ? 3 : 2),
350             ( $self->divisions == 8 ? 24 : 18 ),
351             8
352             );
353             }
354              
355              
356             sub write {
357 0     0 1   my $self = shift;
358 0           $self->score->write_score( $self->file );
359             }
360              
361             1;
362              
363             __END__