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) = @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 while(<STDIN>)
  46 {
  47         chomp;
  48         my @arg = split /\s+/, $_;
  49         my $cmd = shift @arg;
  50         print "Executing: $cmd @arg\n";
  51         if($cmd eq 'clean')
  52         {
  53                 my $tracks = $opus->tracks_r();
  54                 $tracks->[$_]->events_r([clean($tracks->[$_]->events())])
  55                         for 0..@$tracks-1;
  56         }
  57         elsif($cmd eq 'dump')
  58         {
  59                 print $opus->dump({ dump_tracks => 1 });
  60         }
  61         elsif($cmd eq 'ticks')
  62         {
  63                 if(@arg)
  64                 {
  65                         $opus->ticks($arg[0]);
  66                 }
  67                 else
  68                 {
  69                         print "Ticks: ", $opus->ticks(), "\n";
  70                 }
  71         }
  72         elsif($cmd eq 'tricks')
  73         {
  74                 print "haha, very funny\n";
  75         }
  76         elsif($cmd eq 'tracks')
  77         {
  78                 my $tracks = $opus->tracks_r();
  79                 if(@arg)
  80                 {
  81                         my %taken = ();
  82                         my @t = ();
  83                         my $force = 0;
  84                         for(@arg)
  85                         {
  86                                 if($_ eq '--force')
  87                                 {
  88                                         $force = 1;
  89                                         next;
  90                                 }
  91                                 next if $taken{$_}++ and not $force;
  92                                 push @t, $tracks->[$_];
  93                         }
  94                         $opus->tracks_r(\@t);
  95                 }
  96                 else
  97                 {
  98                         for(0..@$tracks-1)
  99                         {
 100                                 print "Track $_:";
 101                                 my $name = undef;
 102                                 my %channels = ();
 103                                 my $notes = 0;
 104                                 my %notehash = ();
 105                                 my $t = 0;
 106                                 my $events = 0;
 107                                 for($tracks->[$_]->events())
 108                                 {
 109                                         ++$events;
 110                                         $_->[0] = 'note_off' if $_->[0] eq 'note_on' and $_->[4] == 0;
 111                                         $t += $_->[1];
 112                                         my $p = $chanpos{$_->[0]};
 113                                         if(defined $p)
 114                                         {
 115                                                 my $c = $_->[$p] + 1;
 116                                                 ++$channels{$c};
 117                                         }
 118                                         ++$notes if $_->[0] eq 'note_on';
 119                                         $notehash{$_->[2]}{$_->[3]} = $t if $_->[0] eq 'note_on';
 120                                         $notehash{$_->[2]}{$_->[3]} = undef if $_->[0] eq 'note_off';
 121                                         $name = $_->[2] if $_->[0] eq 'track_name';
 122                                 }
 123                                 my $channels = join " ", sort keys %channels;
 124                                 my @stuck = ();
 125                                 while(my ($k1, $v1) = each %notehash)
 126                                 {
 127                                         while(my ($k2, $v2) = each %$v1)
 128                                         {
 129                                                 push @stuck, sprintf "%d:%d@%.1f%%", $k1+1, $k2, $v2 * 100.0 / $t
 130                                                         if defined $v2;
 131                                         }
 132                                 }
 133                                 print " $name" if defined $name;
 134                                 print " (channel $channels)" if $channels ne "";
 135                                 print " ($events events)" if $events;
 136                                 print " ($notes notes)" if $notes;
 137                                 print " (notes @stuck stuck)" if @stuck;
 138                                 print "\n";
 139                         }
 140                 }
 141         }
 142         elsif($cmd eq 'save')
 143         {
 144                 $opus->write_to_file($arg[0]);
 145         }
 146         else
 147         {
 148                 print "Unknown command, allowed commands: ticks, tracks, clean, save\n";
 149         }
 150         print "Done with: $cmd @arg\n";
 151 }