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__ |