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 = grep { $_ ne '' } 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 my $t(($track eq '*') ? (0..@$tracks-1) : $track)
 122                 {
 123                         my @events = ();
 124                         my %added = ();
 125                         for(abstime $tracks->[$t]->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{$t}{$c})
 136                                                 {
 137                                                         push @events, ['patch_change', $_->[1], $c-1, $program-1]
 138                                                                 if $program;
 139                                                         $added{$t}{$c} = 1;
 140                                                 }
 141                                         }
 142                                 }
 143                                 push @events, $_;
 144                         }
 145                         $tracks->[$t]->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 my $t(($track eq '*') ? (0..@$tracks-1) : $track)
 153                 {
 154                         my @events = ();
 155                         my %added = ();
 156                         for(abstime $tracks->[$t]->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{$t}{$c})
 167                                                 {
 168                                                         push @events, ['control_change', $_->[1], $c-1, $control, $value]
 169                                                                 if $value ne '';
 170                                                         $added{$t}{$c} = 1;
 171                                                 }
 172                                         }
 173                                 }
 174                                 push @events, $_;
 175                         }
 176                         $tracks->[$t]->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                 print "  save <filename.mid>\n";
 358         }
 359         print "Done with: $cmd @arg\n";
 360 }