our $AUTHORITY = 'cpan:GENE';
our $VERSION = '0.0609';
has max => (
is => 'ro',
isa => sub { croak "$_[0] is not a valid integer" unless $_[0] =~ /^\d+$/ },
default => sub { 8 },
);
has net => (
is => 'ro',
isa => sub { croak "$_[0] is not a hashref" unless ref $_[0] eq 'HASH' },
default => sub {
{ 1 => [qw( 1 2 3 4 5 6 )],
2 => [qw( 3 4 5 )],
3 => [qw( 1 2 4 6 )],
4 => [qw( 1 3 5 6 )],
5 => [qw( 1 4 6 )],
6 => [qw( 1 2 4 5 )],
7 => [] }
},
);
has chord_map => (
is => 'lazy',
);
sub _build_chord_map {
my ($self) = @_;
my %scale = (
chromatic => [ ('m') x 12 ],
major => [ '', 'm', 'm', '', '', 'm', 'dim' ],
ionian => [ '', 'm', 'm', '', '', 'm', 'dim' ],
dorian => [ 'm', 'm', '', '', 'm', 'dim', '' ],
phrygian => [ 'm', '', '', 'm', 'dim', '', 'm' ],
lydian => [ '', '', 'm', 'dim', '', 'm', 'm' ],
mixolydian => [ '', 'm', 'dim', '', 'm', 'm', '' ],
minor => [ 'm', 'dim', '', 'm', 'm', '', '' ],
aeolian => [ 'm', 'dim', '', 'm', 'm', '', '' ],
locrian => [ 'dim', '', 'm', 'm', '', '', 'm' ],
);
return $scale{ $self->scale_name };
}
has scale_name => (
is => 'ro',
isa => sub { croak "$_[0] is not a valid string" if ref $_[0] },
default => sub { 'major' },
);
has scale_note => (
is => 'ro',
isa => sub { croak "$_[0] is not a valid note" unless $_[0] =~ /^[A-G][
default => sub { 'C' },
);
has scale => (
is => 'lazy',
init_args => undef,
);
sub _build_scale {
my ($self) = @_;
my @scale = get_scale_notes($self->scale_note, $self->scale_name);
my %equiv = (
'C#' => 'Db',
'D#' => 'Eb',
'E#' => 'F',
'F#' => 'Gb',
'G#' => 'Ab',
'A#' => 'Bb',
'B#' => 'C',
'Cb' => 'B',
'Dbb' => 'C',
'Ebb' => 'D',
'Fb' => 'E',
'Gbb' => 'F',
'Abb' => 'G',
'Bbb' => 'A',
);
for (@scale) {
$_ = $equiv{$_} if exists $equiv{$_};
}
print ucfirst($self->scale_name), ' scale: ', ddc(\@scale) if $self->verbose;
return \@scale;
}
has octave => (
is => 'ro',
isa => sub { croak "$_[0] is not a valid octave" unless $_[0] =~ /^-?\d+$/ },
default => sub { 4 },
);
has tonic => (
is => 'ro',
isa => sub { croak "$_[0] is not a valid setting" unless $_[0] =~ /^-?[01]$/ },
default => sub { 1 },
);
has resolve => (
is => 'ro',
isa => sub { croak "$_[0] is not a valid setting" unless $_[0] =~ /^-?[01]$/ },
default => sub { 1 },
);
has substitute => (
is => 'ro',
isa => sub { croak "$_[0] is not a valid boolean" unless $_[0] =~ /^[01]$/ },
default => sub { 0 },
);
has sub_cond => (
is => 'ro',
isa => sub { croak "$_[0] is not a valid coderef" unless ref($_[0]) eq 'CODE' },
default => sub { return sub { int rand 4 == 0 } },
);
has flat => (
is => 'ro',
isa => sub { croak "$_[0] is not a valid boolean" unless $_[0] =~ /^[01]$/ },
default => sub { 0 },
);
has graph => (
is => 'lazy',
init_args => undef,
);
sub _build_graph {
my ($self) = @_;
my $g = Graph::Directed->new;
for my $posn (keys %{ $self->net }) {
for my $p (@{ $self->net->{$posn} }) {
$g->add_edge($posn, $p);
}
}
return $g;
}
has phrase => (
is => 'rw',
init_args => undef,
);
has chords => (
is => 'rw',
init_args => undef,
);
has verbose => (
is => 'ro',
isa => sub { croak "$_[0] is not a valid boolean" unless $_[0] =~ /^[01]$/ },
default => sub { 0 },
);
sub generate {
my ($self) = @_;
croak 'chord_map length must equal number of net keys'
unless @{ $self->chord_map } == keys %{ $self->net };
print 'Graph: ' . $self->graph, "\n" if $self->verbose;
my @progression;
my $v;
for my $n (1 .. $self->max) {
$v = $self->_next_successor($n, $v);
push @progression, $v;
}
print 'Progression: ', ddc(\@progression) if $self->verbose;
my @chord_map = @{ $self->chord_map };
if ($self->substitute) {
my $i = 0;
for my $chord (@chord_map) {
my $substitute = $self->sub_cond->() ? $self->substitution($chord) : $chord;
if ($substitute eq $chord && $i < @progression && $self->sub_cond->()) {
$progression[$i] .= 't';
}
$chord = $substitute;
$i++;
}
}
print 'Chord map: ', ddc(\@chord_map) if $self->verbose;
my @phrase = map { $self->_tt_sub(\@chord_map, $_) } @progression;
$self->phrase(\@phrase);
print 'Phrase: ', ddc($self->phrase) if $self->verbose;
my $mcn = Music::Chord::Note->new;
my @chords;
for my $chord (@phrase) {
my @chord = $mcn->chord_with_octave($chord, $self->octave);
push @chords, \@chord;
}
if ($self->flat) {
my %equiv = (
'C#' => 'Db',
'D#' => 'Eb',
'E#' => 'F',
'F#' => 'Gb',
'G#' => 'Ab',
'A#' => 'Bb',
'B#' => 'C',
);
for my $chord (@chords) {
for my $note (@$chord) {
$note =~ s/^([A-G]
}
}
}
$self->chords(\@chords);
print 'Chords: ', ddc($self->chords) if $self->verbose;
return \@chords;
}
sub _next_successor {
my ($self, $n, $v) = @_;
$v //= 1;
my $s;
if ($n == 1) {
if ($self->tonic == 0) {
$s = $self->graph->random_successor(1);
}
elsif ($self->tonic == 1) {
$s = 1;
}
else {
$s = $self->_full_keys;
}
}
elsif ($n == $self->max) {
if ($self->resolve == 0) {
$s = $self->graph->random_successor($v) || $self->_full_keys;
}
elsif ($self->resolve == 1) {
$s = 1;
}
else {
$s = $self->_full_keys;
}
}
else {
$s = $self->graph->random_successor($v);
}
return $s;
}
sub _full_keys {
my ($self) = @_;
my @keys = grep { keys @{ $self->net->{$_} } > 0 } keys %{ $self->net };
return $keys[int rand @keys];
}
sub _tt_sub {
my ($self, $chord_map, $n) = @_;
my $note;
if ($n =~ /t/) {
my @fnotes = get_scale_notes('C', 'chromatic', 0, 'b');
my @snotes = get_scale_notes('C', 'chromatic');
my %ftritone = map { $fnotes[$_] => $fnotes[($_ + 6) % @fnotes] } 0 .. $#fnotes;
my %stritone = map { $snotes[$_] => $snotes[($_ + 6) % @snotes] } 0 .. $#snotes;
$n =~ s/t//;
$note = $ftritone{ $self->scale->[$n - 1] } || $stritone{ $self->scale->[$n - 1] };
print 'Tritone: ', $self->scale->[$n - 1], " => $note\n" if $self->verbose;
}
else {
$note = $self->scale->[$n - 1];
}
$note .= $chord_map->[$n - 1];
print "Note: $note\n" if $self->verbose;
return $note;
}
sub substitution {
my ($self, $chord) = @_;
my $substitute = $chord;
if ($chord eq '' || $chord eq 'm') {
my $roll = int rand 2;
$substitute = $roll == 0 ? $chord . 'M7' : $chord . 7;
}
elsif ($chord eq 'dim' || $chord eq 'aug') {
$substitute = $chord . 7;
}
elsif ($chord eq '-5' || $chord eq '-9') {
$substitute = "7($chord)";
}
elsif ($chord eq 'M7') {
my $roll = int rand 3;
$substitute = $roll == 0 ? 'M9' : $roll == 1 ? 'M11' : 'M13';
}
elsif ($chord eq '7') {
my $roll = int rand 3;
$substitute = $roll == 0 ? '9' : $roll == 1 ? '11' : '13';
}
elsif ($chord eq 'm7') {
my $roll = int rand 3;
$substitute = $roll == 0 ? 'm9' : $roll == 1 ? 'm11' : 'm13';
}
print qq|Substitute: "$chord" => "$substitute"\n| if $self->verbose && $substitute ne $chord;
return $substitute;
}
1;