#!/usr/bin/env perl

use v5.24;
use utf8;
use strict;
use warnings;

use feature qw(signatures);
no warnings qw(experimental::signatures);

use Data::Dumper;
use File::Basename qw(fileparse);
use FindBin qw($RealBin);
use Getopt::Long qw(:config bundling);
use MIDI::Event;
use MIDI::Opus;
use MIDI::Track;
use Pod::Usage;
use POSIX qw();

use lib $RealBin;
use PCSpeakerSheet;

use constant {
    DEFAULT_TEMPO => 120,
    TICKS_TO_MS   => 1_000,
    TICKS_TO_US   => 1,

    CC_ALL_SOUND_OFF => 120,
    CC_ALL_NOTES_OFF => 123,
};

my $options = {
    output => '%base-%id.beep',
    track  => undef,
};

#------------------------------------------------------------------------------

sub join_events(@tracks) {
    # sort events by their (absolute) delta_time
    return [ sort { $a->[1] <=> $b->[1] } map { @$_ } @tracks ];
}

sub extract_tempo_track($opus) {
    my $tempo = [];
    my %tickmap;

    # extract tempo events with absolute offsets in delta_time
    foreach my $track ($opus->tracks_r->@*) {
        foreach my $event (delta_to_abs_ticks($track)->@*) {
            # ignore all events except set_tempo
            next unless $event->[0] =~ /^(set_tempo|time_signature)$/;

            # copy the event with absolute ticks in delta_time
            push @$tempo, [ @$event ];

            my $ticks = $event->[1];
            $tickmap{$ticks} //= 0;

            warn "event clash at $ticks"
                if $tickmap{$ticks};

            ++$tickmap{$ticks};
        }
    }

    # sort events and return array of events
    return join_events($tempo);
}

sub delta_to_abs_ticks($track) {
    my $events = [];

    my $ticks = 0;
    foreach my $event ($track->events_r->@*) {
        $ticks += $event->[1];

        # copy the event
        my $evcopy = [ @$event ];
        $evcopy->[1] = $ticks;
        push @$events, $evcopy;
    }

    # return events (they are already sorted)
    return $events;
}

sub process_track($tempo, $tppq, $track, $id) {
    printf "track: %d\n", $id;

    my $sheet  = PCSpeakerSheet->new;
    my $events = join_events(delta_to_abs_ticks($track), $tempo);
    my $uspq   = DEFAULT_TEMPO;

    my $timer = 0;
    my $prev_ticks = 0;
    foreach my $event (@$events) {
        if ($options->{'dump-midi'}) {
            print STDERR join(' ', @$event), "\n";
        }

        my $delta = $event->[1] - $prev_ticks;

        if ($event->[0] eq 'set_tempo') {
            $uspq = $event->[2];
        } elsif ($event->[0] eq 'instrument_name') {
            print $event->[2], "\n";
        }

        $timer += ($delta * ($uspq / $tppq)) / TICKS_TO_US;

        if ($event->[0] =~ /^note_(on|off)$/) {
            my ($name, undef, $channel, $key, $velocity) = @$event;

            if ($name eq 'note_on' and $velocity == 0) {
                $name = 'note_off';
            }

            no strict 'refs';
            $sheet->$name(int($timer), $channel, $key);
        } elsif ($event->[0] eq 'control_change') {
            my ($name, undef, $channel, $code, $value) = @$event;

            if ($code == CC_ALL_SOUND_OFF or $code == CC_ALL_NOTES_OFF) {
                $sheet->all_notes_off(int($timer), $channel);
            }
        }

        $prev_ticks = $event->[1];
    }

    $sheet->all_notes_off(int($timer));
    return $sheet;
}

sub process_opus($opus) {
    my $tppq   = $opus->ticks;
    my $tracks = $opus->tracks_r;

    printf "ticks (TPPQ): %d\n", $tppq;
    printf "number of tracks: %d\n", scalar @$tracks;

    my $tempo = extract_tempo_track($opus);
    my @sheets;

    if ($options->{track}) {
        my $track = $tracks->[$options->{track}];
        die "no such track $options->{track}"
            unless defined $track;

        push @sheets, process_track($tempo, $tppq, $track, $options->{track});
    } else {
        for (my $id = 0; $id < @$tracks; ++$id) {
            push @sheets, process_track($tempo, $tppq, $tracks->[$id], $id);
        }
    }

    return PCSpeakerSheet->join_sheets(@sheets);
}

