package PCSpeakerSheet;

use v5.24;

use utf8;
use strict;
use warnings;

use Carp;
use Data::Dumper;

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

use constant {
    US_TO_MS => 1_000_000,
    MAX_SIMULTANEOUS_NOTES => 100,
};

=head1 NAME

    PCSpeakerSheet.pm -- PC Speaker Sheet creator

=head1 SYNOPSIS

    use PCSpeakerSheet;

    # create new empty sheet
    my $sheet = PCSpeakerSheet->new;

    # redistribute notes from various sheets, possibly decreasing
    # the number of required tracks
    my $sheet = PCSpeakerSheet->join_sheets(@other_sheets);

    # add a note starting at 300 ms on channel $ch and key $k
    $sheet->note_on(300_000, $ch, $k);

    # turn off previous note at 350 ms
    $sheet->note_off(350_000, $ch, $k);

    # turn off all notes on given channel at 400 ms
    $sheet->all_notes_off(400_000, $ch);

    # turn off all notes on all channels at 450 ms
    $sheet->all_notes_off(450_000);

    # write duration or precise-based beeplay track
    $sheet->write_duration($id, $filename);
    $sheet->write_precise($id, $filename);

=head1 DESCRIPTION

This module aids with the conversion of notes from midi files to a text
format for C<beeplay>. As midi events are being processed (ordered
from the beginning of the play), the module records notes for each
channel. At the end it can dump the sheet to a text file.

General usage for a MIDI file looks like this:

    my @sheets;
    foreach my $track (@miditracks) {
        my $sheet = PCSpeakerSheet->new;

        foreach my $note ($track->notes) {
            # do something with the sheet, e.g
            $sheet->note_on(...);
            $sheet->note_off(...);
            # ...
        }

        push @sheets, $sheet;
    }

    # join sheets to reduce number of required tracks
    my $final = PCSpeakerSheet->join_sheets(@sheets);

=head2 Constructors

=over

=item C<new()>

    my $sheet = PCSpeakerSheet->new;

Creates an empty sheet.

=cut

sub new($class) {
    return bless {
        _playing => {},
        _idle    => {},
        _tracks  => [],
    }, $class;
};

=back

=head2 Private methods

I<See source code.>

=cut

# Create a new track and return it.
sub _add_new_track($self) {
    my $track = {
        notes => [],
    };

    push $self->{_tracks}->@*, $track;

    $track->{id} = $self->{_tracks}->$#*;

    $self->{_idle}->{$track->{id}} = undef;
    return $track;
}

# Find a track that is currently idle (no notes playing)
# or create a new one.
sub _get_idle_track($self) {
    my $track_id = (sort keys $self->{_idle}->%*)[0];

    return unless defined $track_id;
    return $self->{_tracks}->[$track_id];
}

# Convert MIDI key to a frequency in Hz.
sub _freq($self, $key) {
    my $exp = ($key - 21) / 12;
    return int(27.5 * 2 ** $exp);
}

=head2 Getters

=over

=item C<tracks()>

    my $count = $sheet->tracks;

Returns the number of tracks used so far.

=cut

sub tracks($self) {
    return scalar $self->{_tracks}->@*;
}

=back

=head2 Operations

=over

=item C<note_on()>

    $sheet->note_on($time, $channel, $key[, $srctrack[, $volume]]);

Mark a note being played from time C<$time> on channel C<$channel>
with the key C<$key>.

Additionally, a source track C<$srctrack> or C<$volume> can be provided.

=cut

sub note_on($self, $time, $channel, $key, $srctrack = -1, $volume = 1) {
    if (keys $self->{_playing}->%* > MAX_SIMULTANEOUS_NOTES) {
        croak "Too many notes playing >:c";
    }

    my %used_ids = map {
        /:(?<n>\d+)$/;
        $+{n} => 1
    } grep {
        /^$channel:$key:/
    } keys $self->{_playing}->%*;

    my $n = -1;
    my $v = $volume;
    while ($v > 0) {
        ++$n;

        next
            if $used_ids{$n};

        my $track = $self->_get_idle_track // $self->_add_new_track;
        my $note  = {
            start => $time,
            channel => $channel,
            key => $key,
            track => $track->{id},
            n => $n,
            volume => $volume,
        };

        my $id = join ':', $channel, $key, $srctrack, $n;
        push $track->{notes}->@*, $note;
        $self->{_playing}->{$id} = $note;
        delete $self->{_idle}->{$track->{id}};
        --$v;
    }
}

=item C<note_off()>

    $sheet->note_off($time, $channel, $key[, $srctrack]);

