#!/usr/bin/env perl
#
# Modal canon brute forcer.

use strict;
use warnings;

use List::Util qw/min/;
use Music::Canon        ();
use Music::LilyPondUtil ();
use Try::Tiny;

# Notes to iterate over (0..23 or similar might make output easier to grep for
# particular patterns, as that way both the input and output will cover
# particular pitch patterns in the output).
my @input = 0 .. 11;

# What modes to generate notes for (via Music::Scales, could also try Forte
# Numbers or supply list of array refs, see Music::Canon docs on
# set_modal_scale_* for details).
#
# Yet another option would be to vary the ascending vs. descending modes used,
# in addition to the varying input and output modes, though that would require
# ascending and descending input material to fully explore, and would generate
# stupidly larger amounts of output. A better option might be to devise a
# specific question to be answered, for example: "what are the possibilities
# when using bVII in a descending line for various corresponding output
# ascending modes when composing a contrary motion retrograde canon?" And then
# write code to explore that specific space. Which was exactly the question
# that prompted this entire module.
my @modes = qw/ionian dorian phrygian lydian mixolydian aeolian locrian hm mm/;

# Probably nothing to fiddle with below here, except perhaps whether to
# retrograde or contrary, and what to transpose by, depending on the need (e.g.
# for a contrary motion retrograde canon, probably want to iterate those just
# being on).

my $canon = Music::Canon->new;
my $lyu   = Music::LilyPondUtil->new(
  ignore_register => 1,
  min_pitch       => -50,
  mode            => 'relative'
);

my @in_notes = $lyu->p2ly(@input);
my $pformat  = join ' ', ('%4s') x @input;
my $nformat  = join ' ', ('%4s') x @input;

my $in_pitch = sprintf $pformat, @input;
my $in_notes = sprintf $nformat, @in_notes;

for my $in_mode (@modes) {
  $canon->set_modal_scale_in($in_mode);
  for my $out_mode (@modes) {
    $canon->set_modal_scale_out($out_mode);
    for my $t ( 0 .. 11 ) {
      $canon->set_transpose($t);
      for my $c ( 0 .. 1 ) {
        $canon->set_contrary($c);
        for my $r ( 0 .. 1 ) {
          $canon->set_retrograde($r);

          my $set = gen_settings_str( $in_mode, $out_mode, $t, $c, $r );
          my @output;
          my $meh;
          try {
            @output = $canon->modal_map( \@input );
          }
          catch { $meh = 1 };
          next if $meh;

          if ( min( grep defined, @output ) < -10 ) {
            for my $p (@output) {
              $p += 12 if defined $p;
            }
          }
          if ( min( grep defined, @output ) > 10 ) {
            for my $p (@output) {
              $p -= 12 if defined $p;
            }
          }
          @output = map { defined() ? $_ : 'x' } @output;
          my @out_notes = $lyu->p2ly(@output);

          my $out_pitch = sprintf $pformat, @output;
          my $out_notes = sprintf $nformat, @out_notes;

          print "$set\n";
          print "in\t$in_pitch\n";
          print "out\t$out_pitch\n";
          print "in\t$in_notes\n";
          print "out\t$out_notes\n\n";
        }
      }
    }
  }
}

exit 0;

##############################################################################
#
# SUBROUTINES

sub gen_settings_str {
  my ( $in, $out, $t, $c, $r ) = @_;
  return "in=$in out=$out t=$t c=$c r=$r";
}