fix some barrier and note stuff
[divverent/nexuiz.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) = @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 while(<STDIN>)
22 {
23         chomp;
24         my @arg = split /\s+/, $_;
25         my $cmd = shift @arg;
26         print "Executing: $cmd @arg\n";
27         if($cmd eq 'ticks')
28         {
29                 if(@arg)
30                 {
31                         $opus->ticks($arg[0]);
32                 }
33                 else
34                 {
35                         print "Ticks: ", $opus->ticks(), "\n";
36                 }
37         }
38         elsif($cmd eq 'tricks')
39         {
40                 print "haha, very funny\n";
41         }
42         elsif($cmd eq 'tracks')
43         {
44                 my $tracks = $opus->tracks_r();
45                 if(@arg)
46                 {
47                         my %taken = (0 => 1);
48                         my @t = ($tracks->[0]);
49                         for(@arg)
50                         {
51                                 next if $taken{$_}++;
52                                 push @t, $tracks->[$_];
53                         }
54                         $opus->tracks_r(\@t);
55                 }
56                 else
57                 {
58                         for(1..@$tracks-1)
59                         {
60                                 print "Track $_:";
61                                 my $name = undef;
62                                 my %channels = ();
63                                 my $notes = 0;
64                                 my %notehash = ();
65                                 my $t = 0;
66                                 for($tracks->[$_]->events())
67                                 {
68                                         $_->[0] = 'note_off' if $_->[0] eq 'note_on' and $_->[4] == 0;
69                                         $t += $_->[1];
70                                         my $p = $chanpos{$_->[0]};
71                                         if(defined $p)
72                                         {
73                                                 my $c = $_->[$p] + 1;
74                                                 ++$channels{$c};
75                                         }
76                                         ++$notes if $_->[0] eq 'note_on';
77                                         $notehash{$_->[2]}{$_->[3]} = $t if $_->[0] eq 'note_on';
78                                         $notehash{$_->[2]}{$_->[3]} = undef if $_->[0] eq 'note_off';
79                                         $name = $_->[2] if $_->[0] eq 'track_name';
80                                 }
81                                 my $channels = join " ", sort keys %channels;
82                                 my @stuck = ();
83                                 while(my ($k1, $v1) = each %notehash)
84                                 {
85                                         while(my ($k2, $v2) = each %$v1)
86                                         {
87                                                 push @stuck, sprintf "%d:%d@%.1f%%", $k1+1, $k2, $v2 * 100.0 / $t
88                                                         if defined $v2;
89                                         }
90                                 }
91                                 print " $name" if defined $name;
92                                 print " (channel $channels)" if $channels ne "";
93                                 print " ($notes notes)" if $notes;
94                                 print " (notes @stuck stuck)" if @stuck;
95                                 print "\n";
96                         }
97                 }
98         }
99         elsif($cmd eq 'save')
100         {
101                 $opus->write_to_file($arg[0]);
102         }
103         else
104         {
105                 print "Unknown command, allowed commands: ticks, tricks, tracks, save\n";
106         }
107         print "Done with: $cmd @arg\n";
108 }