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