File Coverage

blib/lib/Audio/TinySoundFont/Builder.pm
Criterion Covered Total %
statement 74 74 100.0
branch 15 16 93.7
condition 15 15 100.0
subroutine 11 11 100.0
pod 5 5 100.0
total 120 121 99.1


line stmt bran cond sub pod time code
1             package Audio::TinySoundFont::Builder;
2              
3 8     8   108 use v5.14;
  8         29  
4 8     8   51 use warnings;
  8         13  
  8         329  
5             our $VERSION = '0.10';
6              
7 8     8   47 use Carp;
  8         18  
  8         457  
8              
9 8     8   50 use Moo;
  8         17  
  8         56  
10 8     8   3041 use Types::Standard qw/ArrayRef HashRef InstanceOf/;
  8         17  
  8         67  
11              
12             has soundfont => (
13             is => 'ro',
14             isa => InstanceOf ['Audio::TinySoundFont'],
15             required => 1,
16             );
17              
18             has play_script => (
19             is => 'rwp',
20             isa => ArrayRef,
21             default => sub { [] },
22             coerce => \&_coerce_play_script,
23             );
24              
25             *SAMPLE_RATE = \&Audio::TinySoundFont::XS::SAMPLE_RATE;
26              
27             sub _coerce_play_script
28             {
29 18     18   4985 my $new_script = shift;
30              
31 18 50       55 croak "play_script requires an ArrayRef"
32             if ref $new_script ne 'ARRAY';
33              
34 18         34 my @result;
35 18         41 foreach my $item (@$new_script)
36             {
37 25 100       210 croak "Script items must be a HashRef, not: " . ref $item
38             if ref $item ne 'HASH';
39              
40             push @result, {
41             in_seconds => ( $item->{in_seconds} // 1 ) + 0,
42             at => ( $item->{at} // 0 ) + 0,
43             for => ( $item->{for} // 1 ) + 0,
44             note => ( $item->{note} // 60 ) + 0,
45             vel => ( $item->{vel} // 0.5 ) + 0,
46 24   100     254 preset => ( $item->{preset} // '' ),
      100        
      100        
      100        
      100        
      100        
47             };
48             }
49              
50 17         302 return \@result;
51             }
52              
53             sub clear
54             {
55 3     3 1 3917 my $self = shift;
56              
57 3         14 $self->set( [] );
58              
59 3         8 return;
60             }
61              
62             sub set
63             {
64 5     5 1 1707 my $self = shift;
65 5         9 my $script = shift;
66              
67 5         133 $self->_set_play_script($script);
68              
69 5         141 return;
70             }
71              
72             sub add
73             {
74 6     6 1 1894 my $self = shift;
75 6         11 my $script = shift;
76              
77 6 100       115 croak "add requires an ArrayRef"
78             if ref $script ne 'ARRAY';
79              
80 5         13 my $old_script = $self->play_script;
81 5         103 $self->_set_play_script( [ @$old_script, @$script ] );
82              
83 5         120 return;
84             }
85              
86             sub render
87             {
88 9     9 1 766 my $self = shift;
89 9         28 my %args = @_;
90              
91 9   100     70 my $vol = $args{volume} // $self->soundfont->db_to_vol( $args{db} );
92              
93 9         23 my $old_vol;
94 9 100       25 if ( defined $vol )
95             {
96 2         57 $old_vol = $self->soundfont->volume;
97 2         47 $self->soundfont->volume($vol);
98             }
99              
100 9         27 my $script = $self->play_script;
101 9         25 my $SR = $self->SAMPLE_RATE;
102 9         17 my $result = '';
103              
104 9 100       34 croak "Cannot process play_script when TinySoundFont is active"
105             if $self->soundfont->is_active;
106              
107             # Create a specialized structure to create a rendering:
108             # [ timestamp, fn, preset, note, vel ]
109 8         19 my @insrs;
110 8         22 foreach my $item (@$script)
111             {
112 12         25 my $at = $item->{at};
113 12         24 my $to = $at + $item->{for};
114 12 100       26 if ( $item->{in_seconds} )
115             {
116 10         19 $at *= $SR;
117 10         35 $to *= $SR;
118             }
119 12         43 push @insrs, [ int $at, 'note_on', @$item{qw/preset note vel/} ];
120 12         37 push @insrs, [ int $to, 'note_off', @$item{qw/preset note vel/} ];
121             }
122              
123 8         56 @insrs = sort { $a->[0] <=> $b->[0] } @insrs;
  29         62  
124              
125 8         17 my $current_ts = 0;
126 8         19 my $soundfont = $self->soundfont;
127 8         28 my $tsf = $soundfont->_tsf;
128 8         27 foreach my $i ( 0 .. $#insrs )
129             {
130 24         41 my ( $ts, $fn, @args ) = @{ $insrs[$i] };
  24         88  
131 24         27862 $result .= $tsf->render( $ts - $current_ts );
132 24         319 $soundfont->$fn(@args);
133 24         80 $current_ts = $ts;
134             }
135              
136 8         20 my $cleanup_samples = 4096;
137 8         25 for ( 1 .. 256 )
138             {
139             last
140 16 100       74 if !$tsf->active_voices;
141 8         459 $result .= $tsf->render($cleanup_samples);
142             }
143              
144 8 100       31 if ( defined $old_vol )
145             {
146 2         53 $self->soundfont->volume($old_vol);
147             }
148              
149 8         3801 return $result;
150             }
151              
152             sub render_unpack
153             {
154 1     1 1 8 my $self = shift;
155              
156 1         4 return unpack( 's<*', $self->render(@_) );
157             }
158              
159             1;
160             __END__