File Coverage

blib/lib/Music/ModalFunction.pm

Criterion	Covered	Total	%
statement	69	69	100.0
branch	29	48	60.4
condition			n/a
subroutine	15	15	100.0
pod	3	3	100.0
total	116	135	85.9

package Music::ModalFunction;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Inspect musical modal functions

our $VERSION = '0.0315';

use Moo;
use strictures 2;
use AI::Prolog ();
use Carp qw(croak);
use MIDI::Util qw(midi_format);
use Music::Note ();
use Music::Scales qw(get_scale_notes);
use namespace::clean;


has [qw(chord_note chord mode_note mode mode_function mode_roman key_note key key_function key_roman)] => (
    is => 'ro',
);

has verbose => (
    is      => 'ro',
    isa     => sub { croak "$_[0] is not a boolean" unless $_[0] =~ /^[01]$/ },
    default => sub { 0 },
);

has _modes => (
    is => 'lazy',
);
sub _build__modes {
    return {
        ionian => [
            { chord => 'maj', roman => 'r_I',   function => 'tonic' },
            { chord => 'min', roman => 'r_ii',  function => 'supertonic' },
            { chord => 'min', roman => 'r_iii', function => 'mediant' },
            { chord => 'maj', roman => 'r_IV',  function => 'subdominant' },
            { chord => 'maj', roman => 'r_V',   function => 'dominant' },
            { chord => 'min', roman => 'r_vi',  function => 'submediant' },
            { chord => 'dim', roman => 'r_vii', function => 'leading_tone' }
        ],
        dorian => [
            { chord => 'min', roman => 'r_i',   function => 'tonic' },
            { chord => 'min', roman => 'r_ii',  function => 'supertonic' },
            { chord => 'maj', roman => 'r_III', function => 'mediant' },
            { chord => 'maj', roman => 'r_IV',  function => 'subdominant' },
            { chord => 'min', roman => 'r_v',   function => 'dominant' },
            { chord => 'dim', roman => 'r_vi',  function => 'submediant' },
            { chord => 'maj', roman => 'r_VII', function => 'subtonic' }
        ],
        phrygian => [
            { chord => 'min', roman => 'r_i',   function => 'tonic' },
            { chord => 'maj', roman => 'r_II',  function => 'supertonic' },
            { chord => 'maj', roman => 'r_III', function => 'mediant' },
            { chord => 'min', roman => 'r_iv',  function => 'subdominant' },
            { chord => 'dim', roman => 'r_v',   function => 'dominant' },
            { chord => 'maj', roman => 'r_VI',  function => 'submediant' },
            { chord => 'min', roman => 'r_vii', function => 'subtonic' }
        ],
        lydian => [
            { chord => 'maj', roman => 'r_I',   function => 'tonic' },
            { chord => 'maj', roman => 'r_II',  function => 'supertonic' },
            { chord => 'min', roman => 'r_iii', function => 'mediant' },
            { chord => 'dim', roman => 'r_iv',  function => 'subdominant' },
            { chord => 'maj', roman => 'r_V',   function => 'dominant' },
            { chord => 'min', roman => 'r_vi',  function => 'submediant' },
            { chord => 'min', roman => 'r_vii', function => 'leading_tone' }
        ],
        mixolydian => [
            { chord => 'maj', roman => 'r_I',   function => 'tonic' },
            { chord => 'min', roman => 'r_ii',  function => 'supertonic' },
            { chord => 'dim', roman => 'r_iii', function => 'mediant' },
            { chord => 'maj', roman => 'r_IV',  function => 'subdominant' },
            { chord => 'min', roman => 'r_v',   function => 'dominant' },
            { chord => 'min', roman => 'r_vi',  function => 'submediant' },
            { chord => 'maj', roman => 'r_VII', function => 'subtonic' }
        ],
        aeolian => [
            { chord => 'min', roman => 'r_i',   function => 'tonic' },
            { chord => 'dim', roman => 'r_ii',  function => 'supertonic' },
            { chord => 'maj', roman => 'r_III', function => 'mediant' },
            { chord => 'min', roman => 'r_iv',  function => 'subdominant' },
            { chord => 'min', roman => 'r_v',   function => 'dominant' },
            { chord => 'maj', roman => 'r_VI',  function => 'submediant' },
            { chord => 'maj', roman => 'r_VII', function => 'subtonic' }
        ],
        locrian => [
            { chord => 'dim', roman => 'r_i',   function => 'tonic' },
            { chord => 'maj', roman => 'r_II',  function => 'supertonic' },
            { chord => 'min', roman => 'r_iii', function => 'mediant' },
            { chord => 'min', roman => 'r_iv',  function => 'subdominant' },
            { chord => 'maj', roman => 'r_V',   function => 'dominant' },
            { chord => 'maj', roman => 'r_VI',  function => 'submediant' },
            { chord => 'min', roman => 'r_vii', function => 'subtonic' }
        ]
    }
}

