coltrane-and-company

#!/usr/bin/env perl

# Attempt to imitate John Coltrane via his mysterious circle diagram.
# Writeup: https://ology.github.io/2022/04/23/coltranes-mystery-music-diagram/

use strict;
use warnings;

use List::SomeUtils qw(first_index);
use Music::Bassline::Generator;
use MIDI::Chord::Guitar;
use MIDI::Drummer::Tiny;
use MIDI::Util qw(set_chan_patch);
use Music::Duration::Partition;
use Music::ScaleNote;

use constant HEAD   => 0;      # diagram index
use constant FIRST  => 1;      # "
use constant MIDDLE => 2;      # "
use constant PENULT => 3;      # "
use constant TAIL   => 4;      # "
use constant LEFT   => -1;     # direction
use constant RIGHT  => 1;      # "
use constant HIGH   => 6;      # octave bound
use constant LOW    => 4;      # "
use constant FORMAT => 'midi'; # note conversion format

my $max    = shift || 12;  # number of measures to play
my $bpm    = shift || 100; # beats per minute
my $jump   = shift || 0;   # allow jumps > 1
my $cpatch = shift || 66;  # soprano sax=64, alto=65, tenor=66, bari=67
my $hpatch = shift || 4;   # electric pianos=4 & 5, nylon guitar=24
my $bpatch = shift || 35;  # fretless bass=35
my $octave = shift || 5;   # starting octave

my $channel = 0; # initial midi channel

# instantiate a drummer object
my $d = MIDI::Drummer::Tiny->new(
    file => "$0.mid",
    bpm  => $bpm,
    bars => $max,
);

# play the parts simultaneously
$d->sync(
    \&drums,
    \&bass,
    # \&harmony,
    \&coltrane,
);

# write the score as a midi file
# $d->write;
$d->play_with_timidity;

sub drums {
    $d->metronome4($d->bars, $d->ride2, $d->quarter, 67);
    $d->note($d->quarter, $d->ride1, $d->kick);
}

sub bass {
    set_chan_patch($d->score, $channel++, $bpatch);

    my $bassline = Music::Bassline::Generator->new(
        tonic   => 1,
#       verbose => 1,
    );

    for my $spec (
        ['Cm7',    4, 'Fm7'],
        ['Fm7',    4, 'Cm7'],
        ['Cm7',    4, 'Cm7'],
        ['Cm7',    4, 'Fm7'],
        ['Fm7',    2, 'Cm7'],
        ['Cm7',    2, 'F#dim7'],
        ['F#dim7', 4, 'Cm7'],
        ['Cm7',    4, 'G'],
        ['G',      4, 'Ab7'],
        ['Ab7',    4, 'G7'],
        ['G7',     4, 'Cm7'],
        ['Cm7',    2, 'G7'],
        ['G7',     2, 'Dm7'],
        ['Dm7',    2, 'G7'],
        ['G7',     2, undef],
    ) {
        my $notes = $bassline->generate($spec->@*);
        $d->note('qn', $_) for @$notes;
    }
}

sub harmony {
    set_chan_patch($d->score, $channel++, $hpatch);

    my $mcg = MIDI::Chord::Guitar->new(voicing_file => "$ENV{HOME}/sandbox/MIDI-Chord-Guitar/share/midi-guitar-chord-voicings.csv");

    my $C      = $mcg->transform('C',  '',     0);
    my $C7     = $mcg->transform('C',  '7',    0);
    my $Cm7    = $mcg->transform('C',  'm7',   0);
    my $Dm7    = $mcg->transform('D',  'm7',   0);
    my $F      = $mcg->transform('F',  '',     0);
    my $F7     = $mcg->transform('F',  '7',    0);
    my $Fm7    = $mcg->transform('F',  'm7',   0);
    my $Fsdim7 = $mcg->transform('F#', 'dim7', 0);
    my $G      = $mcg->transform('G',  '',     0);
    my $G7     = $mcg->transform('G',  '7',    0);
    my $Af7    = $mcg->transform('Ab', '7',    0);

    my $half  = 'hn';
    my $whole = 'wn';

    for my $spec (
        [$whole, @$Cm7], [$whole, @$Fm7], [$whole, @$Cm7], [$whole, @$Cm7],
        [$half, @$Fm7], [$half, @$C7], [$whole, @$Fsdim7], [$whole, @$Cm7], [$whole, @$G7],
        [$whole, @$Af7], [$whole, @$G7], [$half, @$Cm7], [$half, @$G7], [$half, @$Dm7], [$half, @$G7],
    ) {
        $d->score->n(@$spec);
    }
}

