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 }