Stop playing a note at time C<$time> on channel C<$channel>
and key C<$key>. If the C<$srctrack> was provided for the corresponding
C<note_on()> call, then this parameter must also be provided here.

=cut

sub note_off($self, $time, $channel, $key, $srctrack = -1) {
    my $id = join ':', $channel, $key, $srctrack;

    foreach my $key (grep { /^$id/ } $self->{_playing}->%*) {
        my $note = delete $self->{_playing}->{$key};

        croak "note_off: note start time is after its finish"
            if $note->{start} > $time;

        $note->{end} = $time;
        $self->{_idle}->{$note->{track}} = undef;
    }
}

=item C<all_notes_off()>

    $sheet->all_notes_off($target_channel);
    $sheet->all_notes_off;

Turn all notes off on channel C<$target_channel> or all channels
if no parameter is provided.

=cut

sub all_notes_off($self, $time, $target_channel = undef) {
    foreach my $id (keys $self->{_playing}->%*) {
        my ($channel, $key) = ($id =~ /^(\d+):(\d+):/);
        next if defined $target_channel and $target_channel != $channel;

        $self->note_off($time, $channel, $key);
    }
}

=back

=head2 Output methods

=over

=item C<write_duration()>

    $sheet->write_duration($id, $filename);

Write the track C<$id> to a file C<$filename> in the duration-based
beeplay format.

The C<$id> is an integer from 0 (inclusively) to a number returned
by the C<tracks()> call (exclusively).

=cut

sub write_duration($self, $id, $filename) {
    my $track = $self->{_tracks}->[$id]
        or croak "no such track $id";

    open FH, ">:raw", $filename
        or croak "$filename: $!";

    my $last = 0;
    my $off  = 0;
    foreach my $note ($track->{notes}->@*) {
        if ($last < $note->{start}) {
            printf FH "%d\n", $note->{start} - $last;
        } elsif ($last > $note->{start}) {
            croak "note start delayed in track, this should not happen";
        }

        printf FH "%d %d\n", $note->{end} - $note->{start}, $self->_freq($note->{key});
        $last = $note->{start};
    }

    close FH;
}

=item C<write_precise()>

    $sheet->write_precise($id, $filename);

Write the track C<$id> to a file C<$filename> in the precise
beeplay format.

=cut

sub write_precise($self, $id, $filename) {
    my $track = $self->{_tracks}->[$id]
        or croak "no such track $id";

    open FH, ">:raw", $filename
        or croak "$filename: $!";

    foreach my $note ($track->{notes}->@*) {
        foreach my $type (qw(start end)) {
            printf FH "%03d %06d %4d\n",
                int($note->{$type} / US_TO_MS),
                int($note->{$type} % US_TO_MS),
                ($type eq 'start' ? $self->_freq($note->{key}) : 0);
        }
    }

    close FH;
}

=back

=head2 Class methods

=over

=item C<join_sheets()>

    my $sheet = PCSpeakerSheet->join_sheets(@sheets);

Reorganize notes between sheets to (possibly) decrease the number of
required tracks. This does not modify sheets provided as parameters,
but returns a new track.

=cut

sub join_sheets($class, @sheets) {
    my @tracks;

    # create copies of all tracks of every sheet
    foreach my $sheet (@sheets) {
        foreach my $track ($sheet->{_tracks}->@*) {
            # ignore empty tracks (shouldn't happen, but...)
            push @tracks, [ $track->{notes}->@* ]
                if $track->{notes}->@*;
        }
    }

    # virtual track for note_off events
    my $off = [];
    my $result = $class->new;
    my $end = 0;

    # recreate events list
    while (@tracks) {
        # select track with earliest event
        # prefer 'end' tunes to save tracks
        my $track = (sort {
            my $d = $a->[0]->{start} <=> $b->[0]->{start};
            $d || ($b->[0]->{off} // 0) <=> ($a->[0]->{off} // 0)
        } grep { @$_ > 0 } @tracks, $off)[0];

        my $note = shift @$track;
        $end = $note->{end};

        # virtual note_off
        if ($note->{off}) {
            $result->note_off($note->@{qw(end channel key)});
        # note_on event
        } else {
            $result->note_on($note->@{qw(start channel key)});

            # add virtual note_off event to $off track
            push @$off, {
                off   => 1,
                start => $note->{end},
                $note->%{qw(end channel key)},
            };

            $off = [ sort { $a->{start} <=> $b->{start} } @$off ];
        }

        # remove empty tracks except $off track
        @tracks = grep { @$_ > 0 } @tracks;
    }

    $result->all_notes_off($end);
    return $result;
}

=back

=head1 AUTHOR

    Roman Lacko <xlacko1@fi.muni.cz>

=cut

1;