sub coltrane {
    set_chan_patch($d->score, $channel++, $cpatch);

    # describe Coltrane's circle diagram
    my @outer = (
        [qw( Af Bf C  D  E  )],
        [qw( Gf Af Bf C  D  )],
        [qw( E  Gf Af Bf C  )],
        [qw( D  E  Gf Af Bf )],
        [qw( C  D  E  Gf Af )],
        [qw( Bf C  D  E  Gf )],
    );
    my @inner = (
        [qw( Df Ef F  G  A  )],
        [qw( B  Df Ef F  G  )],
        [qw( A  B  Df Ef F  )],
        [qw( G  A  B  Df Ef )],
        [qw( F  G  A  B  Df )],
        [qw( Ef F  G  A  B  )],
    );
    my %outer_links = (
        0 => {
            Af => [5],
            C  => [5,0],
            E  => [0],
        },
        1 => {
            Gf => [0],
            Bf => [0,1],
            D  => [1],
        },
        2 => {
            E  => [1],
            Af => [1,2],
            C  => [2],
        },
        3 => {
            D  => [2],
            Gf => [2,3],
            Bf => [3],
        },
        4 => {
            C  => [3],
            E  => [3,4],
            Af => [4],
        },
        5 => {
            Bf => [4],
            D  => [4,5],
            Gf => [5],
        },
    );
    my %inner_links = (
        0 => {
            Df => [0],
            F  => [0,1],
            A  => [1],
        },
        1 => {
            B  => [1],
            Ef => [1,2],
            G  => [2],
        },
        2 => {
            A  => [2],
            Df => [2,3],
            F  => [3],
        },
        3 => {
            G  => [3],
            B  => [3,4],
            Ef => [4],
        },
        4 => {
            F  => [4],
            A  => [4,5],
            Df => [5],
        },
        5 => {
            Ef => [5],
            G  => [5,0],
            B  => [0],
        },
    );

    # initial conditions
    my $in_out       = int rand 2; # choose a ring, inner or outer
    my $section_num  = int rand @inner; # choose a section of the ring
    my $section      = $in_out ? $inner[$section_num] : $outer[$section_num];
    my $index        = int rand @$section; # get the current note & its index
    my $current_note = $section->[$index]; # "
    my $direction    = int rand 2 ? RIGHT : LEFT; # which way are we headed?
    my $formatted; # The new note to generate

    # instantiate scale movement objects
    my $outer_scale = Music::ScaleNote->new(
      scale_note  => 'C',
      scale_name  => 'wholetone',
      note_format => FORMAT,
      flat        => 1,
#     verbose     => 1,
    );
    my $inner_scale = Music::ScaleNote->new(
      scale_note  => 'C#',
      scale_name  => 'wholetone',
      note_format => FORMAT,
      flat        => 1,
#     verbose     => 1,
    );

    # initialize phrase generators
    my $slow = Music::Duration::Partition->new(
        size    => 4, # 4 quarter notes = 1 measure
        pool    => [qw/ hn thn qn tqn /], # XXX but what note durations
        groups  => [    1, 3,  1, 3    ], # XXX did Coltrane actually
#       weights => [    1, 2,  1, 2    ], # XXX play?
    );
    my @slow_motifs = map { $slow->motif } 1 .. 2;
    my $fast = Music::Duration::Partition->new(
        size    => 4,
        pool    => [qw/ qn tqn en ten sn /],
        groups  => [    1, 3,  1, 3,  2   ],
        weights => [    1, 1,  2, 2,  2   ],
    );
    my @fast_motifs = map { $fast->motif } 1 .. 2;

    # produce max bars of phrases
    for my $n (1 .. $max) {
        warn sprintf "%d. %d (%s)[%d] = %s%d\n",
            $n, $section_num, "@$section", $index, $current_note, $octave;

        my $motif = $n <= 4
            ? $slow_motifs[ int rand @slow_motifs ]
            : $fast_motifs[ int rand @fast_motifs ];

        for my $m (@$motif) {
            my %args = (
                in_out       => $in_out,
                inner_scale  => $inner_scale,
                outer_scale  => $outer_scale,
                octave       => $octave,
                current_note => $current_note,
                direction    => $direction,
                section_num  => $section_num,
                inner        => \@inner,
                outer        => \@outer,
                inner_links  => \%inner_links,
                outer_links  => \%outer_links,
            );

            if (($index == HEAD && $direction == LEFT) || ($index == TAIL && $direction == RIGHT)) {
                ($in_out, $section_num, $index, $formatted, $octave, $section) = step_in_out(%args);
            }
            else {
                my $roll = int rand 2;
                if ($index == MIDDLE && $roll) {
                    ($in_out, $section_num, $index, $formatted, $octave, $section) = step_in_out(%args);
                }
                else {
                    if ($jump) {
                        if ($direction == RIGHT && $index != PENULT) {
                            $direction++ if int rand 2;
                        }
                        elsif ($direction == LEFT && $index != FIRST) {
                            $direction-- if int rand 2;
                        }
                    }
                    my $next_note = $in_out
                        ? $inner_scale->get_offset(note_name => $current_note . $octave, offset => $direction)
                        : $outer_scale->get_offset(note_name => $current_note . $octave, offset => $direction);

                    (my $sans_octave, $octave, $formatted) = normalize_octave($next_note);

                    $index = first_index { $_ eq $sans_octave } @$section;
                }
            }

            # add the motif note to the score
            $d->note($m, $formatted);

            warn "\tNew note: (@$section)[$index] = $formatted, $m\n";

            # iterate the parameters
            $current_note = $section->[$index];
            $direction    = int rand 2 ? RIGHT : LEFT;
        }
    }
}

