#!/usr/bin/perl -w

use strict;
use MIDI;
use utf8;
use feature 'state';
use Data::Dumper;
use Getopt::Long;
use Encode;

binmode(STDOUT, ":encoding(UTF-8)");
binmode(STDERR, ":encoding(UTF-8)");

########################################################################
## TODO

# charset identification for all events containing text

########################################################################

=encoding utf8
=cut

=head1 NAME

miditoly.pl - a program to convert midi files to lilypond [1] code

=head1 SYNOPSIS

miditoly.pl [options] midi_file, ...

=head1 DESCRIPTION

TODO

=head1 IMPLEMENTATION

=over

=item 1) read files and sort out the data to data structures:

=over

=item note: [ sta_time, end_time, midi_note, velocity ]

=item stack: a container type = ( per_track_channel_hash, ... )

=item per_track_channel_hash: { channel_no => [ stored_data, ... ], ... }

=back

=item 2) per track and channel: separate notes into voices

=item 3) per voice: convert to lilypond code

=back

=head1 AUTHOR

Written by Karl Hammar.

=head1 COPYRIGHT

Copyright © 2012 Karl Hammar.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.

=head1 SEE ALSO

 [1] http://www.lilypond.org/
 [2] http://www.music.mcgill.ca/~ich/classes/mumt306/midiformat.pdf
 [3] http://www.cdik.se/pdf/midiformat.pdf

=head1 ISSUES

Don't really know if it should write c-sharp or d-flat.
One could potentially look att the resulting chord by looking att other voices.

Cannot identify slurs.

=cut

########################################################################
##### Conventions ######################################################

 # we use 0 based bar number internally

########################################################################
##### Data extracted from the midi file by proc_file() #################

# from midi header
my $nformat;
my $ntracks;
my $ticks;

# header things
my $title;
my $composer; # e.g. "W. A. Mozart", taken from text_event
my @tagline; # ( "line1", ... ), taken from text_event

# track data: $midi[track_number]{channel}{event_type}{sta|end|data}
my @midi;

# theese events has a "channel"
#  note_on / note_off
#  patch change events
#  control change events
#  key_after_touch
#  channel_after_touch
#  pitch_wheel_change

# the rest doesn't hava a channel, though I use the fictive channel $noch
# to make them have the same structure as the above
#  time_sig
#  tempo
#  key_sig
#  lyric
#  markup and other text events
my $noch = ".";

my %active_note; # $active_note{channel}{midi_pitch} = [ note_event ] used in sub note_on()/off()

########################################################################
##### Other global variables ###########################################

my $opt_verbose = 0;
#my $opt_barcnt = 1;
#my $opt_sympfx = "";
# use only indicated tracks
my $opt_track = "";
my @track_list; # the result of the above, ( track_number_to_care_for, ... )
my %track_list; # same, but as hash ( n => n, ... )
#my $opt_sq = 0;
#my $opt_eq = 0;
my $opt_encoding = "";
my $opt_bar = "";

my $opt_maxdots = 3;
#my $opt_maxtupl = 9;
my $pfx = "  ";

# see dispatch_init() below
my %dispatch;

# statistics
my %duration; # { number_of_ticks => [ count, lilypond_symbol ], ... }, e.g. with ticks = 100: ( 250 => [ 38, 100, "2." ] )
my @duration; # sorted list of found duration, = sort sort_num keys %duration
my %midi_note; # { midi_note_number => count }
my $file_endtime = 0;
my @track_stat;
my @info_list;
my @err_list;
my $max_channels_per_track = 0;
my $track_zero_noch = 0;
# character set identification/conversion
my @encoding_all = sort Encode->encodings(':all');
my %charcodes;
my $txt_all = "";
my $txt_ext = "";
my $txt_tst = "";

# test of duration
my %dtest = (
    proportional => 1,
);

### some constants
my @key_minor = qw/ as es bes f c g d a e b fis cis gis dis ais /; # -7b to +7#, a minor is 0
my @key_major = qw/ ces ges des as es bes f c g d a e b fis cis /; # -7b to +7#, c major is 0
my @note_is   = qw/ c cis d dis e f fis g gis a ais b /; # note names in key with #'s
my @note_es   = qw/ c des d es  e f ges g as  a bes b /; # note names in key with b's
my @tuplets = ( 3, 5, 7, 9, 11, 13 );
my @ties = ( 5, 7, 9, 10, 11); # e.g. a4~ a8 = _5_/8
my @alph = ( "a" .. "z" );
my %alph = ( c => 0, d => 1, e => 2, f => 3, g => 4, a => 5, b => 6, r => 7); # note name to scale step
my @long_note = ( qw/ 1 \breve \longa \maxima / );
my $abase = ord('z') - ord('a')+1; # not binary, decimal etc., every "digit" is a..z
my $callback_init   = -1;
my $callback_import = -2;
my $callback_decode = -3;
my $callback_ly     = -4;
my $callback_finish = -5;
my $relative_f = 60 - 7; # 60 is middle c, then count down 7 semitones
my $indent = "  ";
my $pausIsSkip = 0;
my $pausIsRest = 1;

########################################################################
##### error handling ###################################################

sub info(@) {
    for my $str (@_) {
	push @info_list, $str;
	if ($opt_verbose > 0) { print $str, "\n"; }
    }
}
sub err(@) {
    for my $str (@_) {
	push @err_list, $str;
	print $str, "\n";
    }
}

########################################################################
##### event handlers ###################################################
# argument to all event handlers are ( event_name, time, event_data...)
# where time is time from start of track
# if (event_name eq "") { init_this_event_handler; }

# event handlers are called from proc_file() to extract things to
# globals variables declared at top of this file

# first some small helpers needed by the handlers

