File Coverage

blib/lib/Music/Gestalt.pm
Criterion Covered Total %
statement 244 320 76.2
branch 101 150 67.3
condition 55 105 52.3
subroutine 37 40 92.5
pod 27 27 100.0
total 464 642 72.2


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