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