sub char_cache($) {
    my $str = shift;

    return if ($str eq "");
    $txt_all .= $str;
    my @arr = split(//, $str);
    my $flag = 0;
    for my $c (@arr) {
	my $o = ord($c);
	#if (!defined($o)) { print "XXX<$str>\n"; }
	if ($o > 127) {
	    #if (!defined($charcodes{$o})) { $charcodes{$o} = 0; }
	    $charcodes{$o}++;
	    $flag = 1;
	}
    }

    if ($txt_tst && $txt_tst =~ m/ $/) {
	$txt_tst = "";
    }

    if ($flag || ($txt_ext && $txt_ext !~ m/ $/)) {
	$txt_ext .= $txt_tst . $str;
	$txt_tst = "";
    } else {
	$txt_tst .= $str;
    }
}

sub char_cache_guess_charset() {
    my $ll = length($txt_ext);
    if ($ll == 0) {
	return;
    }
    #print join("\n", @encoding_all), "\n";
    my %enc = ();
    $enc{$_} = 1 foreach (@encoding_all);
    my $flg = 0;
    my @cc = sort keys %charcodes;
    if ($cc[0] < 0xA0) { $flg = 1; }
    my $listAndExit = 0;
    if ($opt_encoding =~ m|/(.*)/|) {
	$listAndExit = 1;
	$opt_encoding = $1;
    }

    if ($txt_ext) { # i.e. non-ascii text/lyrics
	#print " <$txt_ext>\n\n";
	my @EBCDIC = (
	    1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27,
	    29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 251, 252, 254, 256, 257, 258, 259, 260, 264, 273,
	    274, 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, 293, 297, 298,
	    310, 320, 321, 322, 330, 351, 352, 353, 355, 357, 358, 359, 360, 361, 363, 382, 383, 384, 385, 386,
	    387, 388, 389, 390, 391, 392, 393, 394, 395, 410, 420, 421, 423, 424, 425, 435, 500, 803, 829, 833,
	    834, 835, 836, 837, 838, 839, 870, 871, 875, 880, 881, 882, 883, 884, 885, 886, 887, 888, 889, 890,
	    892, 893, 905, 918, 924, 930, 931, 933, 935, 937, 939, 1001, 1002, 1003, 1005, 1007, 1024, 1025, 1026,
	    1027, 1028, 1030, 1031, 1032, 1033, 1037, 1047, 1068, 1069, 1070, 1071, 1073, 1074, 1075, 1076, 1077,
	    1078, 1079, 1080, 1081, 1082, 1083, 1084, 1085, 1087, 1091, 1097, 1110, 1112, 1113, 1122, 1123, 1130,
	    1132, 1136, 1137, 1140, 1141, 1142, 1143, 1144, 1145, 1146, 1147, 1148, 1149, 1150, 1151, 1152, 1153,
	    1154, 1155, 1156, 1157, 1158, 1159, 1160, 1164, 1165, 1166, 1278, 1303, 1364, 1364, 1371, 1376, 1377,
	    1388, 1390, 1399, 9067, 12712, 16804,
	);
	my %EBCDIC;
	$EBCDIC{$_} = 1 foreach( @EBCDIC );
	for my $encoding (@encoding_all) {
	    if ($listAndExit) {
		next unless($encoding =~ m/$opt_encoding/);
	    }
	    if ($encoding =~ m/^UCS-/i ||$encoding =~ m/^UTF-(1|7|16|32|EBCDIC)([^0-9]|$)/i ||
		    $encoding =~ m/^cp-?(\d+)/i && $EBCDIC{$1}) {
		# multibyte and EBCDIC does not match extended ascii
		delete $enc{$encoding};
		next;
	    }
	    if ($encoding =~ m/^ISO-8859-/i && $flg) {
		# C1 control character are not concidered here
		# https://en.wikipedia.org/wiki/C0_and_C1_control_character
		delete $enc{$encoding};
		next;
	    }
	    my $str = $txt_ext;
	    my $tst = decode($encoding, $str,
			     sub {
				 $enc{$encoding} = 0;
				 shift;
				 "X";
			     }
			 );
	    my $len = length($tst);
	    if ($enc{$encoding} && $len > 1 && $len > $ll/3) {
		if ($listAndExit) {
		    print " $encoding: <$tst>\n\n";
		}
	    } else {
		delete $enc{$encoding};
	    }
	}

	if ($listAndExit) {
	    exit;
	}
	# make some very crude guessing, TODO encoding
	if ($enc{utf8}) {
	    $opt_encoding = "utf8";
	} elsif ($enc{"iso-8859-1"}) {
	    $opt_encoding = "iso-8859-1";
	} elsif ($enc{cp1252}) {
	    $opt_encoding = "cp1252";
	} else {
	    print "Please specify encoding\n";
	    exit;
	}
	info("encoding: $opt_encoding");
    } else {
	info("encoding: none");
    }
    #print "  ", join(" ", sort keys %enc), "\n";
}

sub char_decode_everything() {
    return unless ($txt_ext);
    # oops, this was deep...
    for (my $track = 0; $track < $ntracks; $track++) {
	if (defined($midi[$track])) {
	    for my $channel (keys %{$midi[$track]}) {
		for my $event_type (keys %{$midi[$track]{$channel}}) {
		    my $v = $dispatch{$event_type};
		    if (defined($v)) {
			my $f = $$v[1];
			&$f($event_type, $callback_decode, $midi[$track]{$channel}{$event_type});
		    } else {
			err("char_decode_everything: event_type $event_type not defined");
		    }
		}
	    }
	}
    }
}

sub char_cache_dump() {
    print "char cache:\n";
    if ($opt_verbose > 3) {
	print "   <$txt_ext>\n";
    }
    for my $k (sort { $a <=> $b } keys %charcodes) {
	my $v = $charcodes{$k};
	printf("  0x%02x: %d\n", $k, $v);
    }
    if ($opt_encoding) {
	print "encoding choosen: $opt_encoding\n";
	my $str = decode($opt_encoding, $txt_ext);
	print "   <$str>\n";
    } else {
	print "encoding choosen: none\n";
    }
}

sub time_sig2ly($$) {
    my $num = shift;
    my $den = 1 << shift;
    "\\time $num/$den";
}

sub round($$) {
    my $val = shift;
    my $deg = shift;
    $val = int($val * $deg + 0.5) / $deg
}

sub midivaluePos($) {
    my $val = shift;
    $val = round( $val / 127, 1000);
}
sub midivalue($) {
    my $val = shift;
    $val -= 64;
    if ($val <= 0) {
	$val = round( $val / 64, 1000);
    } else {
	$val = round( $val / (127-64), 1000);
    }
    $val;
}

sub ticksperbar($$) {
    my $num = shift;
    my $den = 1 << shift;

    # note length (in #of whole notes) of time sig, e.g. 4/4 => 1, 3/4 => 0.75 etc.
    my $len_time_sig = $num / $den;

    # length of whole note in ticks, $ticks is length of 1/4, so 4/4 is 4*$ticks in length
    my $ticks_per_one = $ticks << 2;

    #print "ticksperbar: $num/$den $len_time_sig $ticks_per_one\n";
    my $val = $ticks_per_one * $len_time_sig;

    return $val;
}

sub timeAndBar($$) {
    my $track = shift;
    my $time = shift;

    if ($time < 0) { $time = 0; }
    if ($time == 0) {
	return [ 0, 0, 0 ];
    }
    my $time_sig = $midi[$track]{$noch}{time_signature};
    if (!defined($time_sig)) {
	$track = 0;
	$time_sig = $midi[$track]{$noch}{time_signature};
    }

    # find latest time sig before this time
    my $ix;
    for ($ix = 1; $ix < @$time_sig; $ix++) {
	if ($time < $$time_sig[$ix]{sta}[0]) {
	    last;
	}
    }
    my $sta_time = $$time_sig[$ix-1]{sta}[0];
    my $sta_bar  = $$time_sig[$ix-1]{sta}[1];
    my $tpb      = $$time_sig[$ix-1]{data}[2];

    my $dt    = $time - $sta_time;
    my $bar   = $sta_bar + int($dt / $tpb);
    my $btime = $dt % $tpb;

    my $tb = [ $time, $bar, $btime ];
    $tb;
}

sub event_add($$$ $$;$) {
    my $name = shift;
    my $track = shift;
    my $channel = shift;

    my $data = shift;
    my $sta_time = shift;
    my $end_time = shift;

    my $event = { };
    $$event{data} = $data;
    $$event{sta} = timeAndBar($track, $sta_time);
    if (defined($end_time)) {
	$$event{end}  = timeAndBar($track, $end_time);
    }

    if (!defined($midi[$track]{$channel}{$name})) {
	$midi[$track]{$channel}{$name} = [];
    }
    push @{$midi[$track]{$channel}{$name}}, $event;
    $$event{index} = [ $track, $channel, $#{$midi[$track]{$channel}{$name}}, $name ];
    if ($name eq "") {
	print Dumper($midi[$track]{$channel});
    }

    $event;
}
sub event_print($@) {
    my $func = shift;

    for my $r (@_) {
	my $data = $$r{data};
	my $sta  = $$r{sta};
	my $end  = $$r{end};
	my $index = $$r{index};
	printf("    %6d %4d %4d |", @$sta);
	if ($end) {
	    printf(" %6d %4d %4d |", @$end);
	}
	printf(" %2d %2s %3d %s |", @$index);
	if ($func) {
	    print " ", &$func($data), "\n";
	} else {
	    print " ";
	    if (!ref($data)) {
		print "<$data>";
	    } if (ref($data) eq "ARRAY") {
		print join(" ", @$data);
	    } else {
		## err
	    }
	}
	print "\n";
    }
}

##### header like events ###############

sub track_name($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('track_name', dtime, text)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $data = shift; # text string
	char_cache(" $data ");

	if ($sta_time != 0) { err "track $track, $name: at illegal time ($sta_time)";	}
	#print "*** track_name($name, $action, $track, $sta_time, $channel, $data)\n";
	if ($track == 0 && $sta_time == 0) {
	    $title = $data;
	} else {
	    my $event = event_add($name, $track, $channel, $data, $sta_time);
	}
    } elsif ($action == $callback_decode) {
	my $r = shift;
	for my $ref (@$r) {
	    $$ref{data} = decode($opt_encoding, $$ref{data});
	}
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub instrument_name($$@)      {
    # ('instrument_name', dtime, text)
}; # ignore for time beeing
sub copyright_text_event($$@) {
    # ('copyright_text_event', dtime, text)
    track_name(shift, shift, @_);
}

##### time and key management ##########
# I'm trying to understand this, the text below might be wrong.
# timings:
# midi ticks = number or MIDI ticks (time units used for delta times) per "MIDI quarter note" or (rather) beat
# midi tempo = microseconds per "MIDI quarter note" (i.e. beat)
#  normally musicians express tempo (m.m.) as beats / minute, so m.m. = 60*1000*1000 / midi_tempo
#  combining ticks and tempo, we get "microseconds per tick" = tempo / ticks
# midi time signature tells us the normal 3/4 4/4 etc., how fast the metronome clicks, and the relation between
#  notated note to beat, soo if $bb below is 8 the beat is on the quarternote (or a "4" in lilypond syntax)
#  8 -> 4, 12 -> 4., 4 -> 8, etc.
#  and all thoose beats are subdivided into $ticks timeunits
#
# soo $dtime / $ticks is how big part of a beat this dtime takes
# and a beat is $bb / 32 in notelength, and a given $dtime becomes ($dtime*$bb)/(32*ticks) in notlenght and it
# better be a 2 multiple or some 3/5/7/... tuplet in length
#
#  (2**n) = 2 to the power of n
# the bar length: the beat is $bb/32 in notelength and $ticks in timeunits
#  the bar is $nn / (2**$dd) * (32/$bb) in timeunits (ticks); hopefully this is an integer

sub time_signature($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
	# midi default: 4/4
	my $track = 0;
	my $sta_time = 0;
	my $channel = $noch;
	my $data = [ 4, 2, ticksperbar(4,2) ];
	my $event = event_add($name, $track, $channel, $data, $sta_time);
    } elsif ($action == $callback_import) {
	# ('time_signature', dtime, nn, dd, cc, bb)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $num = shift;	# numerator (e.g. the 3 in 3/4)
	my $dd  = shift; # denumerator, well its 2 exponent, i.e. 2**0 = 1, 2**1 = 2, 2**2 = 4, 3**2 = 8, ...
	# my $cc  = shift; # the number of MIDI clocks in a metronome click; not useful for score on paper
	# my $bb  = shift; # the number of notated 32nd-notes in a "midi quarter note" (i.e. beat)

	my $lst = $midi[$track]{$channel}{$name};
	my $last = $$lst[$#$lst];
	if ($sta_time == $$last{sta}[0]) {
	    # if duplicate time signatures, take the last one seen
	    pop @$lst;
	}
	my $tpb = ticksperbar($num, $dd);
	my $str = time_sig2ly($num, $dd);
	my $data = [ $num, $dd, $tpb, $str ];
	my $event = event_add($name, $track, $channel, $data, $sta_time);
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
	my $ev = shift;
	my $data = $$ev{data};
	my $str = $$data[3];
	return $str;
    } elsif ($action == $callback_finish) {
    }
    return 0;
}

sub set_tempo($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
	my $track = 0;
	my $sta_time = 0;
	my $channel = $noch;
	my $data = '\tempo 4 = 120';
	my $event = event_add($name, $track, $channel, $data, $sta_time);
    } elsif ($action == $callback_import) {
	# ('set_tempo', dtime, tempo)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $tempo = shift;	# microseconds per midi quarter note

	my $lst = $midi[$track]{$channel}{$name};
	my $last = $$lst[$#$lst];
	if ($sta_time == $$last{sta}[0]) {
	    # if duplicate time signatures, take the last one seen
	    pop @$lst;
	}
	my $mm = int( 0.5 + 60*1000*1000 / $tempo);
	my $data = "\\tempo 4 = $mm";
	my $event = event_add($name, $track, $channel, $data, $sta_time);
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
	my $ev = shift;
	my $data = $$ev{data};
	my $str = $data;
	return $str;
    } elsif ($action == $callback_finish) {
    }

    return 0;
}

##### patch and control change #########
sub patch_change($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('patch_change', dtime, channel, patch)
	my $track = shift;
	my $sta_time = shift;
	my $channel = shift;
	my $patch = shift;

	my $instr = $MIDI::number2patch{$patch};
	my $data = "\\set Staff.midiInstrument = #\"$instr\" % $patch";
	my $event = event_add($name, $track, $channel, $data, $sta_time);
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}

# volyme 7 / 27
# balance 8 / 40
# pan position 10 / 42
# reverb level 91 / -
# chorus level 93 / -

sub control_change($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('control_change', dtime, channel, controller(0-127), value(0-127))
	my $track = shift;
	my $sta_time = shift;
	my $channel = shift;
	my $controller = shift;
	my $value = shift;

	my $data = "";
	if ($controller ==  7) {  # msb volume
	} elsif ($controller ==  8) { # msb balance
	    $value = midivalue($value);
	    $data = "\\set Staff.midiBalance = #$value";
	} elsif ($controller == 10) { # msb pan
	    $value = midivalue($value);
	    $data = "\\set Staff.midiPanPosition = #$value";
	} elsif ($controller == 27) { # lsb volume
	    # skip lsb for now
	} elsif ($controller == 40) { # lsb balance
	    # skip lsb for now
	} elsif ($controller == 42) { # lsb pan
	    # skip lsb for now
	} elsif ($controller == 91) { # msb reverb
	    $value = midivaluePos($value);
	    $data = "\\set Staff.midiReverbLevel = #$value";
	} elsif ($controller == 93) { # msb chorus
	    $value = midivaluePos($value);
	    $data = "\\set Staff.midiChorusLevel = #$value";
	}

	if ($data) {
	    my $event = event_add($name, $track, $channel, $data, $sta_time);
	}
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }

    return 0;
}

##### notes and lyrics #################

sub key_signature($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('key_signature', dtime, sf, mi)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $sf = shift;		# > 0 number of #, < 0 number of b
	my $mi = shift;		# 1 = minor, 0 = major

	if ($sf < -7 || 7 < $sf || $mi < 0 || 1 < $mi) {
	    err "$name: illegal parameters sf:$sf mi:$mi";
	    return 1;
	}
	my $data = [ $sf, $mi ];
	my $event = event_add($name, $track, $channel, $data, $sta_time);
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}

sub note_on($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('note_on', dtime, channel, note, velocity)
	# ('note_off', dtime, channel, note, velocity)
	my $track = shift;
	my $sta_time = shift;
	my $channel = shift;
	my $note = shift;
	my $velocity = shift;

	if ($name eq "note_off" || $velocity == 0) {
	    my $prev = $active_note{$channel}{$note};
	    if (defined($prev)) {
		delete($active_note{$channel}{$note});

		# save duration and note value
		my $end_time = $sta_time;
		$sta_time = $$prev{sta}[0];
		$$prev{end} = timeAndBar($track, $end_time);
		my $dt = $end_time - $sta_time;

		if (!defined($duration{$dt})) {
		    $duration{$dt} = [ 0, "" ];
		}
		$duration{$dt}[0]++;
		$midi_note{$track}{$channel}{$note}++;
		$midi_note{$track}{all}{$note}++;
		$midi_note{all}{$note}++;
	    } else {
		err "bogus note off:";
		return 1;
	    }
	} else {
	    my $data = [ $note, $velocity ];
	    my $event = event_add($name, $track, $channel, $data, $sta_time);
	    $active_note{$channel}{$note} = $event;
	}
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
	# TODO close all active notes
    }
    return 0;
}
sub note_off($$@) { note_on(shift, shift, @_); }

sub lyric($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('lyric', dtime, text)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $data = shift;

	char_cache($data);
	my $event = event_add($name, $track, $channel, $data, $sta_time);
    } elsif ($action == $callback_decode) {
	my $r = shift;
	for my $ref (@$r) {
	    $$ref{data} = decode($opt_encoding, $$ref{data});
	}
    } elsif ($action == $callback_ly) {
	# if ($text eq "\r") {
	#   new lyric line, perhaps new stanza number ?
	# } elsif (substr($text,-1) eq " ") {
	#   print "  lyric: $text\n";
	# } else {
	#   print "  lyric: $text --\n";
	# }
    } elsif ($action == $callback_finish) {
    }
    return 0;
}

