Allow remapping a channel to multiple channels (to duplicate notes).
[xonotic/xonotic.git] / misc / tools / midichannels.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5 use MIDI;
6 use MIDI::Opus;
7
8 my ($filename, @others) = @ARGV;
9 my $opus = MIDI::Opus->new({from_file => $filename});
10
11 my %chanpos = (
12         note_off => 2,
13         note_on => 2,
14         key_after_touch => 2,
15         control_change => 2,
16         patch_change => 2,
17         channel_after_touch => 2,
18         pitch_wheel_change => 2
19 );
20
21 my %isclean = (
22         set_tempo => sub { 1; },
23         note_off => sub { 1; },
24         note_on => sub { 1; },
25         control_change => sub { $_[3] == 64; },
26 );
27
28 sub abstime(@)
29 {
30         my $t = 0;
31         return map { [$_->[0], $t += $_->[1], @{$_}[2..(@$_-1)]]; } @_;
32 }
33
34 sub reltime(@)
35 {
36         my $t = 0;
37         return map { my $tsave = $t; $t = $_->[1]; [$_->[0], $t - $tsave, @{$_}[2..(@$_-1)]]; } @_;
38 }
39
40 sub clean(@)
41 {
42         return reltime grep { ($isclean{$_->[0]} // sub { 0; })->(@$_) } abstime @_;
43 }
44
45 for(@others)
46 {
47         my $opus2 = MIDI::Opus->new({from_file => $_});
48         if($opus2->ticks() != $opus->ticks())
49         {
50                 my $tickfactor = $opus->ticks() / $opus2->ticks();
51                 for($opus2->tracks())
52                 {
53                         $_->events(reltime map { $_->[1] = int($_->[1] * $tickfactor + 0.5); $_; } abstime $_->events());
54                 }
55         }
56         $opus->tracks($opus->tracks(), $opus2->tracks());
57 }
58
59 while(<STDIN>)
60 {
61         chomp;
62         my @arg = split /\s+/, $_;
63         my $cmd = shift @arg;
64         print "Executing: $cmd @arg\n";
65         if($cmd eq '#')
66         {
67                 # Just a comment.
68         }
69         elsif($cmd eq 'clean')
70         {
71                 my $tracks = $opus->tracks_r();
72                 $tracks->[$_]->events_r([clean($tracks->[$_]->events())])
73                         for 0..@$tracks-1;
74         }
75         elsif($cmd eq 'dump')
76         {
77                 print $opus->dump({ dump_tracks => 1 });
78         }
79         elsif($cmd eq 'ticks')
80         {
81                 if(@arg)
82                 {
83                         $opus->ticks($arg[0]);
84                 }
85                 else
86                 {
87                         print "Ticks: ", $opus->ticks(), "\n";
88                 }
89         }
90         elsif($cmd eq 'tricks')
91         {
92                 print "haha, very funny\n";
93         }
94         elsif($cmd eq 'retrack')
95         {
96                 my $tracks = $opus->tracks_r();
97                 my @newtracks = ();
98                 for(0..@$tracks-1)
99                 {
100                         for(abstime $tracks->[$_]->events())
101                         {
102                                 my $p = $chanpos{$_->[0]};
103                                 if(defined $p)
104                                 {
105                                         my $c = $_->[$p] + 1;
106                                         push @{$newtracks[$c]}, $_;
107                                 }
108                                 else
109                                 {
110                                         push @{$newtracks[0]}, $_;
111                                 }
112                         }
113                 }
114                 $opus->tracks_r([map { ($_ && @$_) ? MIDI::Track->new({ events => [reltime @$_] }) : () } @newtracks]);
115         }
116         elsif($cmd eq 'program')
117         {
118                 my $tracks = $opus->tracks_r();
119                 my ($track, $channel, $program) = @arg;
120                 for(($track eq '*') ? (0..@$tracks-1) : $track)
121                 {
122                         my @events = ();
123                         my $added = 0;
124                         for(abstime $tracks->[$_]->events())
125                         {
126                                 my $p = $chanpos{$_->[0]};
127                                 if(defined $p)
128                                 {
129                                         my $c = $_->[$p] + 1;
130                                         if($channel eq '*' || $c == $channel)
131                                         {
132                                                 next
133                                                         if $_->[0] eq 'patch_change';
134                                                 if(!$added)
135                                                 {
136                                                         push @events, ['patch_change', $_->[1], $c-1, $program-1]
137                                                                 if $program;
138                                                         $added = 1;
139                                                 }
140                                         }
141                                 }
142                                 push @events, $_;
143                         }
144                         $tracks->[$_]->events_r([reltime @events]);
145                 }
146         }
147         elsif($cmd eq 'transpose')
148         {
149                 my $tracks = $opus->tracks_r();
150                 my ($track, $channel, $delta) = @arg;
151                 for(($track eq '*') ? (0..@$tracks-1) : $track)
152                 {
153                         for($tracks->[$_]->events())
154                         {
155                                 my $p = $chanpos{$_->[0]};
156                                 if(defined $p)
157                                 {
158                                         my $c = $_->[$p] + 1;
159                                         if($channel eq '*' ? $c != 10 : $c == $channel)
160                                         {
161                                                 if($_->[0] eq 'note_on' || $_->[0] eq 'note_off')
162                                                 {
163                                                         $_->[3] += $delta;
164                                                 }
165                                         }
166                                 }
167                         }
168                 }
169         }
170         elsif($cmd eq 'channel')
171         {
172                 my $tracks = $opus->tracks_r();
173                 my ($track, %chanmap) = @arg;
174                 for(($track eq '*') ? (0..@$tracks-1) : $track)
175                 {
176                         my @events = ();
177                         for(abstime $tracks->[$_]->events())
178                         {
179                                 my $p = $chanpos{$_->[0]};
180                                 if(!defined $p)
181                                 {
182                                         push @events, $_;
183                                         next;
184                                 }
185                                 my $c = $_->[$p] + 1;
186                                 my @c = split /,/, ($chanmap{$c} // $chanmap{'*'} // $c);
187                                 for my $c(@c) {
188                                         next
189                                                 if $c == 0; # kill by setting channel to 0
190                                         my @copy = @$_;
191                                         $copy[$p] = $c - 1;
192                                         push @events, \@copy;
193                                 }
194                         }
195                         $tracks->[$_]->events_r([reltime @events]);
196                 }
197         }
198         elsif($cmd eq 'percussion')
199         {
200                 my $tracks = $opus->tracks_r();
201                 my ($track, $channel, %map) = @arg;
202                 for(($track eq '*') ? (0..@$tracks-1) : $track)
203                 {
204                         my @events = ();
205                         for(abstime $tracks->[$_]->events())
206                         {
207                                 my $p = $chanpos{$_->[0]};
208                                 if(defined $p)
209                                 {
210                                         my $c = $_->[$p] + 1;
211                                         if($channel eq '*' || $c == $channel)
212                                         {
213                                                 if($_->[0] eq 'note_on' || $_->[0] eq 'note_off')
214                                                 {
215                                                         if(length $map{$_->[3]})
216                                                         {
217                                                                 $_->[3] = $map{$_->[3]};
218                                                         }
219                                                         elsif(exists $map{$_->[3]})
220                                                         {
221                                                                 next;
222                                                         }
223                                                 }
224                                         }
225                                 }
226                                 push @events, $_;
227                         }
228                         $tracks->[$_]->events_r([reltime @events]);
229                 }
230         }
231         elsif($cmd eq 'tracks')
232         {
233                 my $tracks = $opus->tracks_r();
234                 if(@arg)
235                 {
236                         my %taken = ();
237                         my @t = ();
238                         my $force = 0;
239                         for(@arg)
240                         {
241                                 if($_ eq '--force')
242                                 {
243                                         $force = 1;
244                                         next;
245                                 }
246                                 next if $taken{$_}++ and not $force;
247                                 push @t, $tracks->[$_];
248                         }
249                         $opus->tracks_r(\@t);
250                 }
251                 else
252                 {
253                         for(0..@$tracks-1)
254                         {
255                                 print "Track $_:";
256                                 my $name = undef;
257                                 my %channels = ();
258                                 my $notes = 0;
259                                 my %notehash = ();
260                                 my $t = 0;
261                                 my $events = 0;
262                                 my $min = undef;
263                                 my $max = undef;
264                                 for($tracks->[$_]->events())
265                                 {
266                                         ++$events;
267                                         $_->[0] = 'note_off' if $_->[0] eq 'note_on' and $_->[4] == 0;
268                                         $t += $_->[1];
269                                         my $p = $chanpos{$_->[0]};
270                                         if(defined $p)
271                                         {
272                                                 my $c = $_->[$p] + 1;
273                                                 $channels{$c} //= {};
274                                                 if($_->[0] eq 'patch_change')
275                                                 {
276                                                         ++$channels{$c}{$_->[3]};
277                                                 }
278                                         }
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')
284                                         {
285                                                 $min = $_->[3] if !defined $min || $_->[3] < $min;
286                                                 $max = $_->[3] if !defined $max || $_->[3] > $max;
287                                         }
288                                 }
289                                 my $channels = join " ", map { sprintf "%s(%s)", $_, join ",", sort { $a <=> $b } keys %{$channels{$_}} } sort { $a <=> $b } keys %channels;
290                                 my @stuck = ();
291                                 while(my ($k1, $v1) = each %notehash)
292                                 {
293                                         while(my ($k2, $v2) = each %$v1)
294                                         {
295                                                 push @stuck, sprintf "%d:%d@%.1f%%", $k1+1, $k2, $v2 * 100.0 / $t
296                                                         if defined $v2;
297                                         }
298                                 }
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;
304                                 print "\n";
305                         }
306                 }
307         }
308         elsif($cmd eq 'save')
309         {
310                 $opus->write_to_file($arg[0]);
311         }
312         else
313         {
314                 print "Unknown command, allowed commands:\n";
315                 print "  clean\n";
316                 print "  dump\n";
317                 print "  ticks [value]\n";
318                 print "  retrack\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";
324         }
325         print "Done with: $cmd @arg\n";
326 }