#!/usr/bin/env perl
# twi - send events to a MIDI device
use 5.36.0;
use List::Util  qw[shuffle];
use Time::HiRes qw[usleep];

#srand 640;
warn "SEED ", srand(), "\n";

my $record = shift;

# more clever would be to use MIDI clock events instead of what will be
# somewhat random delays over on the synth, which may interact with
# gates and whatnot there in random ways. but uh TODO
sub MS2US () { 1000 }          # usleep conversion for milliseconds
sub SHORT () { 300 * MS2US }   # how short the pedal note sometimes is
sub LONG ()  { 460 * MS2US }
sub CODA ()  { 100 * MS2US }

sub coinflip () { int rand 2 }

# assuming OpenBSD...
my $dev = shift // '/dev/rmidi0';
open my $fh, '>', $dev or die "open '$dev': $!\n";
binmode $fh;
$fh->autoflush(1);

# also assuming OpenBSD...
my $pid = $record ? record() : undef;
$SIG{__DIE__} = $SIG{INT} = $SIG{TERM} = \&bailout;

# D Hungarian minor, in no way adapted from the "Twilight Zone" theme
my $pedal = 70;
my @ps    = qw[61 62 64 65 68 69];
my $velo  = 96;

# TODO probably want to constrain theme to a certain number of measures,
# even if the number of pitches selected runs short or long? (and
# accounting for the random duration changes, too)
sub theme ( $prior = undef ) {
    my $subdur = 0;
    my @shuf;
    if ( defined $prior ) {
        @shuf = $prior->@*;
    } else {
        @shuf = @ps;
        push @shuf, $shuf[0] if coinflip;
        @shuf = shuffle @ps;
        splice @shuf, rand(@shuf), 1 + int rand 2;
    }
    warn "PS @shuf\n";
    for ( 1 .. 8 ) {
        for my $note (@shuf) {
            $subdur = coinflip;
            printf $fh "\x90%c%c", $pedal, $velo;
            # NOTE these little fiddly delays are to try to provoke
            # glides between the notes or such, depending on what the
            # synth is set to do
            usleep 20;
            printf $fh "\x90%c%c", $note, $velo;
            if ($subdur) {
                usleep SHORT;
                printf $fh "\x80%c%c", $pedal, 0;
                usleep LONG() - SHORT();
            } else {
                usleep LONG;
                printf $fh "\x80%c%c", $pedal, 0;
            }
            usleep 20;
            printf $fh "\x80%c%c", $note, 0;
        }
    }
    return \@shuf;
}

# ABBA, but without the Swedes
my @motifs;
push @motifs, theme for 1 .. 2;
theme($_) for reverse @motifs;
# once you get something not terrible you probably should lock it down.
# see also the srand line up at the top
#@motifs = ( [qw(62 64 69 61)], [qw(68 62 69 65 64)] );
#theme($_) for @motifs;
#theme($_) for reverse @motifs;

# a feeble attempt a coda
if (0) {
    for ( 1 .. 6 ) {
        printf $fh "\x90%c%c", $motifs[0][-1], $velo;
        usleep SHORT;
        printf $fh "\x80%c%c", $motifs[0][-1], $velo;
    }
    $velo += 20;
    if ( $velo > 120 ) {
        warn "tail velo clip";
        $velo = 120;
    }
    my $last = $motifs[0][-1] == 62 ? 69 : 62;
    printf $fh "\x90%c%c", $last, $velo;
    usleep CODA;
    printf $fh "\x80%c%c", $last, $velo;
}

bailout();

sub record {
    warn "recording...\n";
    my $pid = fork // die "fork\n";
    if ( $pid == 0 ) {
        exec qw(/usr/bin/aucat -h wav -o out.wav);
        die "exec failed??\n";
    } else {
        sleep 3;
        return $pid;
    }
}

sub bailout {
    warn "cleanup...\n";
    for my $pitch ( 0 .. 127 ) {
        printf $fh "\x80%c%c", $pitch, 0;
    }
    if ( defined $pid ) {
        my $target = $pid;
        undef $pid;
        sleep 3;
        kill TERM => $target;
        warn "waiting for recording process to exit...\n";
        wait;
    }
    exit;
}