| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Music::Gestalt; |
|
2
|
|
|
|
|
|
|
|
|
3
|
9
|
|
|
9
|
|
251997
|
use warnings; |
|
|
9
|
|
|
|
|
21
|
|
|
|
9
|
|
|
|
|
292
|
|
|
4
|
9
|
|
|
9
|
|
45
|
use strict; |
|
|
9
|
|
|
|
|
21
|
|
|
|
9
|
|
|
|
|
426
|
|
|
5
|
|
|
|
|
|
|
use fields |
|
6
|
9
|
|
|
9
|
|
10107
|
qw (automation density duration notes note_length pitch_base pitch_extent pitches pitches_count pitches_mode pitches_mapping pitches_row_pos velocity_base velocity_extent); |
|
|
9
|
|
|
|
|
15295
|
|
|
|
9
|
|
|
|
|
55
|
|
|
7
|
9
|
|
|
9
|
|
1142
|
use 5.006; |
|
|
9
|
|
|
|
|
32
|
|
|
|
9
|
|
|
|
|
420
|
|
|
8
|
9
|
|
|
9
|
|
8788
|
use MIDI::Pitch qw(findsemitone); |
|
|
9
|
|
|
|
|
12944
|
|
|
|
9
|
|
|
|
|
50184
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Music::Gestalt - Compose music using gestalts. |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 VERSION |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Version 0.06 |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=cut |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $VERSION = '0.06'; |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use Music::Gestalt; |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# see below |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
This module helps to compose music using musical gestalts (forms). A gestalt is |
|
31
|
|
|
|
|
|
|
similar to a list in L format, but so far it only supports note |
|
32
|
|
|
|
|
|
|
events, and all parameters are expressed as values between 0 and 1. This allows |
|
33
|
|
|
|
|
|
|
for more flexible transformations of the musical material. |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head2 C |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my $g = Music::Gestalt->new(score => $score); |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
Creates a new Music::Gestalt object. The optional score argument receives |
|
42
|
|
|
|
|
|
|
a score in L format. |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=cut |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub new { |
|
47
|
136
|
|
|
136
|
1
|
298389
|
my $class = shift; |
|
48
|
136
|
|
|
|
|
387
|
my %params = @_; |
|
49
|
136
|
|
|
|
|
444
|
my $self = fields::new($class); |
|
50
|
|
|
|
|
|
|
|
|
51
|
136
|
|
|
|
|
42962
|
$self->{pitches_count} = 0; |
|
52
|
136
|
|
|
|
|
241
|
$self->{pitches_mode} = 'all'; |
|
53
|
136
|
|
|
|
|
212
|
$self->{density} = 1; |
|
54
|
136
|
|
|
|
|
204
|
$self->{note_length} = 1; |
|
55
|
136
|
100
|
|
|
|
693
|
$self->_InitializeFromScore($params{score}) |
|
56
|
|
|
|
|
|
|
if (ref $params{score} eq 'ARRAY'); |
|
57
|
136
|
|
|
|
|
378
|
$self->_PitchesUpdateMapping(); |
|
58
|
|
|
|
|
|
|
|
|
59
|
136
|
|
|
|
|
2313
|
return $self; |
|
60
|
|
|
|
|
|
|
} |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# private methods |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub _InitializeFromScore { |
|
65
|
132
|
|
|
132
|
|
191
|
my ($self, $score) = @_; |
|
66
|
|
|
|
|
|
|
|
|
67
|
132
|
|
|
|
|
189
|
my ($max_time, $min_pitch, $max_pitch, $min_velocity, $max_velocity); |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# find min/max values |
|
70
|
|
|
|
|
|
|
# #0: 'note' |
|
71
|
|
|
|
|
|
|
# #1: start time |
|
72
|
|
|
|
|
|
|
# #2: duration |
|
73
|
|
|
|
|
|
|
# #3: channel |
|
74
|
|
|
|
|
|
|
# #4: note |
|
75
|
|
|
|
|
|
|
# #5: velocity |
|
76
|
132
|
|
|
|
|
262
|
foreach (@$score) { |
|
77
|
1230
|
50
|
|
|
|
2453
|
next unless $_->[0] eq 'note'; |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# min_time is always 0 |
|
80
|
1230
|
100
|
100
|
|
|
4920
|
$max_time = $_->[1] + $_->[2] |
|
81
|
|
|
|
|
|
|
if (!defined $max_time || $_->[1] + $_->[2] > $max_time); |
|
82
|
1230
|
100
|
100
|
|
|
4151
|
$min_pitch = $_->[4] |
|
83
|
|
|
|
|
|
|
if (!defined $min_pitch || $_->[4] < $min_pitch); |
|
84
|
1230
|
100
|
100
|
|
|
3943
|
$max_pitch = $_->[4] |
|
85
|
|
|
|
|
|
|
if (!defined $max_pitch || $_->[4] > $max_pitch); |
|
86
|
1230
|
100
|
100
|
|
|
4045
|
$min_velocity = $_->[5] |
|
87
|
|
|
|
|
|
|
if (!defined $min_velocity || $_->[5] < $min_velocity); |
|
88
|
1230
|
100
|
100
|
|
|
4500
|
$max_velocity = $_->[5] |
|
89
|
|
|
|
|
|
|
if (!defined $max_velocity || $_->[5] > $max_velocity); |
|
90
|
|
|
|
|
|
|
} |
|
91
|
|
|
|
|
|
|
|
|
92
|
132
|
|
|
|
|
267
|
$self->{pitch_base} = $min_pitch; |
|
93
|
132
|
100
|
66
|
|
|
577
|
$self->{pitch_extent} = defined $min_pitch |
|
94
|
|
|
|
|
|
|
&& defined $max_pitch ? $max_pitch - $min_pitch : undef; |
|
95
|
132
|
|
|
|
|
177
|
$self->{velocity_base} = $min_velocity; |
|
96
|
132
|
100
|
66
|
|
|
516
|
$self->{velocity_extent} = defined $min_velocity |
|
97
|
|
|
|
|
|
|
&& defined $max_velocity ? $max_velocity - $min_velocity : undef; |
|
98
|
132
|
|
100
|
|
|
305
|
$self->{duration} = $max_time || 0; |
|
99
|
132
|
|
|
|
|
266
|
$self->{notes} = []; |
|
100
|
|
|
|
|
|
|
|
|
101
|
132
|
100
|
66
|
|
|
597
|
return if (!defined $max_time || $max_time == 0); |
|
102
|
|
|
|
|
|
|
|
|
103
|
129
|
|
|
|
|
198
|
my @notes = (); |
|
104
|
129
|
|
|
|
|
166
|
my $pitch_extent = ($max_pitch - $min_pitch); |
|
105
|
129
|
|
|
|
|
160
|
my $velocity_extent = ($max_velocity - $min_velocity); |
|
106
|
129
|
|
|
|
|
303
|
foreach (@$score) { |
|
107
|
1230
|
50
|
|
|
|
2291
|
next unless $_->[0] eq 'note'; |
|
108
|
1230
|
100
|
|
|
|
5583
|
push @notes, |
|
|
|
100
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
[ |
|
110
|
|
|
|
|
|
|
$_->[1] / $max_time, |
|
111
|
|
|
|
|
|
|
$_->[2] / $max_time, |
|
112
|
|
|
|
|
|
|
($_->[3] - 1) / 15, |
|
113
|
|
|
|
|
|
|
$pitch_extent == 0 ? 0 : ($_->[4] - $min_pitch) / $pitch_extent, |
|
114
|
|
|
|
|
|
|
$velocity_extent == 0 ? 0 : |
|
115
|
|
|
|
|
|
|
($_->[5] - $min_velocity) / $velocity_extent]; |
|
116
|
|
|
|
|
|
|
} |
|
117
|
|
|
|
|
|
|
|
|
118
|
129
|
|
|
|
|
590
|
$self->{notes} = [@notes]; |
|
119
|
|
|
|
|
|
|
} |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub _min { |
|
122
|
7675
|
|
|
7675
|
|
13796
|
my ($a, $b) = @_; |
|
123
|
|
|
|
|
|
|
|
|
124
|
7675
|
100
|
|
|
|
19195
|
return $a < $b ? $a : $b; |
|
125
|
|
|
|
|
|
|
} |
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub _max { |
|
128
|
7679
|
|
|
7679
|
|
9811
|
my ($a, $b) = @_; |
|
129
|
|
|
|
|
|
|
|
|
130
|
7679
|
100
|
|
|
|
23261
|
return $a > $b ? $a : $b; |
|
131
|
|
|
|
|
|
|
} |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub _CalcAutomationValue { |
|
134
|
4165
|
|
|
4165
|
|
5742
|
my ($self, $param_name, $position, $value) = @_; |
|
135
|
|
|
|
|
|
|
|
|
136
|
4165
|
100
|
66
|
|
|
17420
|
return $value |
|
137
|
|
|
|
|
|
|
unless (ref $self->{automation}->{$param_name} eq 'HASH' |
|
138
|
|
|
|
|
|
|
&& ref $self->{automation}->{$param_name}->{values} eq 'ARRAY'); |
|
139
|
1120
|
|
|
|
|
1229
|
my %am = %{$self->{automation}->{$param_name}}; |
|
|
1120
|
|
|
|
|
4177
|
|
|
140
|
|
|
|
|
|
|
|
|
141
|
1120
|
|
|
|
|
1603
|
my $count = scalar @{$am{values}}; |
|
|
1120
|
|
|
|
|
1934
|
|
|
142
|
|
|
|
|
|
|
|
|
143
|
1120
|
100
|
|
|
|
2198
|
if ($count == 1) { |
|
144
|
1056
|
100
|
|
|
|
2954
|
if ($am{mode} eq 'absolute') { |
|
145
|
1040
|
|
|
|
|
3402
|
return $am{values}->[0]; |
|
146
|
|
|
|
|
|
|
} else { |
|
147
|
16
|
|
|
|
|
47
|
return $value * $am{values}->[0]; |
|
148
|
|
|
|
|
|
|
} |
|
149
|
|
|
|
|
|
|
} |
|
150
|
|
|
|
|
|
|
|
|
151
|
64
|
|
|
|
|
94
|
my $time_per_value = 1 / ($count - 1); |
|
152
|
64
|
|
|
|
|
81
|
my $div = $position / $time_per_value; |
|
153
|
64
|
|
|
|
|
69
|
my $idx = int($div); |
|
154
|
64
|
|
|
|
|
78
|
my $frac = $div - $idx; |
|
155
|
64
|
|
|
|
|
88
|
my $base = $am{values}->[$idx]; |
|
156
|
64
|
|
|
|
|
87
|
my $extent = $am{values}->[$idx + 1] - $base; |
|
157
|
64
|
|
|
|
|
88
|
my $val = $base + $frac * $extent; |
|
158
|
|
|
|
|
|
|
|
|
159
|
64
|
100
|
|
|
|
122
|
if ($am{mode} eq 'absolute') { |
|
160
|
32
|
|
|
|
|
88
|
return $val; |
|
161
|
|
|
|
|
|
|
} else { |
|
162
|
32
|
|
|
|
|
94
|
return $value * $val; |
|
163
|
|
|
|
|
|
|
} |
|
164
|
|
|
|
|
|
|
} |
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub _CalcPitch { |
|
167
|
3605
|
|
|
3605
|
|
4959
|
my ($self, $v, $pos) = @_; |
|
168
|
|
|
|
|
|
|
|
|
169
|
3605
|
|
|
|
|
4684
|
my $pb = $self->{pitch_base}; |
|
170
|
3605
|
|
|
|
|
4694
|
my $pe = $self->{pitch_extent}; |
|
171
|
|
|
|
|
|
|
|
|
172
|
3605
|
100
|
|
|
|
10061
|
if (ref $self->{automation}->{pitch_middle}->{values} eq 'ARRAY') { |
|
173
|
560
|
|
|
|
|
933
|
my $pm = $self->PitchMiddle(); |
|
174
|
560
|
|
|
|
|
2993
|
$pb += $self->_CalcAutomationValue('pitch_middle', $pos, $pm) - $pm; |
|
175
|
|
|
|
|
|
|
} |
|
176
|
|
|
|
|
|
|
|
|
177
|
3605
|
|
|
|
|
5419
|
my $val = $pb + $v * $pe + 0.5; |
|
178
|
3605
|
|
|
|
|
8868
|
$val = _max(0, _min(int($val), 127)); |
|
179
|
|
|
|
|
|
|
|
|
180
|
3605
|
|
|
|
|
7312
|
my $pitch = $self->{pitches_mapping}->{$val}; |
|
181
|
3605
|
50
|
33
|
|
|
16102
|
if ($self->{pitches_mode} eq 'row' && ref $self->{pitches} eq 'ARRAY') { |
|
182
|
0
|
|
|
|
|
0
|
$pitch = |
|
183
|
|
|
|
|
|
|
findsemitone($self->{pitches}->[$self->{pitches_row_pos}], $pitch); |
|
184
|
0
|
|
|
|
|
0
|
$self->{pitches_row_pos} = |
|
185
|
0
|
|
|
|
|
0
|
($self->{pitches_row_pos} + 1) % scalar @{$self->{pitches}}; |
|
186
|
|
|
|
|
|
|
} |
|
187
|
3605
|
|
|
|
|
11311
|
return $pitch; |
|
188
|
|
|
|
|
|
|
} |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub _CalcVelocity { |
|
191
|
3605
|
|
|
3605
|
|
4645
|
my ($self, $v, $pos) = @_; |
|
192
|
|
|
|
|
|
|
|
|
193
|
3605
|
|
|
|
|
10044
|
my $val = |
|
194
|
|
|
|
|
|
|
$self->_CalcAutomationValue('velocity', $pos, |
|
195
|
|
|
|
|
|
|
$self->{velocity_base} + $v * $self->{velocity_extent} + 0.5); |
|
196
|
3605
|
|
|
|
|
7455
|
return _max(0, _min(int($val), 127)); |
|
197
|
|
|
|
|
|
|
} |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head1 PROPERTIES |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=head2 C |
|
202
|
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
Sets (if you pass a value) and returns lowest pitch used in this gestalt. |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=cut |
|
206
|
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub PitchLowest { |
|
208
|
25
|
|
|
25
|
1
|
3318
|
my ($self, $v) = @_; |
|
209
|
|
|
|
|
|
|
|
|
210
|
25
|
100
|
|
|
|
63
|
if (defined $v) { |
|
211
|
5
|
|
|
|
|
19
|
$v = _max(0, _min($self->{pitch_base} + $self->{pitch_extent}, $v)); |
|
212
|
5
|
|
|
|
|
14
|
$self->{pitch_extent} = |
|
213
|
|
|
|
|
|
|
$self->{pitch_base} + $self->{pitch_extent} - $v; |
|
214
|
5
|
|
|
|
|
6
|
$self->{pitch_base} = $v; |
|
215
|
|
|
|
|
|
|
} |
|
216
|
|
|
|
|
|
|
|
|
217
|
25
|
|
|
|
|
89
|
return $self->{pitch_base}; |
|
218
|
|
|
|
|
|
|
} |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=head2 C |
|
221
|
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
Sets (if you pass a value) and returns highest pitch used in this gestalt. |
|
223
|
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=cut |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub PitchHighest { |
|
227
|
22
|
|
|
22
|
1
|
1561
|
my ($self, $v) = @_; |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
return undef |
|
230
|
22
|
100
|
66
|
|
|
120
|
unless defined $self->{pitch_base} && defined $self->{pitch_extent}; |
|
231
|
|
|
|
|
|
|
|
|
232
|
16
|
100
|
|
|
|
39
|
if (defined $v) { |
|
233
|
5
|
|
|
|
|
18
|
$v = _min(127, _max($self->{pitch_base}, $v)); |
|
234
|
5
|
|
|
|
|
12
|
$self->{pitch_extent} = $v - $self->{pitch_base}; |
|
235
|
|
|
|
|
|
|
} |
|
236
|
|
|
|
|
|
|
|
|
237
|
16
|
|
|
|
|
64
|
return $self->{pitch_base} + $self->{pitch_extent}; |
|
238
|
|
|
|
|
|
|
} |
|
239
|
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head2 C |
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Sets (if you pass a value) and returns middle pitch of the range used in this gestalt. |
|
243
|
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=cut |
|
245
|
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
sub PitchMiddle { |
|
247
|
702
|
|
|
702
|
1
|
884
|
my ($self, $v) = @_; |
|
248
|
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
return undef |
|
250
|
702
|
100
|
66
|
|
|
3538
|
unless defined $self->{pitch_base} && defined $self->{pitch_extent}; |
|
251
|
|
|
|
|
|
|
|
|
252
|
701
|
100
|
|
|
|
1258
|
if (defined $v) { |
|
253
|
136
|
|
|
|
|
231
|
$v = _min(_max($v, 0), 127); |
|
254
|
136
|
|
|
|
|
909
|
my $pm_old = (2 * $self->{pitch_base} + $self->{pitch_extent}) / 2; |
|
255
|
136
|
|
|
|
|
267
|
$self->{pitch_base} += $v - $pm_old; |
|
256
|
|
|
|
|
|
|
} |
|
257
|
|
|
|
|
|
|
|
|
258
|
701
|
|
|
|
|
1691
|
return (2 * $self->{pitch_base} + $self->{pitch_extent}) / 2; |
|
259
|
|
|
|
|
|
|
} |
|
260
|
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head2 C |
|
262
|
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
Returns the pitch range used in this gestalt, ie. the pitches that occur |
|
264
|
|
|
|
|
|
|
will be between pitch middle +/- pitch range. |
|
265
|
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
If you pass a value as parameter, the new pitch range will be calculated |
|
267
|
|
|
|
|
|
|
around the current pitch middle. |
|
268
|
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=cut |
|
270
|
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
sub PitchRange { |
|
272
|
9
|
|
|
9
|
1
|
1460
|
my ($self, $value) = @_; |
|
273
|
|
|
|
|
|
|
|
|
274
|
9
|
100
|
|
|
|
36
|
return undef unless defined $self->{pitch_base}; |
|
275
|
|
|
|
|
|
|
|
|
276
|
8
|
100
|
|
|
|
24
|
if (defined $value) { |
|
277
|
3
|
|
|
|
|
6
|
my $old_range = $self->{pitch_extent} / 2; |
|
278
|
3
|
|
|
|
|
6
|
$self->{pitch_extent} = 2 * $value; |
|
279
|
3
|
|
|
|
|
8
|
$self->{pitch_base} += $old_range - $value; |
|
280
|
|
|
|
|
|
|
} |
|
281
|
|
|
|
|
|
|
|
|
282
|
8
|
50
|
|
|
|
30
|
return undef unless defined $self->{pitch_extent}; |
|
283
|
8
|
|
|
|
|
47
|
return $self->{pitch_extent} / 2; |
|
284
|
|
|
|
|
|
|
} |
|
285
|
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=head2 C |
|
287
|
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
Sets (if you pass a value) and returns lowest velocity used in this gestalt. |
|
289
|
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=cut |
|
291
|
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub VelocityLowest { |
|
293
|
25
|
|
|
25
|
1
|
1568
|
my ($self, $v) = @_; |
|
294
|
|
|
|
|
|
|
|
|
295
|
25
|
100
|
|
|
|
54
|
if (defined $v) { |
|
296
|
5
|
|
|
|
|
21
|
$v = |
|
297
|
|
|
|
|
|
|
_max(0, _min($self->{velocity_base} + $self->{velocity_extent}, $v)); |
|
298
|
5
|
|
|
|
|
14
|
$self->{velocity_extent} = |
|
299
|
|
|
|
|
|
|
$self->{velocity_base} + $self->{velocity_extent} - $v; |
|
300
|
5
|
|
|
|
|
10
|
$self->{velocity_base} = $v; |
|
301
|
|
|
|
|
|
|
} |
|
302
|
|
|
|
|
|
|
|
|
303
|
25
|
|
|
|
|
90
|
return $self->{velocity_base}; |
|
304
|
|
|
|
|
|
|
} |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=head2 C |
|
307
|
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
Sets (if you pass a value) and returns highest velocity used in this gestalt. |
|
309
|
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=cut |
|
311
|
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
sub VelocityHighest { |
|
313
|
22
|
|
|
22
|
1
|
1670
|
my ($self, $v) = @_; |
|
314
|
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
return undef |
|
316
|
22
|
100
|
66
|
|
|
119
|
unless defined $self->{velocity_base} && defined $self->{velocity_extent}; |
|
317
|
|
|
|
|
|
|
|
|
318
|
16
|
100
|
|
|
|
30
|
if (defined $v) { |
|
319
|
5
|
|
|
|
|
17
|
$v = _min(127, _max($self->{velocity_base}, $v)); |
|
320
|
5
|
|
|
|
|
13
|
$self->{velocity_extent} = $v - $self->{velocity_base}; |
|
321
|
|
|
|
|
|
|
} |
|
322
|
|
|
|
|
|
|
|
|
323
|
16
|
|
|
|
|
98
|
return $self->{velocity_base} + $self->{velocity_extent}; |
|
324
|
|
|
|
|
|
|
} |
|
325
|
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=head2 C |
|
327
|
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
Sets (if you pass a value) and returns middle velocity of the range used in this gestalt. |
|
329
|
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=cut |
|
331
|
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
sub VelocityMiddle { |
|
333
|
12
|
|
|
12
|
1
|
50
|
my ($self, $v) = @_; |
|
334
|
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
return undef |
|
336
|
12
|
100
|
66
|
|
|
87
|
unless defined $self->{velocity_base} && defined $self->{velocity_extent}; |
|
337
|
|
|
|
|
|
|
|
|
338
|
11
|
100
|
|
|
|
28
|
if (defined $v) { |
|
339
|
6
|
|
|
|
|
17
|
$v = _min(_max($v, 0), 127); |
|
340
|
6
|
|
|
|
|
22
|
my $vm_old = |
|
341
|
|
|
|
|
|
|
(2 * $self->{velocity_base} + $self->{velocity_extent}) / 2; |
|
342
|
6
|
|
|
|
|
14
|
$self->{velocity_base} += $v - $vm_old; |
|
343
|
|
|
|
|
|
|
} |
|
344
|
|
|
|
|
|
|
|
|
345
|
11
|
|
|
|
|
60
|
return (2 * $self->{velocity_base} + $self->{velocity_extent}) / 2; |
|
346
|
|
|
|
|
|
|
} |
|
347
|
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=head2 C |
|
349
|
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
Returns the velocity range used in this gestalt, ie. the velocities that occur |
|
351
|
|
|
|
|
|
|
will be between velocity middle +/- velocity range. |
|
352
|
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
If you pass a value as parameter, the new velocity range will be calculated |
|
354
|
|
|
|
|
|
|
around the current velocity middle. |
|
355
|
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=cut |
|
357
|
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub VelocityRange { |
|
359
|
9
|
|
|
9
|
1
|
1643
|
my ($self, $value) = @_; |
|
360
|
|
|
|
|
|
|
|
|
361
|
9
|
100
|
|
|
|
39
|
return undef unless defined $self->{velocity_base}; |
|
362
|
|
|
|
|
|
|
|
|
363
|
8
|
100
|
|
|
|
22
|
if (defined $value) { |
|
364
|
3
|
|
|
|
|
7
|
my $old_range = $self->{velocity_extent} / 2; |
|
365
|
3
|
|
|
|
|
6
|
$self->{velocity_extent} = 2 * $value; |
|
366
|
3
|
|
|
|
|
8
|
$self->{velocity_base} += $old_range - $value; |
|
367
|
|
|
|
|
|
|
} |
|
368
|
|
|
|
|
|
|
|
|
369
|
8
|
50
|
|
|
|
74
|
return undef unless defined $self->{velocity_extent}; |
|
370
|
8
|
|
|
|
|
41
|
return $self->{velocity_extent} / 2; |
|
371
|
|
|
|
|
|
|
} |
|
372
|
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=head2 C |
|
374
|
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
Returns the duration of this gestalt. |
|
376
|
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
If you pass a value as a parameter, it will be used as new duration. |
|
378
|
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=cut |
|
380
|
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub Duration { |
|
382
|
17
|
|
|
17
|
1
|
27
|
my ($self, $v) = @_; |
|
383
|
|
|
|
|
|
|
|
|
384
|
17
|
50
|
|
|
|
38
|
$self->{duration} = _max(0, $v) if defined $v; |
|
385
|
17
|
|
100
|
|
|
102
|
return $self->{duration} || 0; |
|
386
|
|
|
|
|
|
|
} |
|
387
|
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=head2 C |
|
389
|
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Returns the note length property of this gestalt. "1" means that the |
|
391
|
|
|
|
|
|
|
original note lengths are retained, ".5" means that each note is half |
|
392
|
|
|
|
|
|
|
as long as it originally was. |
|
393
|
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
If you pass a value as a parameter, it will be used as new note length. |
|
395
|
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=cut |
|
397
|
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
sub NoteLength { |
|
399
|
5
|
|
|
5
|
1
|
1519
|
my ($self, $v) = @_; |
|
400
|
|
|
|
|
|
|
|
|
401
|
5
|
100
|
|
|
|
19
|
$self->{note_length} = _max(0, $v) if defined $v; |
|
402
|
5
|
|
100
|
|
|
31
|
return $self->{note_length} || 0; |
|
403
|
|
|
|
|
|
|
} |
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=head2 C |
|
406
|
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
Returns the note list of this gestalt. |
|
408
|
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=cut |
|
410
|
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
sub Notes { |
|
412
|
8
|
|
|
8
|
1
|
30
|
my $self = shift; |
|
413
|
|
|
|
|
|
|
|
|
414
|
8
|
100
|
|
|
|
31
|
return @{[]} unless ref $self->{notes} eq 'ARRAY'; |
|
|
4
|
|
|
|
|
21
|
|
|
415
|
4
|
|
|
|
|
5
|
return @{$self->{notes}}; |
|
|
4
|
|
|
|
|
18
|
|
|
416
|
|
|
|
|
|
|
} |
|
417
|
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=head2 C |
|
419
|
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Sets and returns the density of this gestalt. The initial density is 1, meaning |
|
421
|
|
|
|
|
|
|
that all notes will be used. At density 0, a score created from this gestalt |
|
422
|
|
|
|
|
|
|
will have no events. At density 0.5, a score created from this gestalt will |
|
423
|
|
|
|
|
|
|
have half the original events, selected at random. |
|
424
|
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
It is intentional that the density may not be greater than 1; there are too |
|
426
|
|
|
|
|
|
|
many possible ways to generate additional events. |
|
427
|
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
=cut |
|
429
|
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
sub Density { |
|
431
|
12
|
|
|
12
|
1
|
4003
|
my ($self, $v) = @_; |
|
432
|
|
|
|
|
|
|
|
|
433
|
12
|
100
|
|
|
|
44
|
$self->{density} = _min(1, _max(0, $v)) if defined $v; |
|
434
|
12
|
|
|
|
|
82
|
return $self->{density}; |
|
435
|
|
|
|
|
|
|
} |
|
436
|
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=head2 C |
|
438
|
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
Returns or sets the pitches used in this gestalt. You should pass a
reference to a list that contains the pitch numbers used. Returns a |
|
440
|
|
|
|
|
|
|
reference to a list of pitches that will be used. |
|
441
|
|
|
|
|
|
|
An empty list signifies that all pitches are used. |
|
442
|
|
|
|
|
|
|
Note that the set of pitches used is also influenced by the L"PitchesMode"> |
|
443
|
|
|
|
|
|
|
parameter. |
|
444
|
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=cut |
|
446
|
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
sub Pitches { |
|
448
|
0
|
|
|
0
|
1
|
0
|
my ($self, $pitches) = @_; |
|
449
|
0
|
0
|
0
|
|
|
0
|
if (defined $pitches && ref $pitches eq 'ARRAY') { |
|
450
|
0
|
|
|
|
|
0
|
$self->{pitches} = [map { _max(0, _min($_, 127)) } @$pitches]; |
|
|
0
|
|
|
|
|
0
|
|
|
451
|
0
|
|
|
|
|
0
|
$self->{pitches_count} = scalar @$pitches; |
|
452
|
0
|
|
|
|
|
0
|
$self->_PitchesUpdateMapping(); |
|
453
|
|
|
|
|
|
|
} |
|
454
|
|
|
|
|
|
|
|
|
455
|
0
|
0
|
|
|
|
0
|
if (defined $self->{pitches}) { return $pitches; } |
|
|
0
|
|
|
|
|
0
|
|
|
456
|
0
|
|
|
|
|
0
|
else { return []; } |
|
457
|
|
|
|
|
|
|
} |
|
458
|
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=head2 C |
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Returns or sets the pitch mode used in this gestalt. |
|
462
|
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
=cut |
|
464
|
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
sub _PitchesUpdateMapping { |
|
466
|
136
|
|
|
136
|
|
195
|
my ($self) = @_; |
|
467
|
|
|
|
|
|
|
|
|
468
|
136
|
50
|
33
|
|
|
451
|
if (ref $self->{pitches} eq 'ARRAY' && scalar @{$self->{pitches}} > 0) { |
|
|
0
|
|
|
|
|
0
|
|
|
469
|
0
|
|
|
|
|
0
|
my %map; |
|
470
|
0
|
0
|
|
|
|
0
|
if ($self->{pitches_mode} eq 'nearest') { |
|
471
|
0
|
0
|
|
|
|
0
|
if (scalar @{$self->{pitches}} == 1) { |
|
|
0
|
|
|
|
|
0
|
|
|
472
|
0
|
|
|
|
|
0
|
%map = map { $_ => $self->{pitches}->[0] } 0 .. 127; |
|
|
0
|
|
|
|
|
0
|
|
|
473
|
0
|
|
|
|
|
0
|
return $self->{pitches_mapping} = {%map}; |
|
474
|
|
|
|
|
|
|
} |
|
475
|
|
|
|
|
|
|
|
|
476
|
0
|
|
|
|
|
0
|
my @list = sort { $a <=> $b } @{$self->{pitches}}; |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
477
|
0
|
|
|
|
|
0
|
my $idx = 0; |
|
478
|
0
|
|
|
|
|
0
|
for (0 .. 127) { |
|
479
|
0
|
|
|
|
|
0
|
my $diffA = abs($list[$idx] - $_); |
|
480
|
0
|
|
|
|
|
0
|
my $diffB = abs($list[$idx + 1] - $_); |
|
481
|
|
|
|
|
|
|
|
|
482
|
0
|
0
|
|
|
|
0
|
if ($diffA < $diffB) { |
|
483
|
0
|
|
|
|
|
0
|
$map{$_} = $list[$idx]; |
|
484
|
|
|
|
|
|
|
} else { |
|
485
|
0
|
|
|
|
|
0
|
$map{$_} = $list[$idx + 1]; |
|
486
|
0
|
0
|
|
|
|
0
|
$idx++ if ($idx < $#list); |
|
487
|
|
|
|
|
|
|
} |
|
488
|
|
|
|
|
|
|
} |
|
489
|
0
|
|
|
|
|
0
|
return $self->{pitches_mapping} = {%map}; |
|
490
|
|
|
|
|
|
|
} |
|
491
|
|
|
|
|
|
|
} |
|
492
|
|
|
|
|
|
|
|
|
493
|
136
|
|
|
|
|
298
|
$self->{pitches_mapping} = {map { $_ => $_ } 0 .. 127}; |
|
|
17408
|
|
|
|
|
32794
|
|
|
494
|
|
|
|
|
|
|
} |
|
495
|
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
sub PitchesMode { |
|
497
|
0
|
|
|
0
|
1
|
0
|
my ($self, $mode) = @_; |
|
498
|
|
|
|
|
|
|
|
|
499
|
0
|
0
|
|
|
|
0
|
if (defined $mode) { |
|
500
|
0
|
|
|
|
|
0
|
$self->{pitches_mode} = $mode; |
|
501
|
0
|
|
|
|
|
0
|
$self->_PitchesUpdateMapping(); |
|
502
|
|
|
|
|
|
|
} |
|
503
|
0
|
|
|
|
|
0
|
return $self->{pitches_mode}; |
|
504
|
|
|
|
|
|
|
} |
|
505
|
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=head1 METHODS |
|
507
|
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
=head2 C |
|
509
|
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
Returns a structure representing the gestalt in L format. |
|
511
|
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=cut |
|
513
|
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
sub AsScore { |
|
515
|
588
|
|
|
588
|
1
|
1999
|
my $self = shift; |
|
516
|
|
|
|
|
|
|
|
|
517
|
588
|
100
|
|
|
|
1489
|
return [] if $self->{density} == 0; |
|
518
|
|
|
|
|
|
|
|
|
519
|
587
|
|
|
|
|
849
|
my @score = (); |
|
520
|
587
|
|
|
|
|
877
|
$self->{pitches_row_pos} = 0; |
|
521
|
587
|
|
|
|
|
751
|
foreach (@{$self->{notes}}) { |
|
|
587
|
|
|
|
|
1467
|
|
|
522
|
3605
|
|
|
|
|
17506
|
push @score, |
|
523
|
|
|
|
|
|
|
[ |
|
524
|
|
|
|
|
|
|
'note', |
|
525
|
|
|
|
|
|
|
$_->[0] * $self->{duration}, |
|
526
|
|
|
|
|
|
|
$_->[1] * $self->{duration} * $self->{note_length}, |
|
527
|
|
|
|
|
|
|
int(($_->[2] * 15 + 0.5) + 1), |
|
528
|
|
|
|
|
|
|
$self->_CalcPitch($_->[3], $_->[0]), |
|
529
|
|
|
|
|
|
|
$self->_CalcVelocity($_->[4], $_->[0])]; |
|
530
|
|
|
|
|
|
|
} |
|
531
|
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
# remove events if density < 1 |
|
533
|
587
|
100
|
|
|
|
1582
|
if ($self->{density} < 1) { |
|
534
|
7
|
|
|
|
|
20
|
for (1 .. int((1 - $self->{density}) * scalar @score)) { |
|
535
|
28
|
|
|
|
|
134
|
splice @score, int(rand(scalar @score)), 1; |
|
536
|
|
|
|
|
|
|
} |
|
537
|
|
|
|
|
|
|
} |
|
538
|
|
|
|
|
|
|
|
|
539
|
587
|
|
|
|
|
2633
|
return [@score]; |
|
540
|
|
|
|
|
|
|
} |
|
541
|
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=head2 C |
|
543
|
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
Appends other Music::Gestalt objects to this object. |
|
545
|
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
=cut |
|
547
|
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
sub Append { |
|
549
|
5
|
|
|
5
|
1
|
1883
|
my $self = shift; |
|
550
|
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
# 1. Find out lowest/highest pitch and velocity overall |
|
552
|
5
|
|
|
|
|
52
|
my $pitch_lowest = $self->PitchLowest(); |
|
553
|
5
|
|
|
|
|
14
|
my $pitch_highest = $self->PitchHighest(); |
|
554
|
5
|
|
|
|
|
13
|
my $velocity_lowest = $self->VelocityLowest(); |
|
555
|
5
|
|
|
|
|
13
|
my $velocity_highest = $self->VelocityHighest(); |
|
556
|
5
|
|
100
|
|
|
15
|
my $duration = $self->Duration() || 0; |
|
557
|
|
|
|
|
|
|
|
|
558
|
5
|
|
|
|
|
10
|
@_ = grep { UNIVERSAL::isa($_, 'Music::Gestalt') } @_; |
|
|
5
|
|
|
|
|
33
|
|
|
559
|
5
|
|
|
|
|
13
|
foreach (@_) { |
|
560
|
3
|
100
|
66
|
|
|
15
|
$pitch_lowest = $_->PitchLowest() |
|
561
|
|
|
|
|
|
|
if (!defined $pitch_lowest || $_->PitchLowest() < $pitch_lowest); |
|
562
|
3
|
50
|
66
|
|
|
14
|
$pitch_highest = $_->PitchHighest() |
|
563
|
|
|
|
|
|
|
if (!defined $pitch_highest |
|
564
|
|
|
|
|
|
|
|| $_->PitchHighest() > $pitch_highest); |
|
565
|
3
|
100
|
66
|
|
|
14
|
$velocity_lowest = $_->VelocityLowest() |
|
566
|
|
|
|
|
|
|
if (!defined $velocity_lowest |
|
567
|
|
|
|
|
|
|
|| $_->VelocityLowest() < $velocity_lowest); |
|
568
|
3
|
50
|
66
|
|
|
14
|
$velocity_highest = $_->VelocityHighest() |
|
569
|
|
|
|
|
|
|
if (!defined $velocity_highest |
|
570
|
|
|
|
|
|
|
|| $_->VelocityHighest() > $velocity_highest); |
|
571
|
3
|
|
|
|
|
8
|
$duration += $_->Duration; |
|
572
|
|
|
|
|
|
|
} |
|
573
|
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
return |
|
575
|
5
|
50
|
66
|
|
|
30
|
if ( !defined $pitch_lowest |
|
|
|
|
33
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
576
|
|
|
|
|
|
|
|| !defined $pitch_highest |
|
577
|
|
|
|
|
|
|
|| !defined $velocity_lowest |
|
578
|
|
|
|
|
|
|
|| !defined $velocity_highest); |
|
579
|
|
|
|
|
|
|
|
|
580
|
2
|
|
|
|
|
4
|
my $pitch_extent = $pitch_highest - $pitch_lowest; |
|
581
|
2
|
|
|
|
|
5
|
my $velocity_extent = $velocity_highest - $velocity_lowest; |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
# 2. Transform notes in this gestalt to new pitch |
|
584
|
2
|
|
|
|
|
2
|
foreach (@{$self->{notes}}) { |
|
|
2
|
|
|
|
|
6
|
|
|
585
|
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
# start time, duration, pitch, velocity |
|
587
|
2
|
|
|
|
|
7
|
$_->[0] = $_->[0] * $self->{duration} / $duration; |
|
588
|
2
|
|
|
|
|
6
|
$_->[1] = $_->[1] * $self->{duration} / $duration; |
|
589
|
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
# channel stays as it is |
|
591
|
2
|
50
|
|
|
|
9
|
$_->[3] = |
|
592
|
|
|
|
|
|
|
$pitch_extent == 0 ? 0 : |
|
593
|
|
|
|
|
|
|
( |
|
594
|
|
|
|
|
|
|
( |
|
595
|
|
|
|
|
|
|
$self->{pitch_base} - $pitch_lowest + $self->{pitch_extent} * |
|
596
|
|
|
|
|
|
|
$_->[3]) / $pitch_extent); |
|
597
|
2
|
50
|
|
|
|
9
|
$_->[4] = |
|
598
|
|
|
|
|
|
|
$velocity_extent == 0 ? 0 : |
|
599
|
|
|
|
|
|
|
( |
|
600
|
|
|
|
|
|
|
( |
|
601
|
|
|
|
|
|
|
$self->{velocity_base} - $velocity_lowest + |
|
602
|
|
|
|
|
|
|
$self->{velocity_extent} * $_->[4]) / $velocity_extent); |
|
603
|
|
|
|
|
|
|
} |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
# 3. Transform and append notes in the gestalts to be appended |
|
606
|
2
|
|
100
|
|
|
9
|
my $time_pos = $self->{duration} || 0; |
|
607
|
|
|
|
|
|
|
|
|
608
|
2
|
|
|
|
|
5
|
foreach my $g (@_) { |
|
609
|
2
|
|
|
|
|
4
|
my $time_delta = $time_pos / $duration; |
|
610
|
2
|
|
|
|
|
5
|
my $gpitchextent = $g->PitchHighest() - $g->PitchLowest(); |
|
611
|
2
|
|
|
|
|
6
|
my $gvelocityextent = $g->VelocityHighest() - $g->VelocityLowest(); |
|
612
|
2
|
|
|
|
|
7
|
my $dur = $g->Duration() / $duration; |
|
613
|
2
|
|
|
|
|
6
|
foreach ($g->Notes()) { |
|
614
|
4
|
50
|
|
|
|
5
|
push @{$self->{notes}}, |
|
|
4
|
50
|
|
|
|
22
|
|
|
615
|
|
|
|
|
|
|
[ |
|
616
|
|
|
|
|
|
|
$time_delta + ($_->[0] * $dur), |
|
617
|
|
|
|
|
|
|
$_->[1] * $dur, |
|
618
|
|
|
|
|
|
|
$_->[2], |
|
619
|
|
|
|
|
|
|
$pitch_extent == 0 ? 0 : |
|
620
|
|
|
|
|
|
|
( |
|
621
|
|
|
|
|
|
|
( |
|
622
|
|
|
|
|
|
|
$g->PitchLowest() - $pitch_lowest + $gpitchextent * |
|
623
|
|
|
|
|
|
|
$_->[3]) / $pitch_extent), |
|
624
|
|
|
|
|
|
|
$velocity_extent == 0 ? 0 : |
|
625
|
|
|
|
|
|
|
( |
|
626
|
|
|
|
|
|
|
( |
|
627
|
|
|
|
|
|
|
$g->VelocityLowest() - $velocity_lowest + |
|
628
|
|
|
|
|
|
|
$gvelocityextent * $_->[4]) / $velocity_extent)]; |
|
629
|
|
|
|
|
|
|
} |
|
630
|
2
|
|
|
|
|
6
|
$time_pos += $g->Duration(); |
|
631
|
|
|
|
|
|
|
} |
|
632
|
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
# 4. Save new attributes in this gestalt |
|
634
|
2
|
|
|
|
|
4
|
$self->{pitch_base} = $pitch_lowest; |
|
635
|
2
|
|
|
|
|
4
|
$self->{pitch_extent} = $pitch_extent; |
|
636
|
2
|
|
|
|
|
3
|
$self->{velocity_base} = $velocity_lowest; |
|
637
|
2
|
|
|
|
|
4
|
$self->{velocity_extent} = $velocity_extent; |
|
638
|
2
|
|
|
|
|
7
|
$self->{duration} = $duration; |
|
639
|
|
|
|
|
|
|
} |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
=head2 C |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
Inserts other Music::Gestalt objects into this object. |
|
644
|
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
=cut |
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
sub Insert { |
|
648
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
649
|
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
# 1. Find out lowest/highest pitch and velocity overall |
|
651
|
0
|
|
|
|
|
0
|
my $pitch_lowest = $self->PitchLowest(); |
|
652
|
0
|
|
|
|
|
0
|
my $pitch_highest = $self->PitchHighest(); |
|
653
|
0
|
|
|
|
|
0
|
my $velocity_lowest = $self->VelocityLowest(); |
|
654
|
0
|
|
|
|
|
0
|
my $velocity_highest = $self->VelocityHighest(); |
|
655
|
0
|
|
0
|
|
|
0
|
my $duration = $self->Duration() || 0; |
|
656
|
|
|
|
|
|
|
|
|
657
|
0
|
|
|
|
|
0
|
@_ = grep { UNIVERSAL::isa($_, 'Music::Gestalt') } @_; |
|
|
0
|
|
|
|
|
0
|
|
|
658
|
0
|
|
|
|
|
0
|
foreach (@_) { |
|
659
|
0
|
0
|
0
|
|
|
0
|
$pitch_lowest = $_->PitchLowest() |
|
660
|
|
|
|
|
|
|
if (!defined $pitch_lowest || $_->PitchLowest() < $pitch_lowest); |
|
661
|
0
|
0
|
0
|
|
|
0
|
$pitch_highest = $_->PitchHighest() |
|
662
|
|
|
|
|
|
|
if (!defined $pitch_highest |
|
663
|
|
|
|
|
|
|
|| $_->PitchHighest() > $pitch_highest); |
|
664
|
0
|
0
|
0
|
|
|
0
|
$velocity_lowest = $_->VelocityLowest() |
|
665
|
|
|
|
|
|
|
if (!defined $velocity_lowest |
|
666
|
|
|
|
|
|
|
|| $_->VelocityLowest() < $velocity_lowest); |
|
667
|
0
|
0
|
0
|
|
|
0
|
$velocity_highest = $_->VelocityHighest() |
|
668
|
|
|
|
|
|
|
if (!defined $velocity_highest |
|
669
|
|
|
|
|
|
|
|| $_->VelocityHighest() > $velocity_highest); |
|
670
|
0
|
0
|
|
|
|
0
|
$duration = $_->Duration() if $_->Duration() > $duration; |
|
671
|
|
|
|
|
|
|
} |
|
672
|
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
return |
|
674
|
0
|
0
|
0
|
|
|
0
|
if ( !defined $pitch_lowest |
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
675
|
|
|
|
|
|
|
|| !defined $pitch_highest |
|
676
|
|
|
|
|
|
|
|| !defined $velocity_lowest |
|
677
|
|
|
|
|
|
|
|| !defined $velocity_highest); |
|
678
|
|
|
|
|
|
|
|
|
679
|
0
|
|
|
|
|
0
|
my $pitch_extent = $pitch_highest - $pitch_lowest; |
|
680
|
0
|
|
|
|
|
0
|
my $velocity_extent = $velocity_highest - $velocity_lowest; |
|
681
|
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
# 2. Transform notes in this gestalt to new pitch |
|
683
|
0
|
|
|
|
|
0
|
foreach (@{$self->{notes}}) { |
|
|
0
|
|
|
|
|
0
|
|
|
684
|
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
# start time, duration, pitch, velocity |
|
686
|
0
|
|
|
|
|
0
|
$_->[0] = $_->[0] * $self->{duration} / $duration; |
|
687
|
0
|
|
|
|
|
0
|
$_->[1] = $_->[1] * $self->{duration} / $duration; |
|
688
|
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
# channel stays as it is |
|
690
|
0
|
0
|
|
|
|
0
|
$_->[3] = |
|
691
|
|
|
|
|
|
|
$pitch_extent == 0 ? 0 : |
|
692
|
|
|
|
|
|
|
( |
|
693
|
|
|
|
|
|
|
( |
|
694
|
|
|
|
|
|
|
$self->{pitch_base} - $pitch_lowest + $self->{pitch_extent} * |
|
695
|
|
|
|
|
|
|
$_->[3]) / $pitch_extent); |
|
696
|
0
|
0
|
|
|
|
0
|
$_->[4] = |
|
697
|
|
|
|
|
|
|
$velocity_extent == 0 ? 0 : |
|
698
|
|
|
|
|
|
|
( |
|
699
|
|
|
|
|
|
|
( |
|
700
|
|
|
|
|
|
|
$self->{velocity_base} - $velocity_lowest + |
|
701
|
|
|
|
|
|
|
$self->{velocity_extent} * $_->[4]) / $velocity_extent); |
|
702
|
|
|
|
|
|
|
} |
|
703
|
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
# 3. Transform and insert notes in the gestalts to be inserted |
|
705
|
0
|
|
|
|
|
0
|
foreach my $g (@_) { |
|
706
|
0
|
|
|
|
|
0
|
my $gpitchextent = $g->PitchHighest() - $g->PitchLowest(); |
|
707
|
0
|
|
|
|
|
0
|
my $gvelocityextent = $g->VelocityHighest() - $g->VelocityLowest(); |
|
708
|
0
|
|
|
|
|
0
|
my $notes_pos = 0; |
|
709
|
0
|
|
|
|
|
0
|
my $dur = $g->Duration() / $duration; |
|
710
|
0
|
|
|
|
|
0
|
foreach ($g->Notes()) { |
|
711
|
|
|
|
|
|
|
|
|
712
|
0
|
|
|
|
|
0
|
my $start = $_->[0] * $dur; |
|
713
|
0
|
|
0
|
|
|
0
|
$notes_pos++ while ($notes_pos <= $#{$self->{notes}} |
|
|
0
|
|
|
|
|
0
|
|
|
714
|
|
|
|
|
|
|
&& $self->{notes}->[$notes_pos]->[0] <= $start); |
|
715
|
0
|
0
|
|
|
|
0
|
splice @{$self->{notes}}, $notes_pos, 0, |
|
|
0
|
0
|
|
|
|
0
|
|
|
716
|
|
|
|
|
|
|
[ |
|
717
|
|
|
|
|
|
|
$_->[0] * $dur, |
|
718
|
|
|
|
|
|
|
$_->[1] * $dur, |
|
719
|
|
|
|
|
|
|
$_->[2], |
|
720
|
|
|
|
|
|
|
$pitch_extent == 0 ? 0 : |
|
721
|
|
|
|
|
|
|
( |
|
722
|
|
|
|
|
|
|
( |
|
723
|
|
|
|
|
|
|
$g->PitchLowest() - $pitch_lowest + $gpitchextent * |
|
724
|
|
|
|
|
|
|
$_->[3]) / $pitch_extent), |
|
725
|
|
|
|
|
|
|
$velocity_extent == 0 ? 0 : |
|
726
|
|
|
|
|
|
|
( |
|
727
|
|
|
|
|
|
|
( |
|
728
|
|
|
|
|
|
|
$g->VelocityLowest() - $velocity_lowest + |
|
729
|
|
|
|
|
|
|
$gvelocityextent * $_->[4]) / $velocity_extent)]; |
|
730
|
|
|
|
|
|
|
} |
|
731
|
|
|
|
|
|
|
} |
|
732
|
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
# 4. Save new attributes in this gestalt |
|
734
|
0
|
|
|
|
|
0
|
$self->{pitch_base} = $pitch_lowest; |
|
735
|
0
|
|
|
|
|
0
|
$self->{pitch_extent} = $pitch_extent; |
|
736
|
0
|
|
|
|
|
0
|
$self->{velocity_base} = $velocity_lowest; |
|
737
|
0
|
|
|
|
|
0
|
$self->{velocity_extent} = $velocity_extent; |
|
738
|
0
|
|
|
|
|
0
|
$self->{duration} = $duration; |
|
739
|
|
|
|
|
|
|
} |
|
740
|
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
=head2 C, C, C |
|
742
|
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
Mirrors the start times, pitches and velocites found in the gestalt. |
|
744
|
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=cut |
|
746
|
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
sub _mirror { |
|
748
|
30
|
|
|
30
|
|
46
|
my ($self, $param) = @_; |
|
749
|
|
|
|
|
|
|
|
|
750
|
30
|
50
|
|
|
|
83
|
return unless ref $self->{notes} eq 'ARRAY'; |
|
751
|
30
|
|
|
|
|
34
|
foreach (@{$self->{notes}}) { |
|
|
30
|
|
|
|
|
66
|
|
|
752
|
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
# die "\n\n\nparam = $param\n\n\n"; |
|
754
|
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
# start time, duration, pitch, velocity |
|
756
|
1674
|
|
|
|
|
2273
|
$_->[$param] = 1 - $_->[$param]; |
|
757
|
|
|
|
|
|
|
} |
|
758
|
|
|
|
|
|
|
} |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
sub MirrorTime { |
|
761
|
10
|
|
|
10
|
1
|
42
|
my ($self) = @_; |
|
762
|
|
|
|
|
|
|
|
|
763
|
10
|
|
|
|
|
27
|
$self->_mirror(0); |
|
764
|
|
|
|
|
|
|
} |
|
765
|
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
sub MirrorPitch { |
|
767
|
10
|
|
|
10
|
1
|
15
|
my ($self) = @_; |
|
768
|
|
|
|
|
|
|
|
|
769
|
10
|
|
|
|
|
22
|
$self->_mirror(3); |
|
770
|
|
|
|
|
|
|
} |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
sub MirrorVelocity { |
|
773
|
10
|
|
|
10
|
1
|
17
|
my ($self) = @_; |
|
774
|
|
|
|
|
|
|
|
|
775
|
10
|
|
|
|
|
20
|
$self->_mirror(4); |
|
776
|
|
|
|
|
|
|
} |
|
777
|
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
=head1 AUTOMATION METHODS |
|
779
|
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
Using automation, you can vary a parameter over time (comparable to parameter |
|
781
|
|
|
|
|
|
|
automation in sequencers like Logic or Cubase). For each parameter that can be |
|
782
|
|
|
|
|
|
|
automated, there are three modes available: |
|
783
|
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
=over 4 |
|
785
|
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
=item Absolute mode |
|
787
|
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
In this mode, the currently set parameter values will be I with the |
|
789
|
|
|
|
|
|
|
values that you pass to the function. If you pass (0, 100), the parameter |
|
790
|
|
|
|
|
|
|
will range from 0 to 100 over the whole gestalt. If you pass (20, 50 20), the |
|
791
|
|
|
|
|
|
|
parameter will first rise from 20 to 50, then in the second half of the gestalt |
|
792
|
|
|
|
|
|
|
fall from 50 to 20. The parameter value is interpolated at the event's position. |
|
793
|
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=item Relative mode |
|
795
|
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
In this mode, the currently set parameter values will be I with the |
|
797
|
|
|
|
|
|
|
values that you pass to the function. If you pass (0, 1), the parameter |
|
798
|
|
|
|
|
|
|
will fade in over the whole gestalt. If you pass (.2, .5 .2), the |
|
799
|
|
|
|
|
|
|
parameter will first fade in from 20% to 50%, then in the second half of |
|
800
|
|
|
|
|
|
|
the gestalt fade out from 50% to 20%. The parameter value is interpolated |
|
801
|
|
|
|
|
|
|
at the event's position. |
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=item Off |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
Automation will not be applied. |
|
806
|
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=back |
|
808
|
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
Here are some examples how to call the automation functions: |
|
810
|
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
$g->AutomateVelocityOff(); # default |
|
812
|
|
|
|
|
|
|
$g->AutomateVelocityAbs(20, 50, 20); |
|
813
|
|
|
|
|
|
|
$g->AutomateVelocityRel(0, 1); |
|
814
|
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
The values passed to the automation methods will be applied evenly-spaced. |
|
816
|
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
The following automation methods are available: |
|
818
|
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=over 4 |
|
820
|
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
=item C, C, C |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=cut |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
sub AutomateVelocityOff { |
|
826
|
2
|
|
|
2
|
1
|
3
|
my $self = shift; |
|
827
|
|
|
|
|
|
|
|
|
828
|
2
|
|
|
|
|
10
|
delete $self->{automation}->{velocity}; |
|
829
|
|
|
|
|
|
|
} |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
sub AutomateVelocityAbs { |
|
832
|
135
|
|
|
135
|
1
|
205042
|
my $self = shift; |
|
833
|
135
|
100
|
|
|
|
359
|
if (scalar @_) { |
|
834
|
134
|
|
|
|
|
312
|
$self->{automation}->{velocity}->{mode} = 'absolute'; |
|
835
|
146
|
|
|
|
|
285
|
$self->{automation}->{velocity}->{values} = |
|
836
|
134
|
|
|
|
|
222
|
[map { _min(127, _max(0, $_)) } @_]; |
|
837
|
|
|
|
|
|
|
} |
|
838
|
|
|
|
|
|
|
|
|
839
|
135
|
|
|
|
|
385
|
return $self->{automation}->{velocity}; |
|
840
|
|
|
|
|
|
|
} |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
sub AutomateVelocityRel { |
|
843
|
7
|
|
|
7
|
1
|
1199
|
my $self = shift; |
|
844
|
7
|
100
|
|
|
|
36
|
if (scalar @_) { |
|
845
|
6
|
|
|
|
|
13
|
$self->{automation}->{velocity}->{mode} = 'relative'; |
|
846
|
6
|
|
|
|
|
18
|
$self->{automation}->{velocity}->{values} = [@_]; |
|
847
|
|
|
|
|
|
|
} |
|
848
|
|
|
|
|
|
|
|
|
849
|
7
|
|
|
|
|
20
|
return $self->{automation}->{velocity}; |
|
850
|
|
|
|
|
|
|
} |
|
851
|
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
=item C, C, C |
|
853
|
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
=cut |
|
855
|
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
sub AutomatePitchMiddleOff { |
|
857
|
2
|
|
|
2
|
1
|
4
|
my $self = shift; |
|
858
|
|
|
|
|
|
|
|
|
859
|
2
|
|
|
|
|
11
|
delete $self->{automation}->{pitch_middle}; |
|
860
|
|
|
|
|
|
|
} |
|
861
|
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
sub AutomatePitchMiddleAbs { |
|
863
|
135
|
|
|
135
|
1
|
212055
|
my $self = shift; |
|
864
|
135
|
100
|
|
|
|
431
|
if (scalar @_) { |
|
865
|
134
|
|
|
|
|
324
|
$self->{automation}->{pitch_middle}->{mode} = 'absolute'; |
|
866
|
146
|
|
|
|
|
310
|
$self->{automation}->{pitch_middle}->{values} = |
|
867
|
134
|
|
|
|
|
213
|
[map { _min(127, _max(0, $_)) } @_]; |
|
868
|
|
|
|
|
|
|
} |
|
869
|
|
|
|
|
|
|
|
|
870
|
135
|
|
|
|
|
381
|
return $self->{automation}->{pitch_middle}; |
|
871
|
|
|
|
|
|
|
} |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
sub AutomatePitchMiddleRel { |
|
874
|
7
|
|
|
7
|
1
|
1257
|
my $self = shift; |
|
875
|
7
|
100
|
|
|
|
21
|
if (scalar @_) { |
|
876
|
6
|
|
|
|
|
13
|
$self->{automation}->{pitch_middle}->{mode} = 'relative'; |
|
877
|
6
|
|
|
|
|
17
|
$self->{automation}->{pitch_middle}->{values} = [@_]; |
|
878
|
|
|
|
|
|
|
} |
|
879
|
|
|
|
|
|
|
|
|
880
|
7
|
|
|
|
|
19
|
return $self->{automation}->{pitch_middle}; |
|
881
|
|
|
|
|
|
|
} |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=back |
|
884
|
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=head1 AUTHOR |
|
886
|
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
Christian Renz, Ecrenz @ web42.comE |
|
888
|
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=head1 BUGS |
|
890
|
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
|
892
|
|
|
|
|
|
|
C, or through the web interface at |
|
893
|
|
|
|
|
|
|
L. |
|
894
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
|
895
|
|
|
|
|
|
|
your bug as I make changes. |
|
896
|
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
Please also consider adding a test case to your bug report (.t script). |
|
898
|
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
|
900
|
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
Copyright 2005 Christian Renz, Ecrenz @ web42.comE, All Rights Reserved. |
|
902
|
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
|
904
|
|
|
|
|
|
|
under the same terms as Perl itself. |
|
905
|
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=cut |
|
907
|
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
42; |