##### generic text events ##############

sub markup($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ($name, dtime, text)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $data = shift; # one could possible do it as $data = "name: " . shift

	char_cache(" $data ");
	my $event = event_add($name, $track, $channel, $data, $sta_time);
    } elsif ($action == $callback_decode) {
	my $r = shift;
	for my $ref (@$r) {
	    $$ref{data} = decode($opt_encoding, $$ref{data});
	}
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}

sub text_event($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
	$composer = "";
	@tagline = ();
    } elsif ($action == $callback_import) {
	# ('text_event', dtime, text)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $text = shift;

	return 0 if ($text eq "");
	if ($sta_time == 0 && ($nformat == 0 || $track == 0)) {
	    char_cache(" $text ");
	    if ($composer eq "") {
		$composer = $text;
	    } else {
		push @tagline, $text;
	    }
	} else {
	    # TODO: what is this?
	    markup($name, $action, $track, $sta_time, $text);
	}
    } elsif ($action == $callback_decode) {
	$composer = decode($opt_encoding, $composer);
	for (my $ix = 0; $ix < @tagline; $ix++) {
	    $tagline[$ix] = decode($opt_encoding, $tagline[$ix]);
	}
	my $r = shift;
	for my $ref (@$r) {
	    $$ref{data} = decode($opt_encoding, $$ref{data});
	}
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub marker($$@)        { return markup(shift, shift, @_); } # ('marker', dtime, text)
sub cue_point($$@)     { return markup(shift, shift, @_); } # ('cue_point', dtime, text)
sub text_event_08($$@) { return markup(shift, shift, @_); } # ('text_event_08', dtime, text)
sub text_event_09($$@) { return markup(shift, shift, @_); } # ('text_event_09', dtime, text)
sub text_event_0a($$@) { return markup(shift, shift, @_); } # ('text_event_0a', dtime, text)
sub text_event_0b($$@) { return markup(shift, shift, @_); } # ('text_event_0b', dtime, text)
sub text_event_0c($$@) { return markup(shift, shift, @_); } # ('text_event_0c', dtime, text)
sub text_event_0d($$@) { return markup(shift, shift, @_); } # ('text_event_0d', dtime, text)
sub text_event_0e($$@) { return markup(shift, shift, @_); } # ('text_event_0e', dtime, text)
sub text_event_0f($$@) { return markup(shift, shift, @_); } # ('text_event_0f', dtime, text)

sub end_track($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('end_track', dtime)
	my $track = shift;
	my $sta_time = shift;
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}

##### Not implemented stuff ############
# theese shows up in track 0 for format 1
sub smpte_offset($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('smpte_offset', dtime, hr, mn, se, fr, f)f
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $hr = shift;
	my $mn = shift;
	my $se = shift;
	my $fr = shift;
	my $ff = shift;

	if ($sta_time > 0) {
	    err "$name only allowed at time 0";
	} elsif ($nformat > 0 && $track > 0) {
	    # IGNORE, no meaning here
	} else {
	    # IGNORE, not relevant to score on paper???
	}
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub key_after_touch($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('key_after_touch', dtime, channel, note, velocity)
	my $track = shift;
	my $sta_time = shift;
	my $channel = shift;
	my $note = shift;
	my $velocity = shift;
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub channel_after_touch($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('channel_after_touch', dtime, channel, velocity)
	my $track = shift;
	my $sta_time = shift;
	my $channel = shift;
	my $velocity = shift;
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub pitch_wheel_change($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('pitch_wheel_change', dtime, channel, pitch_wheel)
	my $track = shift;
	my $sta_time = shift;
	my $channel = shift;
	my $pitch_wheel = shift;
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub set_sequence_number($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('set_sequence_number', dtime, sequence)
	my $track = shift;
	my $sta_time = shift;
	my $sequence = shift;
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub sequencer_specific($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('sequencer_specific', dtime, raw)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $raw = shift;

	my $data = "0x" . unpack("H*", $raw);
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub raw_meta_event($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('raw_meta_event', dtime, command(0-255), raw)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $command = shift;
	my $raw = shift;

	my $data = "0x" . unpack("H*", $raw);
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub sysex_f0($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('sysex_f0', dtime, raw)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $raw = shift;

	my $data = "0x" . unpack("H*", $raw);
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub sysex_f7($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('sysex_f7', dtime, raw)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $raw = shift;
	my $data = "0x" . unpack("H*", $raw);
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub song_position($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('song_position', dtime)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub song_select($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('song_select', dtime, song_number)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $song_number = shift;
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub tune_request($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('tune_request', dtime)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}
sub raw_data($$@) {
    my $name = shift;
    my $action = shift;

    if ($action == $callback_init) {
    } elsif ($action == $callback_import) {
	# ('raw_data', dtime, raw)
	my $track = shift;
	my $sta_time = shift;
	my $channel = $noch;
	my $raw = shift;

	my $data = "0x" . unpack("H*", $raw);
	#print "$name: not supported\n";
    } elsif ($action == $callback_decode) {
    } elsif ($action == $callback_ly) {
    } elsif ($action == $callback_finish) {
    }
    return 0;
}

sub sort_ev {
    my $ia = $dispatch{$a}[0];
    my $ib = $dispatch{$b}[0];
    $ia <=> $ib;
}

sub dispatch_init() {
    # $ix is the order of simultaneous events when output to lilypond code
    # i.e. \time \key \tempo comes before notes and then \markup's
    my $ix = 0;
    %dispatch = (
	# events with: header like text
	"track_name"           => [ $ix++, \&track_name, ],
	"instrument_name"      => [ $ix++, \&instrument_name, ],
	"copyright_text_event" => [ $ix++, \&copyright_text_event, ],

	# time and key management
	"time_signature"       => [ $ix++, \&time_signature, ],
	"key_signature"        => [ $ix++, \&key_signature, ],
	"set_tempo"            => [ $ix++, \&set_tempo, ],

	# patch and control change
	"patch_change"         => [ $ix++, \&patch_change, ],
	"control_change"       => [ $ix++, \&control_change, ],

	# notes and lyrics
	"note_off"             => [ $ix++, \&note_off, ],
	"note_on"              => [ $ix++, \&note_on, ],
	"lyric"                => [ $ix++, \&lyric, ],

	# generic text events
	"text_event"           => [ $ix++, \&text_event, ],
	"marker"               => [ $ix++, \&marker, ],
	"cue_point"            => [ $ix++, \&cue_point, ],
	"text_event_08"        => [ $ix++, \&text_event_08, ],
	"text_event_09"        => [ $ix++, \&text_event_09, ],
	"text_event_0a"        => [ $ix++, \&text_event_0a, ],
	"text_event_0b"        => [ $ix++, \&text_event_0b, ],
	"text_event_0c"        => [ $ix++, \&text_event_0c, ],
	"text_event_0d"        => [ $ix++, \&text_event_0d, ],
	"text_event_0e"        => [ $ix++, \&text_event_0e, ],
	"text_event_0f"        => [ $ix++, \&text_event_0f, ],

	"end_track"            => [ $ix++, \&end_track, ],

	# not implemented
	"smpte_offset"         => [ $ix++, \&smpte_offset, ],
	"key_after_touch"      => [ $ix++, \&key_after_touch, ],
	"channel_after_touch"  => [ $ix++, \&channel_after_touch, ],
	"pitch_wheel_change"   => [ $ix++, \&pitch_wheel_change, ],
	"set_sequence_number"  => [ $ix++, \&set_sequence_number, ],
	"sequencer_specific"   => [ $ix++, \&sequencer_specific, ],
	"raw_meta_event"       => [ $ix++, \&raw_meta_event, ],
	"sysex_f0"             => [ $ix++, \&sysex_f0, ],
	"sysex_f7"             => [ $ix++, \&sysex_f7, ],
	"song_position"        => [ $ix++, \&song_position, ],
	"song_select"          => [ $ix++, \&song_select, ],
	"tune_request"         => [ $ix++, \&tune_request, ],
	"raw_data"             => [ $ix++, \&raw_data, ],
    );

}

sub run_callbacks($) {
    my $value = shift;
    for my $k (keys %dispatch) {
	my $v = $dispatch{$k};
	my $f = $$v[1];
	&$f($k, $value);
    }
}

########################################################################
##### Main program and extrackt info from events #######################

sub sort_num {
    my $A = $a;
    my $B = $b;
    $A = -1 if ($a eq $noch);
    $B = -1 if ($b eq $noch);
    $A <=> $B;
}
sub log2($) {
    my $n = shift;
    my $v = log($n)/log(2);
    return $v;
}
sub l2($) {
    my $x = shift;
    my $y = log2($x);
    my $i = int($y);
    my $f = abs($y - $i);
    return ($y, $i, $f);
}
sub l2_dots($$) {
    my $dt = shift;
    my $dots = shift;

    my $d = 1 << $dots;
    my $n = 2 * $d - 1;
    my $f = $n / $d;
    return l2($dt / $f);
}
sub l2_tupl($$) {
    my $dt = shift;
    my $tupl = shift;
    return l2($dt * $tuplets[$tupl]);
}
sub note_len($;$) {
    my $dt = shift;
    my $qq = shift;

    if ($dt !~ m/^\d+$/) {
	err "Not a positive number: <$dt>";
	return ("-",0,0,0);
    }
    my $qn = $dt / ( 4* $ticks );

    my $emin = 2;
    # neutral in length
    my ($yy, $ii, $ff) = l2($qn);
    if ($yy == $ii) {
	return ($ii, 0, 0, 0);
    }
    my $en = $ff;
    $emin = $en;
    my $ee = "normal";

    # + in length, longer notes
    my $ed = 2;
    my $dix;
    for (my $dots = 1; $dots <= $opt_maxdots; $dots++) {
	($yy, $ii, $ff) = l2_dots($qn,$dots);
	if ($yy == $ii) {
	    return ($ii, $dots, 0, 0);
	}
	if ($ff < $ed) {
	    $ed = $ff;
	    $dix = $dots;
	}
    }
    if ($ed < $emin) { $emin = $ed; $ee = "dots"; }

    # perhaps with ties
    my $et = 2;
    my $tix;
    for (my $ties = 0; $ties < @ties; $ties++) {
	my $f = $ties[$ties];
	($yy, $ii, $ff) = l2($qn / $f);
	if ($yy == $ii) {
	    return ($ii, 0, 0, $f);
	}
	if ($ff < $et) {
	    $et = $ff;
	    $tix = $ties;
	}
    }
    if ($et < $emin) { $emin = $et; $ee = "ties"; }

    # - in length, shorter notes
    my $ep = 2;
    my $pix;
    for my $tp (@tuplets) {
	($yy, $ii, $ff) = l2($qn * $tp);
	if ($yy == int($ii)) {
	    return ($ii, 0, $tp, 0);
	}
	if ($ff < $ep) {
	    $ep = $ff;
	    $pix = $tp;
	}
    }
    if ($ep < $emin) { $emin = $ep; $ee = "tuplets"; }
    $qn *= 16;
    #print "$dt/$qn: $ee $emin $en $ed/$dix $et/$tix $ep/$pix\n";

    return ("-",0,0,0);
}
sub dt2sym($) {
    my $dt = shift;
    my ($ii, $dots, $tp, $ties) = note_len($dt);

    my $sym = "";
    #print "$dt: $ii/$dots/$tp/$ties\n";
    if ($ii eq "-") {
#       print "   Print strange note length: $dt (ticks = $ticks)\n";
	$sym = "*($dt)*";
    } elsif ($ii >= 0) {
	if ($ii < @long_note) {
	    $sym = $long_note[$ii];
	} else {
	    err "Too long note";
	}
    } else {
	$sym = 1 << (-$ii);
    }
    $sym .= "." x $dots;
    if ($ties) { $sym .= "*$ties"; }
    return $sym;
}
sub cache_durations() {
    # this only conciders notes, since rests are not in the midi file
    # and rests also depends how you distribute used notes to voices
    @duration = sort sort_num keys %duration;
    for my $dt (@duration) {
	my $r = $duration{$dt};
	my $lstr = dt2sym($dt);
	$$r[1] = $lstr;
	# TODO: handle tuplets
    }
}

sub parse_opt_bar() {
    if ($opt_bar =~ m/^(\d+)?(\.\.(\d+)?)?$/) {
	my $sta = $1;
	my $end = $3;
	if (!defined($sta)) { $sta = 0; }
	if (!defined($end)) { $end = -1; }
	if ($opt_verbose) { print "Bar: $sta..$end\n"; }
	$opt_bar = [$sta, $end];
    } else {
	print "strange bar range <$opt_bar>\n";
	$opt_bar = [0, -1];
    }
}

sub parse_opt_track($) {
    my $sz = shift; # scalar(@tr)

    if ($opt_track eq "") {
	@track_list = 0..($sz-1);
    } else {
	# now $opt_track is non_empty
	my @fld = split(/,/, $opt_track);

	my %list = ();
	$list{0} = 1; # always include track 0, it contains the time signature event
	for my $n (@fld) {
	    if ($n =~ m/^(\d+)(\.\.(\d+|[\$\#]|))?$/) {
		if (defined($3)) {
		    if ($3 =~ /d+/) {
			$list{$_} = 1 foreach($1..$3);
		    } else {
			$list{$_} = 1 foreach($1..($sz-1));
		    }
		} else {
		    $list{$1} = 1;
		}
	    } else {
		err "strange things ($n) in track option ($opt_track)";
	    }
	}
	@track_list = sort { $a <=> $b } keys %list;
    }
    # and make it quickly findable
    for (my $ix = 0; $ix < @track_list; $ix++) {
	my $n = $track_list[$ix];
	$track_list{$n} = $ix;
    }
}

sub proc_file($) {
    my $file = shift;

    @info_list = ();
    @err_list = ();
    info("File: $file");

    my $opus = MIDI::Opus->new({
	'from_file' => $file,
	no_eot_magic => 1
    });
    $nformat = $opus->format();
    $ntracks = $opus->tracks();
    $ticks   = $opus->ticks();

    # MThd data, see [2] page 4
    info(
	"format: $nformat",
	"tracks: $ntracks",
	"ticks : $ticks (also called divisions)",
    );

    # some consitensy checks
    if ($nformat == 0 && $ntracks != 1) {
	print "Strange file, format 0 only allow 1 track, this one has $ntracks\n";
	return;
    }
    if ($nformat > 1) {
	print "Sorry, doesn't handle any other formats than 0 and 1 currently\n";
	return;
    }

    if ($ticks < 0) {
	# TODO
	print "Sorry, doesn't support smpte time settings\n";
	return;
    }

    run_callbacks($callback_init);

    my @tr = $opus->tracks();
    parse_opt_track(@tr+0);
    for my $track (@track_list) {
	next unless (defined($track));
	my @orig_event;
	{
	    my $r = $tr[$track];
	    if (!defined($r)) {
		err "no track $track";
		next;
	    }
	    my $type = $r->type();
	    @orig_event = $r->events();

	    if ($opt_verbose) {
		my $cnt = @orig_event;
		print "Track $track: type $type, has $cnt elements\n";
	    }
	    if ($type ne "MTrk") {
		print "track $track: not a \"MTrk\", cannot handle it\n";
		next; # track
	    }
	}

	my $sta_time = 0;
	%active_note = ();
	for my $ev (@orig_event) {
	    # this is a copy so $opus will be freed at end of sub
	    my @event = @$ev; # @event = ( event_name, delta_time, event_data... )
	    my $name = shift @event;
	    my $dtime = shift @event;

	    # keep track of total time (i.e. time from start of track)
	    $sta_time += $dtime;
	    if ($file_endtime < $sta_time) { $file_endtime = $sta_time; }

	    # find event handler data, an array ref
	    my $ar = $dispatch{$name};
	    if (!defined($ar) || ref($ar) ne "ARRAY") {
		print "No handler for \"$event[0]\"\n";
		next; # event
	    }
	    my $func = $$ar[1];
	    if (&$func($name, $callback_import, $track, $sta_time, @event) || $opt_verbose > 3) {
		my $sym = "";
		if ($name eq "note_on" || $name eq "note_off") {
		    my $midi_note = $event[1];
		    $sym = " (" . midinote2ly(0, $midi_note) . ")";
		}
		err sprintf "\t\[ %s %2d %7d %s \]%s", $name, $track, $sta_time, join(" ", @event), $sym;
	    }
	}
	for my $channel (keys %active_note) {
	    for my $note (keys %{$active_note{$channel}}) {
		my $event = $active_note{$channel}{$note};
		my $ref = [ $channel, $note, 0 ];
		err("note not finished at track end: $track, $channel, $note");
		note_off("note_off", $track, $file_endtime, $ref);
	    }
	}
    }

    run_callbacks($callback_finish);

    if ($opt_verbose > 0) {
	print "end_tim: $file_endtime\n";
    }
}

sub notestep2ly($$) {
    my $key = shift;
    my $ntone = shift;

    my $sym = "";
    if ($key < 0) {
	$sym = $note_es[$ntone];
    } else {
	$sym = $note_is[$ntone];
    }
    return $sym;
}

sub oct2sym($) {
    my $oct = shift;
    my $sym;
    if ($oct >= 0) {
	$sym = "'" x $oct;
    } else {
	$sym = "," x -$oct;
    }
    $sym;
}

sub midinote2ly($$;$) {
    my $key = shift;
    my $note = shift;
    my $old = shift;
    if ($note == -1) { return ( "r", -1 ); }
    my $ntone = $note % 12;
    my $sym = notestep2ly($key,$ntone);
    # 60 is middle c, its $oct = 5
    # and oct = 4 is small octave
    my $oct = int($note / 12) - 4;

    if (!defined($old)) { # use absolute
	$sym .= oct2sym($oct);
	#print "$note: $ntone $oct $sym\n";
    } else { # relative
	#print "relative $key/$note/$old\n";
	my $otone = $old % 12;
	my $oct2  = int($old / 12) - 4;
	my $sym2  = notestep2ly($key,$otone);
	#print "midinote2ly: $sym/$oct $sym2/$oct2\n";
	my $step  = $alph{substr($sym,0,1)}  + 7*$oct;
	my $step2 = $alph{substr($sym2,0,1)} + 7*$oct2;
	my $diff = $step - $step2;
	my $sign = 1;
	if ($diff < 0) {
	    $sign = -1;
	    $diff = -$diff;
	}
	my $doct = int(($diff+3)/7);
	$sym .= oct2sym($sign*$doct);
	#print "$sym/$step/$oct $sym2/$step2/$oct2 $diff:$doct\n";
    }
    #print "\n";
    return $sym;
}

sub print_durations() {
    my $cnt = 0;

    print "Duration 1/4     Count note_len\n";
    for (my $ix = 0; $ix < @duration; $ix++) {
	my $dt = $duration[$ix];
	my $v = $duration{$dt}[0];
	my $l = $duration{$dt}[1];
	my $diff = 0;
	#if ($ix < $#duration) { $diff = $duration[$ix+1] - $dt; }
	printf "%6d %8.4f %6d", $dt, $dt/$ticks, $v;
	if ($l) { print " $l"; }
	print "\n";
	$cnt += $v;
    };
    printf "Total: %6d notes\n", $cnt;
    #print Dumper(%duration);
}

sub print_notecount($$) {
    my $track = shift;
    my $channel = shift;

    my $cnt = 0;
    my $ref;
    if ($track eq "all") {
	$ref = $midi_note{all};
    } else {
	$ref = $midi_note{$track}{$channel};
    }
    print "\n";
    print "Note count for track \"$track\"\n";
    print "note# note count\n";
    for my $k (sort sort_num keys %$ref) {
	my $sym = midinote2ly(0,$k);
	printf "%3d %-6s %4d\n", $k, $sym, $$ref{$k};
	$cnt += $$ref{$k};
    }
    printf "Total: %6d notes\n", $cnt;
}

sub mid_debug() {
    return if ($opt_verbose <= 1);

    print "\nStatistics:\n";
    #stack_statistics();
    print_durations();
    print_notecount("all", 0);
    char_cache_dump();

    for (my $track = 0; $track < @midi; $track++) {
	next if (!defined($midi[$track]));
	print "\n";
	print "########################################################################\n";
	print "## Track $track\n";
	print_notecount($track, "all");
	for my $channel (sort keys %{$midi[$track]}) {
	    print " channel $channel\n";
	    my @ev = sort sort_ev keys %{$midi[$track]{$channel}};
	    my @eva = grep( !/^(note_on|lyric)$/, @ev);
	    my @evb = grep(  /^(note_on|lyric)$/, @ev);
	    for my $ev (@eva) {
		my $r = $midi[$track]{$channel}{$ev};
		print "   $ev:\n";
		event_print(undef, @$r);
	    }
	    if ($opt_verbose >= 3) {
		for my $ev (@evb) {
		    my $r = $midi[$track]{$channel}{$ev};
		    print "   $ev:\n";
		    event_print(undef, @$r);
		}
	    }
	}
    }

}

sub header() {
    #print "\n%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
    print "\\version \"2.16.0\"\n";
    print "\n";
    if (@info_list) {
	print "% Midi information:\n";
	for my $str (@info_list) {
	    print "% $str\n";
	}
	print "\n";
    }
    if (@err_list) {
	print "% Errors or unhandled data:\n";
	for my $str (@err_list) {
	    print "% $str\n";
	}
	print "\n";
    }
    print "\\header {\n";

    if ($title) {
	print "  title = \"$title\"\n";
    } else {
	print "  %title = \"\"\n";
    }

    my $composer;
    my $tagline = "";
    my $ref = $midi[0]{$noch}{text_event};
    if ($ref) {
	my @tagline = @$ref;
	if (@tagline && $tagline[0]{sta}[0] == 0) {
	    $composer = $tagline[0]{data};
	    for (my $ix = 1; $ix < @tagline; $ix++) {
		last if ($tagline[$ix]{sta}[0] > 0);
		$tagline .= $tagline[$ix]{data}; # TODO
	    }
	}
    }
    if ($composer) {
	print "  composer = \"$composer\"\n";
    } else {
	print "  \%composer = \"\"\n";
    }

    my @copyr = ();
    $ref = $midi[0]{$noch}{copyright_text_event};
    if ($ref) {
	for my $r (@$ref) {
	    push @copyr, $$r{data};
	}
    }
    if (@copyr) {
	my $cr;
	if (@copyr == 1) {
	    $cr = "  copyright = \"$copyr[0]\"\n";
        } else {
	    $cr = "  copyright = \\markup \\center-column {\n";
	    for (@copyr) {
		$cr .= "    \\line { $_ }\n";
	    }
	    $cr .= "  }\n";
	}
	print $cr;
    } else {
	print "  \%copyright = \"\"\n";
    }

    if ($tagline) {
	print "  tagline = \"$tagline\"\n";
    } else {
	print "  tagline = \"\"\n";
    }

    print "}\n";
    print "\n";
}

########################################################################
##### postprocessors ###################################################

sub event_heads($) {
    my $track = shift;

    my %list = ();
    for my $ch (keys %{$midi[$track]}) {
	for my $event_type (keys %{$midi[$track]{$ch}}) {
	    $list{$event_type} = $midi[$track]{$ch}{$event_type};
	}
    }
    if ($track > 0) {
	my @defaults = qw / time_signature set_tempo key_signature /;
	for my $event_type (@defaults) {
	    if (!defined($list{$event_type})) {
		if (defined($midi[0]) && defined($midi[0]{$noch}) && defined($midi[0]{$noch}{$event_type})) {
		    $list{$event_type} = $midi[0]{$noch}{$event_type}
		}
	    }
	}
    }
    return %list;
}
sub restskip($$$) {
    my $rest = shift;
    my $old = shift;
    my $new = shift;

#    print "restskip old: ", join(" ", @$old), "\n";
#    print "restskip new: ", join(" ", @$new), "\n";
    if (defined($new) && defined($old)) {
	my $dbar = $$new[1] - $$old[1];

	if ($$old[2] == 0) {
	    $dbar--;
	    #print "
	} else {
	    if ($dbar > 0) {
	    }
	}
    } else {
	print "restskip: undef\n";
    }
}
sub post_song($) {
    # this postprocessor assumes:
    #  only one simultaneous note per track
    #  dito lyrics
    my $file = shift;

#    for (my $track = 0; $track < @midi; $track++) {
    for (my $track = 0; $track < 2; $track++) {
	next unless (defined($midi[$track]));
	my @channel = sort keys %{$midi[$track]};
	my $lyr = "";
	my $mus = "";
	my @other = ();

	for my $channel (@channel) {
	    my @k = sort keys %{$midi[$track]{$channel}};
	    my @l = grep  /^lyric$/, @k;
	    my @r = grep !/^lyric$/, @k;
	    my @m = grep  /^note_on$/, @r;
	    @r    = grep !/^note_on$/, @r;
	    if (@l) { $lyr = $channel; }
	    if (@m) { $mus = $channel; }
	    for my $k (@r) {
		push @other, [ $channel, $k ];
	    }
	}

	if ($opt_verbose) {
	    print "Track: $track\n";
	    print "  channels: ", join(" ", @channel), "\n";
	    print "  l: $lyr\n" if ($lyr ne "");
	    print "  m: $mus\n" if ($mus ne "");
	    for my $r (@other) {
		print "  $$r[0] $$r[1]\n";
	    }
	}

	# here comes code hopefully...
	my $ts = -1;
	my %list = event_heads($track);
	my @events = sort sort_ev keys %list;
	print " Track $track events: ", join(" ", @events), "\n";

	my %ix;
	$ix{$_} = 0 foreach (@events);
	my $time_nxt = undef;
	my $time_old = [ 0, 0 , 0];

	while(1) {
	    $time_nxt = undef;
	    # find next closest time
	    for my $ev (@events) {
		my $ref = $list{$ev}[$ix{$ev}];
print Dumper($ref);
last;
		if (!defined($ref) || !defined($$ref{sta})) {
		    next;
		}
		my $time_new = $$ref{sta};
		my $tst = $$time_new[0];
		if (!defined($time_nxt)) {
		    $time_nxt = $$time_new[0];
#		    my $str = restskip($pausIsSkip, $time_old, $time_new);
#		    print "$str\n";
		} else {
		    if ($tst < $time_nxt) {
			$time_nxt = $tst;
		    }
		}
	    }

	    last if (!defined($time_nxt));
	    last if ($time_nxt > 1000);

	    # process events with this time
	    print "% Timestep $time_nxt\n";
	    for my $ev (@events) {
		if (!defined($list{$ev}[$ix{$ev}])) {
		    next;
		}
		my $tst = $list{$ev}[$ix{$ev}]{sta}[0];
		while (defined($tst) && $tst == $time_nxt) {
		    my $f = $dispatch{$ev}[1];
		    my $str = &$f($ev, $callback_ly, $list{$ev}[$ix{$ev}]);
		    if ($str) { print "$str\n"; }
		    $ix{$ev}++;
		    $tst = $list{$ev}[$ix{$ev}]{sta}[0];
		}
	    }
	    last if ($time_nxt >= $file_endtime);
	} # while(1)
    } # for (my $track = 0; $track < @midi; $track++)

    return;
}

my %postprocessors = (
    post_song => \&post_song,
);

sub main() {
    my $opt_postproc = "post_song";
    dispatch_init();
    GetOptions(
	"verbose+"    => \$opt_verbose,
	"track=s"     => \$opt_track,
	"proc=s"      => \$opt_postproc,
	"encoding=s"  => \$opt_encoding,
	"bar=s"       => \$opt_bar,
#	"bar_count=i" => \$opt_barcnt,
#	"pfx=s"       => \$opt_sympfx,
    ) || die("arg failure");

    parse_opt_bar();
    while (@ARGV) {
	my $file = shift @ARGV;
	# in principle one could do this conversion in one pass
	# but it is nice to now note durations
	%charcodes = ();
	proc_file($file);
	cache_durations();
	char_cache_guess_charset();
	char_decode_everything();
	if ($opt_verbose) {
	    mid_debug();
	    #return;
	}
	header();
	my $pp = $postprocessors{$opt_postproc};
	if (defined($pp)) {
	    &$pp($file);
	}
    }
}

main();

__END__

    if ($track > 0) { return; }

    my $tr_name = $track_name[$track];
    my $instr   = $instrument[$track];

    my $old_bar = 0;
    my $old_len = 0; # default is 4/4
    print "time_and_tempo = {\n";
    for (my $ix = 0; $ix < @currTimeSig; $ix++) {
	my $sta_time    = $currTimeSig[$ix][0];
	my $tickperbar  = $currTimeSig[$ix][3];
	my $barnumber   = $currTimeSig[$ix][4];

	my $str = time_sig2ly($currTimeSig[$ix]);
	my $db = $barnumber - $old_bar;
	if ($db > 0) {
	    my $ls = dt2sym($old_len);
	    my $a = $old_bar + 1;
	    my $b = $barnumber;
	    print "  s$ls*$db | % $a..$b\n";
	}
	print "  $str\n";
	$old_bar = $barnumber;
	$old_len = $tickperbar;
    }
    print "}\n";

