dice-game

#!/usr/bin/env perl
use strict;
use warnings;

##
# Musical dice game, attributed to Mozart
# Write-up: https://ology.github.io/2022/01/17/if-mozart-were-a-programmer/
# 16 measures x 11 dice sums (2-12) = 176 2D-grid of 3/8 measures
# Examples:
#   $ perl dice-game
#   $ perl dice-game  8 80 0 0
#   $ perl dice-game 16 70 4 35 39,45,7,8,26,44,48,9,25,8,37,19,28,39,31,29
#   $ timidity dice-game.mid
##

use MIDI::Util qw(setup_score set_chan_patch);
use Music::Cadence ();

use constant DQN => 'dqn';     # Dotted-quarter-note duration
use constant TOTAL_BARS => 48; # Total available measure subroutines

my $max    = shift || 16; # Number of measures to produce
my $bpm    = shift || 70; # Beats per minute
my $tpatch = shift // 4;  # Treble patch
my $bpatch = shift // 0;  # Bass patch
my $choice = shift || ''; # Comma-separated sub numbers. Blank for random

# Declare the available measures
my @barst = map { my $sub = 'bart' . $_; \&$sub } 1 .. TOTAL_BARS; # Treble
my @barsb = map { my $sub = 'barb' . $_; \&$sub } 1 .. TOTAL_BARS; # Bass

my $score = setup_score(bpm => $bpm);

# Choose the measures to play - either user defined or at random
# * Technically, this should be the sum of two dice for random choice
my @choices = $choice
    ? map { $_ - 1 } split /,/, $choice
    : map { int rand @barst } 1 .. $max;

# Define the procedures to actually play the chosen measures
my $tproc = sub { # Treble
    set_chan_patch($score, 0, $tpatch);
    # Add phrases to the score
    $barst[$_]->() for @choices;
    # Outro
    my $mc = Music::Cadence->new(octave => 4, format => 'midinum');
    my $chords = $mc->cadence(type => 'plagal');
    $score->n(DQN, @$_) for @$chords;
    $chords = $mc->cadence(type => 'perfect');
    $score->n(DQN, @$_) for @$chords;
};
my $bproc = sub { # Bass
    set_chan_patch($score, 1, $bpatch);
    # Add phrases to the score
    $barsb[$_]->() for @choices;
    # Outro
    $score->n(DQN, $_) for qw(F3 C3 G3 C2);
};

# Mash the phrases together
$score->synch($tproc, $bproc);

$score->write_score("$0.mid");

# Available measures:

