Mozart's dice

mozart.pl

#!/usr/bin/env perl

use strict;
use warnings;

use v5.32;
use experimental qw/ signatures /;

use MIDI;
use Path::This '$THISDIR';
use IO::Async::Loop;
use IO::Async::Timer::Periodic;
use IO::Async::Timer::Countdown;
use MIDI::RtMidi::FFI::Device;
use List::Util qw/ first /;

my $device = MIDI::RtMidi::FFI::Device->new;
$device->open_port_by_name( qr/loopmidi/i );

my $loop = IO::Async::Loop->new;

# Tables and MIDI files come from https://github.com/MarquisdeGeek/midilib

my $MinuetTable = [
 96,  22, 141,  41, 105, 122,  11,  30,  70, 121,  26,   9, 112,  49, 109,  14,
 32,   6, 128,  63, 146,  46, 134,  81, 117,  39, 126,  56, 174,  18, 116,  83,
 69,  95, 158,  13, 153,  55, 110,  24,  66, 139,  15, 132,  73,  58, 145,  79,
 40,  17, 113,  85, 161,   2, 159, 100,  90, 176,   7,  34,  67, 160,  52, 170,
148,  74, 163,  45,  80,  97,  36, 107,  25, 143,  64, 125,  76, 136,   1,  93,
104, 157,  27, 167, 154,  68, 118,  91, 138,  71, 150,  29, 101, 162,  23, 151,
152,  60, 171,  53,  99, 133,  21, 127,  16, 155,  57, 175,  43, 168,  89, 172,
119,  84, 114,  50, 140,  86, 169,  94, 120,  88,  48, 166,  51, 115,  72, 111,
 98, 142,  42, 156,  75, 129,  62, 123,  65,  77,  19,  82, 137,  38, 149,   8,
  3,  87, 165,  61, 135,  47, 147,  33, 102,   4,  31, 164, 144,  59, 173,  78,
 54, 130,  10, 103,  28,  37, 106,   5,  35,  20, 108,  92,  12, 124,  44, 131,
];

my $TrioTable = [
72,  6, 59, 25, 81, 41, 89,  13, 36,  5, 46, 79,  30, 95, 19, 66,
56, 82, 42, 74, 14,  7, 26,  71, 76, 20, 64, 84,   8, 35, 47, 88,
75, 39, 54,  1, 65, 43, 15,  80,  9, 34, 93, 48,  69, 58, 90, 21,
40, 73, 16, 68, 29, 55,  2,  61, 22, 67, 49, 77,  57, 87, 33, 10,
83,  3, 28, 53, 37, 17, 44,  70, 63, 85, 32, 96,  12, 23, 50, 91,
18, 45, 62, 38,  4, 27, 52,  94, 11, 92, 24, 86,  51, 60, 78, 31,
];

my $MinuetMids = [ map { MIDI::Opus->new({ 'from_file' => "$THISDIR/midilib/src/MIDIFiles/M$_.MID" }) } $MinuetTable->@* ];
my $TrioMids = [ map { MIDI::Opus->new({ 'from_file' => "$THISDIR/midilib/src/MIDIFiles/M$_.MID" }) } $TrioTable->@* ];
my $ppq = ppq( $MinuetMids->[0] );
my $tempo = tempo( $MinuetMids->[0]->tracks_r->[0] );
my $signature = signature( $MinuetMids->[0]->tracks_r->[0] );
my $tick = ( ( $tempo / $ppq ) / 1_000_000 );
my $bar = ( $tempo * $signature->{numerator} ) / 1_000_000;

say "PPQ: $ppq";
say "Tempo: $tempo";
say "Signature: $signature->{numerator} / $signature->{denominator} : $signature->{ticks} ";
say "Tick: $tick";

sub ppq( $opus ) {
    $opus->ticks;
}

sub event_by_name( $track, $event ) {
    first { $_->[0] eq $event } $track->events;
}

sub tempo( $track ) {
    event_by_name( $track, 'set_tempo' )->[2];
}

sub signature( $track ) {
    my $signature = event_by_name( $track, 'time_signature' );
    {
        numerator   => $signature->[2],
        denominator => $signature->[3],
        ticks       => $signature->[4],
    }
}

sub schedule_notes( $track, $tick ) {
    my $time;
    my @events = grep { $_->[0] =~ /^note/ } $track->events;
    my @timers = map {
        my $event = $_->[0];
        my $dtime = $_->[1];
        my $note  = $_->[-2];
        my $vel   = $_->[-1];
        $time += $dtime;
        IO::Async::Timer::Countdown->new(
            delay => $time * $tick,
            on_expire => sub {
                $device->send_event( $event => $note, $vel );
            }
        );
    } @events;
    $loop->add( $_->start ) for ( @timers );
}

sub rand_track {
    state $col = 0;
    $col %= 16;
    my $row = int( rand(11) );
    my $selection = ( $row * 16 ) + $col;
    $col++;
    say "Selection row: $row col: $col minuet: $MinuetTable->[ $selection ]";
    $MinuetMids->[ $selection ]->tracks_r->[0];
}

my $timer = IO::Async::Timer::Periodic->new(
    interval => $bar,
    reschedule => 'hard',
    on_tick => sub {
        schedule_notes( rand_track, $tick );
    }
);
$loop->add( $timer->start );

$loop->run;

Some words on this

https://fuzzix.org/18th-century-procedural-music-with-rtmidi