fix a link in the docs
[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                         my $force = 0;
50                         for(@arg)
51                         {
52                                 if($_ eq '--force')
53                                 {
54                                         $force = 1;
55                                         next;
56                                 }
57                                 next if $taken{$_}++ and not $force;
58                                 push @t, $tracks->[$_];
59                         }
60                         $opus->tracks_r(\@t);
61                 }
62                 else
63                 {
64                         for(1..@$tracks-1)
65                         {
66                                 print "Track $_:";
67                                 my $name = undef;
68                                 my %channels = ();
69                                 my $notes = 0;
70                                 my %notehash = ();
71                                 my $t = 0;
72                                 for($tracks->[$_]->events())
73                                 {
74                                         $_->[0] = 'note_off' if $_->[0] eq 'note_on' and $_->[4] == 0;
75                                         $t += $_->[1];
76                                         my $p = $chanpos{$_->[0]};
77                                         if(defined $p)
78                                         {
79                                                 my $c = $_->[$p] + 1;
80                                                 ++$channels{$c};
81                                         }
82                                         ++$notes if $_->[0] eq 'note_on';
83                                         $notehash{$_->[2]}{$_->[3]} = $t if $_->[0] eq 'note_on';
84                                         $notehash{$_->[2]}{$_->[3]} = undef if $_->[0] eq 'note_off';
85                                         $name = $_->[2] if $_->[0] eq 'track_name';
86                                 }
87                                 my $channels = join " ", sort keys %channels;
88                                 my @stuck = ();
89                                 while(my ($k1, $v1) = each %notehash)
90                                 {
91                                         while(my ($k2, $v2) = each %$v1)
92                                         {
93                                                 push @stuck, sprintf "%d:%d@%.1f%%", $k1+1, $k2, $v2 * 100.0 / $t
94                                                         if defined $v2;
95                                         }
96                                 }
97                                 print " $name" if defined $name;
98                                 print " (channel $channels)" if $channels ne "";
99                                 print " ($notes notes)" if $notes;
100                                 print " (notes @stuck stuck)" if @stuck;
101                                 print "\n";
102                         }
103                 }
104         }
105         elsif($cmd eq 'save')
106         {
107                 $opus->write_to_file($arg[0]);
108         }
109         else
110         {
111                 print "Unknown command, allowed commands: ticks, tricks, tracks, save\n";
112         }
113         print "Done with: $cmd @arg\n";
114 }