sub bart1 {
    print '', (caller(0))[3], "\n";
    $score->n('en', $_) for qw(F5 D5 G5);
}
sub barb1 {
    $score->n('en', $_) for qw(F3 D3 G3);
}
sub bart2 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(en A4));
    $score->n('sn', $_) for qw(Fs4 G4 B4 G5);
}
sub barb2 {
    $score->n(qw(qn B2 G3));
    $score->r(qw(en));
}
sub bart3 {
    print '', (caller(0))[3], "\n";
    $score->n('en', $_) for qw(G5 C5 E5);
}
sub barb3 {
    $score->n(qw(qn C3 E3));
    $score->r(qw(en));
}
sub bart4 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(en G5));
    $score->n(qw(qn D5));
}
sub barb4 {
    $score->n('sn', $_) for qw(G2 B2);
    $score->n('en', $_) for qw(G3 B2);
}
sub bart5 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(qn G5 D5 B4 G4));
    $score->r(qw(en));
}
sub barb5 {
    $score->n(qw(en G2));
    $score->n(qw(sn B3 G3));
    $score->n(qw(sn G3 F3));
    $score->n(qw(sn Fs3 E3));
    $score->n(qw(sn E3 D3));
}
sub bart6 {
    print '', (caller(0))[3], "\n";
    $score->n('en', $_) for qw(G4 C5 E5);
}
sub barb6 {
    barb3();
}
sub bart7 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(E5 C5 E5 G5 C6 G5);
}
sub barb7 {
    $score->n(qw(qn C3 G3));
    $score->r(qw(en));
}
sub bart8 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(qn C5));
    $score->r(qw(en));
}
sub barb8 {
    $score->n('en', $_) for qw(C3 G2 C2);
}
sub bart9 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(en E5 C5));
    $score->n(qw(en B4 D5));
    $score->r(qw(en));
}
sub barb9 {
    $score->n(qw(qn G3));
    $score->n(qw(en G2));
}
sub bart10 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(B4 A4 B4 C5 D5 B4);
}
sub barb10 {
    $score->n(qw(qn G3));
    $score->r(qw(en));
}
sub bart11 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(E5 C5 B4 A4 G4 Fs4);
}
sub barb11 {
    $score->n('en', $_) for qw(C3 D3 D2);
}
sub bart12 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(en C5 E4)) for 1 .. 3;
}
sub barb12 {
    $score->n(qw(en C3)) for 1 .. 3;
}
sub bart13 {
    print '', (caller(0))[3], "\n";
    $score->n('en', $_) for qw(C5 G4 E4);
}
sub barb13 {
    $score->n(qw(qn E3 G3));
    $score->r(qw(en));
}
sub bart14 {
    bart8();
}
sub barb14 {
    barb8();
}
sub bart15 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(en E5));
    $score->n('sn', $_) for qw(G5 E5);
    $score->n(qw(en C5));
}
sub barb15 {
    $score->n(qw(qn C3 G3));
    $score->n(qw(en C3 E3));
}
sub bart16 {
    print '', (caller(0))[3], "\n";
    $score->n('en', $_) for qw(A5 Fs5 D5);
}
sub barb16 {
    $score->n(qw(qn Fs3 D3));
    $score->n(qw(en C3 Fs3));
}
sub bart17 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(C5 G4 C5 E5 G4 C5);
}
sub barb17 {
    barb13();
}
sub bart18 {
    print '', (caller(0))[3], "\n";
    $score->n('en', $_) for qw(G4 C5 E5);
}
sub barb18 {
    $score->n(qw(qn C3 E3));
    $score->n(qw(en C3 G3));
}
sub bart19 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(E5 C5);
    $score->n('en', $_) for qw(E5 G5);
}
sub barb19 {
    $score->n(qw(qn C3 G3));
    $score->n(qw(en C3 E3));
}
sub bart20 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(en G5));
    $score->n('sn', $_) for qw(B5 D6);
    $score->n(qw(en D5));
}
sub barb20 {
    $score->n(qw(qn D3));
    $score->r(qw(en));
}
sub bart21 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(C5 E5 G5 D5 A4 Fs5);
}
sub barb21 {
    barb11();
}
sub bart22 {
    print '', (caller(0))[3], "\n";
    $score->n('en', $_) for qw(E5 C5 G4);
}
sub barb22 {
    $score->n(qw(qn C3));
    $score->r(qw(en));
}
sub bart23 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(F5 E5 D5 E5 F5 G5);
}
sub barb23 {
    $score->n('sn', $_) for qw(F3 E3 D3 E3 F3 G3);
}
sub bart24 {
    bart5();
}
sub barb24 {
    barb5();
}
sub bart25 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(D4 Fs4 A4 D5 Fs5 A5);
}
sub barb25 {
    $score->n(qw(qn D3));
    $score->n(qw(en C3));
}
sub bart26 {
    print '', (caller(0))[3], "\n";
    for (1 .. 3) {
        $score->n(qw(en C5 E5));
    }
}
sub barb26 {
    $score->n('sn', $_) for qw(C3 E3 G3 E3 C4 C3);
}
sub bart27 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(F5 E5 F5 D5 C5 B4);
}
sub barb27 {
    $score->n(qw(qn G3 B3));
    $score->r(qw(en));
}
sub bart28 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(Fs5 D5 A4 A5 Fs5 D5);
}
sub barb28 {
    $score->n(qw(qn C3 A3));
    $score->r(qw(en));
}
sub bart29 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(B4 D5 G5 D5);
    $score->n(qw(en B4));
}
sub barb29 {
    barb9();
}
sub bart30 {
    bart5();
}
sub barb30 {
    barb5();
}
sub bart31 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(E5 C5);
    $score->n('en', $_) for qw(G4 E5);
}
sub barb31 {
    $score->n(qw(qn C3 G3));
    $score->n(qw(en C3 G3));
}
sub bart32 {
    print '', (caller(0))[3], "\n";
    $score->n('en', $_) for qw(G4 C5 F5);
}
sub barb32 {
    barb6();
}
sub bart33 {
    bart5();
}
sub barb33 {
    barb5();
}
sub bart34 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(E5 C5 D5 B4);
    $score->n(qw(en G4));
}
sub barb34 {
    barb10();
}
sub bart35 {
    print '', (caller(0))[3], "\n";
    $score->n('en', $_) for qw(A4 D5 Fs5);
}
sub barb35 {
    $score->n(qw(qn Fs3 D3));
    $score->n(qw(en C3 A3));
}
sub bart36 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(A4 E5 D5 G5 Fs5 A5);
}
sub barb36 {
    barb11();
}
sub bart37 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(G5 B5 G5 D5);
    $score->n(qw(en B4));
}
sub barb37 {
    $score->n(qw(qn B3 D3));
    $score->r(qw(en));
}
sub bart38 {
    print '', (caller(0))[3], "\n";
    $score->n('en', $_) for qw(C5 G4 E5);
}
sub barb38 {
    for (1 .. 3) {
        $score->n(qw(sn C3 E3));
        $score->n(qw(sn G3));
    }
}
sub bart39 {
    print '', (caller(0))[3], "\n";
    $score->n('en', $_) for qw(G5 G4 G4);
}
sub barb39 {
    $score->n('sn', $_) for qw(B2 D3 G3 D3 B2 G2);
}
sub bart40 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(C5 B4 C5 E5 G4 C5);
}
sub barb40 {
    barb6();
}
sub bart41 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(C5 B4 C5 E5);
    $score->n(qw(en G4));
}
sub barb41 {
    barb6();
}
sub bart42 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(B4 C5 D5 B4 A4 G4);
}
sub barb42 {
    $score->n(qw(qn A2));
    $score->r(qw(en));
}
sub bart43 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(en G5));
    $score->n('sn', $_) for qw(F5 E5 D5 C5);
}
sub barb43 {
    barb6();
}
sub bart44 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(en A4));
    $score->n('sn', $_) for qw(F5 D5 A4 B4);
}
sub barb44 {
    $score->n(qw(qn F3));
    $score->n(qw(en G3));
}
sub bart45 {
    print '', (caller(0))[3], "\n";
    $score->n('sn', $_) for qw(C5 B4 C5 G4 E4 C4);
}
sub barb45 {
    barb13();
}
sub bart46 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(en G5));
    $score->n('sn', $_) for qw(B5 G5 D5 B4);
}
sub barb46 {
    barb37();
}
sub bart47 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(en G5));
    $score->n('sn', $_) for qw(G5 D5);
    $score->n(qw(en B5));
}
sub barb47 {
    barb37();
}
sub bart48 {
    print '', (caller(0))[3], "\n";
    $score->n(qw(en E5));
    $score->n('sn', $_) for qw(C5 E5 G5 C6);
}
sub barb48 {
    barb19();
}