File Coverage

blib/lib/MIDI/Simple/Drummer/Euclidean.pm
Criterion Covered Total %
statement 23 39 58.9
branch 0 6 0.0
condition 2 9 22.2
subroutine 6 8 75.0
pod 3 3 100.0
total 34 65 52.3


line stmt bran cond sub pod time code
1             package MIDI::Simple::Drummer::Euclidean;
2             $MIDI::Simple::Drummer::Euclidean::VERSION = '0.0811';
3             our $AUTHORITY = 'cpan:GENE';
4 1     1   605 use strict;
  1         2  
  1         25  
5 1     1   4 use warnings;
  1         2  
  1         26  
6 1     1   423 use parent 'MIDI::Simple::Drummer';
  1         251  
  1         4  
7              
8             sub new {
9 1     1 1 520 my $self = shift;
10 1         8 $self->SUPER::new(
11             -onsets => 4,
12             -patch => 25,
13             -rhythm => undef,
14             -pad => 'kick',
15             @_
16             );
17             }
18              
19             sub _default_patterns {
20 1     1   2 my $self = shift;
21             return {
22              
23             1 => sub {
24 0     0   0 my $self = shift;
25             my $rhythm = $self->{-rhythm}
26             ? $self->{-rhythm}
27 0 0       0 : $self->euclid($self->{-onsets}, $self->beats);
28 0         0 for my $i ( @$rhythm ) {
29 0 0       0 if ( $i eq 'x' ) {
30 0         0 my $pad = $self->{-pad};
31 0   0     0 my $note = $self->$pad || $self->snare;
32 0         0 $self->note($self->EIGHTH, $note );
33             }
34             else {
35 0         0 $self->rest($self->EIGHTH);
36             }
37             }
38             }
39              
40 1         21 };
41             }
42              
43             sub euclid {
44 1     1 1 475 my $self = shift;
45 1         3 my ($m, $n) = @_;
46              
47             # Onsets per measure
48 1   33     6 $m ||= $self->{-onsets};
49             # Beats per measure
50 1   33     6 $n ||= $self->beats;
51              
52             # Line is from x=0, y=1 to x=$BPM, y=$mod+1
53             # Then from that, for each $y from # 1..$mod
54             # figure out the x value to see where beat would be.
55              
56 1         2 my $intercept = 1;
57              
58             # y = mx + b; b is 1 as we're drawing the intercept through that point,
59             # and then (y2-y1)/(x2-x1) reduces to just:
60 1         2 my $slope = $m / $n;
61              
62 1         3 my @onsets = ('.') x $n;
63 1         2 for my $y ( 1 .. $m ) {
64             # solve x = (y-b)/m rounding nearest and put the beat there
65 4         9 $onsets[ sprintf "%.0f", ( $y - $intercept ) / $slope ] = 'x';
66             }
67              
68 1         3 return \@onsets;
69             };
70              
71             sub rotate {
72 0     0 1   my $self = shift;
73 0           my $phrase = shift;
74              
75 0           my $done = 0;
76 0           while ( $done == 0 ) {
77 0           my $i = shift @$phrase;
78 0           push @$phrase, $i;
79 0 0         $done++ if $phrase->[0] eq 'x';
80             }
81              
82 0           return $phrase;
83             }
84              
85             1;
86              
87             __END__