File Coverage

blib/lib/Audio/TinySoundFont/Preset.pm
Criterion Covered Total %
statement 62 62 100.0
branch 16 16 100.0
condition 15 17 88.2
subroutine 10 10 100.0
pod 2 2 100.0
total 105 107 98.1


line stmt bran cond sub pod time code
1             package Audio::TinySoundFont::Preset;
2              
3 8     8   141 use v5.14;
  8         32  
4 8     8   53 use warnings;
  8         22  
  8         344  
5             our $VERSION = '0.10';
6              
7 8     8   48 use autodie;
  8         15  
  8         63  
8 8     8   44038 use Carp;
  8         27  
  8         608  
9 8     8   63 use Try::Tiny;
  8         17  
  8         498  
10 8     8   52 use Moo;
  8         15  
  8         77  
11 8     8   4330 use Types::Standard qw/Int Str InstanceOf/;
  8         18  
  8         123  
12              
13             has soundfont => (
14             is => 'ro',
15             isa => InstanceOf ['Audio::TinySoundFont'],
16             required => 1,
17             );
18              
19             has index => (
20             is => 'ro',
21             isa => Int,
22             required => 1,
23             );
24              
25             has name => (
26             is => 'ro',
27             isa => Str,
28             lazy => 1,
29             builder => sub
30             {
31 3     3   1363 my $self = shift;
32 3   50     72 $self->soundfont->_tsf->get_presetname( $self->index ) // '';
33             },
34             );
35              
36             sub render
37             {
38 29     29 1 9169 my $self = shift;
39 29         97 my %args = @_;
40              
41 29         100 my $tsf = $self->soundfont->_tsf;
42              
43 29 100       237 croak "Cannot render a preset when TinySoundFont is active"
44             if $tsf->active_voices;
45              
46 28         65 my $SR = $tsf->SAMPLE_RATE;
47 28   100     113 my $seconds = $args{seconds} // 0;
48 28   100     127 my $samples = ( $seconds * $SR ) || $args{samples} // $SR;
      66        
49 28   100     82 my $note = $args{note} // 60;
50 28   100     85 my $vel = $args{vel} // 0.5;
51 28   100     122 my $vol = $args{volume} // $self->soundfont->db_to_vol( $args{db} );
52              
53 28         58 my $old_vol;
54 28 100       61 if ( defined $vol )
55             {
56 14         430 $old_vol = $self->soundfont->volume;
57 14         302 $self->soundfont->volume($vol);
58             }
59              
60 28         165 my $vel_msg = qq{Velocity of "$vel" should be between 0 and 1};
61 28 100       81 if ( $vel < 0 )
62             {
63 1         210 carp qq{$vel_msg, setting to 0};
64 1         978 $vel = 0;
65             }
66              
67 28 100       65 if ( $vel > 1 )
68             {
69 1         94 carp qq{$vel_msg, setting to 1};
70 1         629 $vel = 1;
71             }
72              
73 28         65 my $note_msg = qq{Note "$note" should be between 0 and 127};
74 28 100       106 if ( $note < 0 )
75             {
76 1         95 carp qq{$note_msg, setting to 0};
77 1         636 $note = 0;
78             }
79              
80 28 100       57 if ( $note > 127 )
81             {
82 1         94 carp qq{$note_msg, setting to 127};
83 1         632 $note = 127;
84             }
85              
86 28         241 $tsf->note_on( $self->index, $note, $vel );
87              
88 28         71592 my $result = $tsf->render($samples);
89 28         218 $tsf->note_off( $self->index, $note );
90              
91 28         48 my $cleanup_samples = 4096;
92 28         83 for ( 1 .. 256 )
93             {
94             last
95 54 100       233 if !$tsf->active_voices;
96 26         2281 $result .= $tsf->render($cleanup_samples);
97             }
98              
99 28 100       66 if ( defined $old_vol )
100             {
101 14         375 $self->soundfont->volume($old_vol);
102             }
103              
104 28         4433 return $result;
105             }
106              
107             sub render_unpack
108             {
109 1     1 1 9 my $self = shift;
110              
111 1         4 return unpack( 's<*', $self->render(@_) );
112             }
113              
114             1;
115             __END__