sub dump_sheet($sheet, $format, $base) {
    my $tracks = $sheet->tracks;

    foreach my $id (0..($tracks - 1)) {
        my $fn = $options->{output};

        $fn =~ s/%id/$id/g;
        $fn =~ s/%base/$base/g;

        die "refusing to overwrite $fn"
            if -f $fn and !$options->{force};

        if ($format eq 'precise') {
            $sheet->write_precise($id, $fn);
        } else {
            $sheet->write_duration($id, $fn);
        }
    }
}

#------------------------------------------------------------------------------

GetOptions($options, qw(h help duration|D precise|P output|o=s track|t=i force
        dump-midi))
    or pod2usage(-verbose => 1);

pod2usage(-exitval => 0, -verbose => 1) if $options->{h};
pod2usage(-exitval => 0, -verbose => 2) if $options->{help};
pod2usage(-verbose => 1) unless @ARGV == 1;

die "options --duration and --precise are mutually exclusive"
    if $options->{duration} and $options->{precise};

my ($ext)  = ($ARGV[0] =~ /(\.[^\.]+)$/);
my $base   = (fileparse($ARGV[0], $ext))[0];

my $opus   = MIDI::Opus->new({ from_file => $ARGV[0] });
my $sheet  = process_opus($opus);
my $format = $options->{duration} ? 'duration' : 'precise';

dump_sheet($sheet, $format, $base);

=head1 NAME

    midiconv -- create beeplay track files from a midi

=head1 SYNOPSIS

    midiconv [OPTIONS] --output=FORMAT MIDIFILE

    midiconv --track=10 midi/imperial.mid
    midiconf --output=imperial/track-%id.beep midi/imperial.mid

Short list of options

    -h                      show brief help and exit
        --help              show Perl POD page and exit

    -D  --duration          output tracks in duration-based format
    -P  --precise           output tracks in precise format

Run C<beeplay --help> to learn more about these output formats.

    -f  --force             allow to overwrite existing files
    -o  --output=WHERE      where to write generated tracks
    -t  --track=N           export track N instead of all tracks
        --dump-midi         dump midi events to STDERR

=head1 DESCRIPTION

C<midiconv> reads the given midi file and generates tracks that can
be played on a single computer with C<beeplay> or on many computers
in parallel with C<polybeep>.

If you intend to feed the tracks to C<polybeep>, use the C<--precise>
output format.

=head2 Output formats

There are two output formats, duration-based and precise.
TL;DR:

=over

=item

duration-based generates smaller track files, but is practically
useless if you intend to play various tracks of the same score
in parallel due to high chance of desynchronization

=item

precise format requires a bit more space, but is synchronized with
the beginning of the C<beeplay> script and therefore is better
suited to play tracks in parallel

=back

Refer to C<beeplay --help> for more details.

=head2 Output files

The script generates track files to a destination specified by the
C<output> parameter. This parameter can refer to a single file
or can contain the following format keys:

=over

=item C<%id>

ID of the track, starting from zero.

=item C<%base>

Basename of the midi file being converted.

=back

For example,

    midiconv --output=tracks/%base/%id.beep midi/game-of-thrones.midi

will create the following files:

    tracks/game-of-thrones/0.beep
    tracks/game-of-thrones/1.beep
    ...

Note that parent directories are B<NOT> created, you must create
them yourself.

If you specify only a single file, be sure to use the C<--track>
option, otherwise the script will try to overwrite the same
file for every track it generates. This will fail unless you
also provide the C<--force> flag, which makes little to no sense.

The default value is C<%base-%id.beep>.

=head1 OPTIONS AND ARGUMENTS

=head2 Input format selectors

At most one of the following arguments is allowed:

=over

=item C<-D>, C<--duration>

Create tracks in duration-based mode.
I<This is the default.>

=item C<-P>, C<--precise>

Create tracks in precise mode.

=back

Other options and arguments

=over

=item C<MIDIFILE>

Input midi file to extract tracks from.

=item C<-h>

Show brief help and exit.

=item C<--help>

Show Perl POD page and exit.

=item C<--force>

Allow to overwrite existing file.

=item C<-o>, C<--output=WHERE>

Where to store generated tracks.

The C<WHERE> path can contain format specifiers, see the L<DESCRIPTION>.

=item C<-t>, C<--track=N>

Extract only track number C<N> instead of all tracks.

=item C<--dump-midi>

Debugging option that will print processed midi events to standard
error output.

=back

=head1 AUTHOR

    Roman Lacko <xlacko1@fi.muni.cz>
