8 my ($filename, @others) = @ARGV;
9 my $opus = MIDI::Opus->new({from_file => $filename});
17 channel_after_touch => 2,
18 pitch_wheel_change => 2
22 set_tempo => sub { 1; },
23 note_off => sub { 1; },
24 note_on => sub { 1; },
25 control_change => sub { $_[3] == 64; },
31 return map { [$_->[0], $t += $_->[1], @{$_}[2..(@$_-1)]]; } @_;
37 return map { my $tsave = $t; $t = $_->[1]; [$_->[0], $t - $tsave, @{$_}[2..(@$_-1)]]; } @_;
42 return reltime grep { ($isclean{$_->[0]} // sub { 0; })->(@$_) } abstime @_;
47 my $opus2 = MIDI::Opus->new({from_file => $_});
48 if($opus2->ticks() != $opus->ticks())
50 my $tickfactor = $opus->ticks() / $opus2->ticks();
53 $_->events(reltime map { $_->[1] = int($_->[1] * $tickfactor + 0.5); $_; } abstime $_->events());
56 $opus->tracks($opus->tracks(), $opus2->tracks());
62 my @arg = split /\s+/, $_;
64 print "Executing: $cmd @arg\n";
69 elsif($cmd eq 'clean')
71 my $tracks = $opus->tracks_r();
72 $tracks->[$_]->events_r([clean($tracks->[$_]->events())])
77 print $opus->dump({ dump_tracks => 1 });
79 elsif($cmd eq 'ticks')
83 $opus->ticks($arg[0]);
87 print "Ticks: ", $opus->ticks(), "\n";
90 elsif($cmd eq 'tricks')
92 print "haha, very funny\n";
94 elsif($cmd eq 'retrack')
96 my $tracks = $opus->tracks_r();
100 for(abstime $tracks->[$_]->events())
102 my $p = $chanpos{$_->[0]};
105 my $c = $_->[$p] + 1;
106 push @{$newtracks[$c]}, $_;
110 push @{$newtracks[0]}, $_;
114 $opus->tracks_r([map { ($_ && @$_) ? MIDI::Track->new({ events => [reltime @$_] }) : () } @newtracks]);
116 elsif($cmd eq 'program')
118 my $tracks = $opus->tracks_r();
119 my ($track, $channel, $program) = @arg;
120 for(($track eq '*') ? (0..@$tracks-1) : $track)
124 for(abstime $tracks->[$_]->events())
126 my $p = $chanpos{$_->[0]};
129 my $c = $_->[$p] + 1;
130 if($channel eq '*' || $c == $channel)
133 if $_->[0] eq 'patch_change';
136 push @events, ['patch_change', $_->[1], $c-1, $program-1]
144 $tracks->[$_]->events_r([reltime @events]);
147 elsif($cmd eq 'transpose')
149 my $tracks = $opus->tracks_r();
150 my ($track, $channel, $delta) = @arg;
151 for(($track eq '*') ? (0..@$tracks-1) : $track)
153 for($tracks->[$_]->events())
155 my $p = $chanpos{$_->[0]};
158 my $c = $_->[$p] + 1;
159 if($channel eq '*' ? $c != 10 : $c == $channel)
161 if($_->[0] eq 'note_on' || $_->[0] eq 'note_off')
170 elsif($cmd eq 'channel')
172 my $tracks = $opus->tracks_r();
173 my ($track, %chanmap) = @arg;
174 for(($track eq '*') ? (0..@$tracks-1) : $track)
177 for(abstime $tracks->[$_]->events())
179 my $p = $chanpos{$_->[0]};
185 my $c = $_->[$p] + 1;
186 my @c = split /,/, ($chanmap{$c} // $chanmap{'*'} // $c);
189 if $c == 0; # kill by setting channel to 0
192 push @events, \@copy;
195 $tracks->[$_]->events_r([reltime @events]);
198 elsif($cmd eq 'percussion')
200 my $tracks = $opus->tracks_r();
201 my ($track, $channel, %map) = @arg;
202 for(($track eq '*') ? (0..@$tracks-1) : $track)
205 for(abstime $tracks->[$_]->events())
207 my $p = $chanpos{$_->[0]};
210 my $c = $_->[$p] + 1;
211 if($channel eq '*' || $c == $channel)
213 if($_->[0] eq 'note_on' || $_->[0] eq 'note_off')
215 if(length $map{$_->[3]})
217 $_->[3] = $map{$_->[3]};
219 elsif(exists $map{$_->[3]})
228 $tracks->[$_]->events_r([reltime @events]);
231 elsif($cmd eq 'tracks')
233 my $tracks = $opus->tracks_r();
246 next if $taken{$_}++ and not $force;
247 push @t, $tracks->[$_];
249 $opus->tracks_r(\@t);
264 for($tracks->[$_]->events())
267 $_->[0] = 'note_off' if $_->[0] eq 'note_on' and $_->[4] == 0;
269 my $p = $chanpos{$_->[0]};
272 my $c = $_->[$p] + 1;
273 $channels{$c} //= {};
274 if($_->[0] eq 'patch_change')
276 ++$channels{$c}{$_->[3]};
279 ++$notes if $_->[0] eq 'note_on';
280 $notehash{$_->[2]}{$_->[3]} = $t if $_->[0] eq 'note_on';
281 $notehash{$_->[2]}{$_->[3]} = undef if $_->[0] eq 'note_off';
282 $name = $_->[2] if $_->[0] eq 'track_name';
283 if($_->[0] eq 'note_on')
285 $min = $_->[3] if !defined $min || $_->[3] < $min;
286 $max = $_->[3] if !defined $max || $_->[3] > $max;
289 my $channels = join " ", map { sprintf "%s(%s)", $_, join ",", sort { $a <=> $b } keys %{$channels{$_}} } sort { $a <=> $b } keys %channels;
291 while(my ($k1, $v1) = each %notehash)
293 while(my ($k2, $v2) = each %$v1)
295 push @stuck, sprintf "%d:%d@%.1f%%", $k1+1, $k2, $v2 * 100.0 / $t
299 print " $name" if defined $name;
300 print " (channel $channels)" if $channels ne "";
301 print " ($events events)" if $events;
302 print " ($notes notes [$min-$max])" if $notes;
303 print " (notes @stuck stuck)" if @stuck;
308 elsif($cmd eq 'save')
310 $opus->write_to_file($arg[0]);
314 print "Unknown command, allowed commands:\n";
317 print " ticks [value]\n";
319 print " program <track|*> <channel|*> <program (1-based)>\n";
320 print " transpose <track|*> <channel|*> <delta>\n";
321 print " channel <track|*> <channel|*> <channel> [<channel> <channel> ...]\n";
322 print " percussion <track|*> <channel|*> <from> <to> [<from> <to> ...]\n";
323 print " tracks [trackno] [trackno] ...\n";
325 print "Done with: $cmd @arg\n";