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   102 use v5.14;
  8         90  
4 8     8   40 use warnings;
  8         13  
  8         544  
5             our $VERSION = '0.12';
6              
7 8     8   42 use autodie;
  8         15  
  8         115  
8 8     8   44699 use Carp;
  8         16  
  8         711  
9 8     8   51 use Try::Tiny;
  8         14  
  8         542  
10 8     8   45 use Moo;
  8         13  
  8         59  
11 8     8   5378 use Types::Standard qw/Int Str InstanceOf/;
  8         14  
  8         106  
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   1890 my $self = shift;
32 3   50     108 $self->soundfont->_tsf->get_presetname( $self->index ) // '';
33             },
34             );
35              
36             sub render
37             {
38 29     29 1 14055 my $self = shift;
39 29         118 my %args = @_;
40              
41 29         151 my $tsf = $self->soundfont->_tsf;
42              
43 29 100       429 croak "Cannot render a preset when TinySoundFont is active"
44             if $tsf->active_voices;
45              
46 28         85 my $SR = $tsf->SAMPLE_RATE;
47 28   100     172 my $seconds = $args{seconds} // 0;
48 28   100     188 my $samples = ( $seconds * $SR ) || $args{samples} // $SR;
      66        
49 28   100     101 my $note = $args{note} // 60;
50 28   100     98 my $vel = $args{vel} // 0.5;
51 28   100     204 my $vol = $args{volume} // $self->soundfont->db_to_vol( $args{db} );
52              
53 28         66 my $old_vol;
54 28 100       71 if ( defined $vol )
55             {
56 14         548 $old_vol = $self->soundfont->volume;
57 14         457 $self->soundfont->volume($vol);
58             }
59              
60 28         191 my $vel_msg = qq{Velocity of "$vel" should be between 0 and 1};
61 28 100       84 if ( $vel < 0 )
62             {
63 1         357 carp qq{$vel_msg, setting to 0};
64 1         2240 $vel = 0;
65             }
66              
67 28 100       80 if ( $vel > 1 )
68             {
69 1         188 carp qq{$vel_msg, setting to 1};
70 1         874 $vel = 1;
71             }
72              
73 28         63 my $note_msg = qq{Note "$note" should be between 0 and 127};
74 28 100       64 if ( $note < 0 )
75             {
76 1         215 carp qq{$note_msg, setting to 0};
77 1         885 $note = 0;
78             }
79              
80 28 100       68 if ( $note > 127 )
81             {
82 1         226 carp qq{$note_msg, setting to 127};
83 1         846 $note = 127;
84             }
85              
86 28         362 $tsf->note_on( $self->index, $note, $vel );
87              
88 28         102379 my $result = $tsf->render($samples);
89 28         358 $tsf->note_off( $self->index, $note );
90              
91 28         53 my $cleanup_samples = 4096;
92 28         122 for ( 1 .. 256 )
93             {
94             last
95 54 100       384 if !$tsf->active_voices;
96 26         3118 $result .= $tsf->render($cleanup_samples);
97             }
98              
99 28 100       73 if ( defined $old_vol )
100             {
101 14         638 $self->soundfont->volume($old_vol);
102             }
103              
104 28         5366 return $result;
105             }
106              
107             sub render_unpack
108             {
109 1     1 1 11 my $self = shift;
110              
111 1         4 return unpack( 's<*', $self->render(@_) );
112             }
113              
114             1;
115             __END__