has _database => (
    is => 'lazy',
);
sub _build__database {
    my ($self) = @_;

    # consider every note
    my @chromatic = get_scale_notes('c', 'chromatic', 0, 'b');
    my $database = '';

    # build a prolog fact for each base note
    for my $base (@chromatic) {
        my ($mode_base) = map { lc } midi_format($base);

        # consider each mode's properties
        for my $mode (sort keys %{ $self->_modes }) {
            # get the 7 notes of the base note mode
            my @notes = get_scale_notes($base, $mode);
            warn "Basics: $base $mode [@notes]\n" if $self->verbose;

            my @pitches; # notes suitable for the prolog database

            # convert the notes to flatted, lower-case
            for my $note (@notes) {
                my $n = Music::Note->new($note, 'isobase');
                $n->en_eq('flat') if $note =~ /#/;
                push @pitches, map { lc } midi_format($n->format('isobase'));
            }

            my $i = 0; # increment for each of 7 diatonic modes

            for my $pitch (@pitches) {
                # get the properties of the given mode
                my $chord    = $self->_modes->{$mode}[$i]{chord};
                my $function = $self->_modes->{$mode}[$i]{function};
                my $roman    = $self->_modes->{$mode}[$i]{roman};

                # append to the database of facts
                $database .= "chord_key($pitch, $chord, $mode_base, $mode, $function, $roman).\n";

                $i++;
            }
        }
    }
    # append the prolog rules
    $database .= <<'RULES';
% Can a chord in one key function in a second?
pivot_chord_keys(ChordNote, Chord, Key1Note, Key1, Key1Function, Key1Roman, Key2Note, Key2, Key2Function, Key2Roman) :-
    % bind the chord to the function of the first key
    chord_key(ChordNote, Chord, Key1Note, Key1, Key1Function, Key1Roman),
    % bind the chord to the function of the second key
    chord_key(ChordNote, Chord, Key2Note, Key2, Key2Function, Key2Roman),
    % the functions cannot be the same
    Key1Function \= Key2Function.

% TODO
roman_key(Mode, ModeRoman, Key, KeyRoman) :-
    chord_key(_, _, _, Mode, ModeFunction, ModeRoman),
    chord_key(_, _, _, Key, KeyFunction, KeyRoman),
    ModeFunction \= KeyFunction.
RULES
    warn "Database: $database\n" if $self->verbose;

    return $database;
}

has _prolog => (
    is => 'lazy',
);
sub _build__prolog {
    my ($self) = @_;
    return AI::Prolog->new($self->_database);
}


sub chord_key {
    my ($self) = @_;
    my $query = sprintf 'chord_key(%s, %s, %s, %s, %s, %s).',
        defined $self->chord_note   ? $self->chord_note   : 'ChordNote',
        defined $self->chord        ? $self->chord        : 'Chord',
        defined $self->key_note     ? $self->key_note     : 'KeyNote',
        defined $self->key          ? $self->key          : 'Key',
        defined $self->key_function ? $self->key_function : 'KeyFunction',
        defined $self->key_roman    ? $self->key_roman    : 'KeyRoman';
    return $self->_querydb($query);
}


sub pivot_chord_keys {
    my ($self) = @_;
    my $query = sprintf 'pivot_chord_keys(%s, %s, %s, %s, %s, %s, %s, %s, %s, %s).',
        defined $self->chord_note    ? $self->chord_note    : 'ChordNote',
        defined $self->chord         ? $self->chord         : 'Chord',
        defined $self->mode_note     ? $self->mode_note     : 'ModeNote',
        defined $self->mode          ? $self->mode          : 'Mode',
        defined $self->mode_function ? $self->mode_function : 'ModeFunction',
        defined $self->mode_roman    ? $self->mode_roman    : 'ModeRoman',
        defined $self->key_note      ? $self->key_note      : 'KeyNote',
        defined $self->key           ? $self->key           : 'Key',
        defined $self->key_function  ? $self->key_function  : 'KeyFunction',
        defined $self->key_roman     ? $self->key_roman     : 'KeyRoman';
    return $self->_querydb($query);
}


sub roman_key {
    my ($self) = @_;
    my $query = sprintf 'roman_key(%s, %s, %s, %s).',
        defined $self->mode       ? $self->mode       : 'Mode',
        defined $self->mode_roman ? $self->mode_roman : 'ModeRoman',
        defined $self->key        ? $self->key        : 'Key',
        defined $self->key_roman  ? $self->key_roman  : 'KeyRoman';
    return $self->_querydb($query);
}

sub _querydb {
    my ($self, $query) = @_;

    warn "Query: $query\n" if $self->verbose;

    $self->_prolog->query($query);

    my @return;

    while (my $result = $self->_prolog->results) {
        push @return, $result;
    }

    return \@return;
}

1;

__END__