sub normalize_octave {
    my ($next_note) = @_;

    my $formatted = $next_note->format(FORMAT);

    my $octave;
    my $sans_octave;

    if ($formatted =~ /^([A-G][fs]?)(\d+)$/) {
        $sans_octave = $1;
        $octave = $2;

        $octave-- if $octave > HIGH;
        $octave++ if $octave < LOW;

        $formatted = $sans_octave . $octave;
    }

    return $sans_octave, $octave, $formatted;
}

sub step_in_out {
    my (%args) = @_;

    my $next_note = $args{in_out}
        ? $args{inner_scale}->step(note_name => $args{current_note} . $args{octave}, steps => $args{direction})
        : $args{outer_scale}->step(note_name => $args{current_note} . $args{octave}, steps => $args{direction});

    my ($sans_octave, $octave, $formatted) = normalize_octave($next_note);

    my ($section_num, $section);

    my $in_out = $args{in_out} ? 0 : 1; # jump rings
    if ($in_out) {
        ($section_num, $section) = get_section(
            links        => $args{outer_links},
            section_num  => $args{section_num},
            current_note => $args{current_note},
            direction    => $args{direction},
            sections     => $args{inner},
        );
    }
    else {
        ($section_num, $section) = get_section(
            links        => $args{inner_links},
            section_num  => $args{section_num},
            current_note => $args{current_note},
            direction    => $args{direction},
            sections     => $args{outer},
        );
    }

    my $index = first_index { $_ eq $sans_octave } @$section;

    return $in_out, $section_num, $index, $formatted, $octave, $section;
}

sub get_section {
    my (%args) = @_;

    my $section_num  = $args{section_num};
    my $current_note = $args{current_note};

    # Do we have 1 or 2 linkages? If 2, & going right, use it
    my $i = exists $args{links}->{$section_num}{$current_note}
        && @{ $args{links}->{$section_num}{$current_note} } == 2
        && $args{direction} == RIGHT ? 1 : 0;

    $section_num = $args{links}->{$section_num}{$current_note}[$i];

    my $section = $args{sections}->[$section_num];

    return $section_num, $section;
}