#!perl
#
# Generate notes of arbitrary scales (subsets of the Western 12-tone
# chromatic system) from a specified starting note in a specified
# direction and so forth from other options. This file uses "scale" and
# "subset" and "interval series" and "interval vector" interchangeably.
#
# The output is in lilypond absolute format. The default scale is The
# Major Scale, but that's easy to adjust to say C Minor:
#
#   $ scalemogrifier --minor --flats
#
# By default, scales loop back to the starting note. If this is not the
# case, suffix 'nl' to a custom interval series:
#
#   $ scalemogrifier --intervals=c,cis,dis,e,g,nl --length=15
#   c cis dis e g gis ais b d' dis' f' fis' a' ais' c''
#
# The output is based on the assumption that 'c' equals 0. The output
# can be transposed via:
#
#   $ scalemogrifier --mode=mixolydian --transpose=-5
#
# Integer interval numbers can be used instead of note names or the
# --mode option, for example the Major Scale:
#
#   $ scalemogrifier --intervals='2 2 1 2 2 2 1' --raw
#
# Or to form a -P4,+P5 sequence:
#
#   $ scalemogrifier --intervals=-5,7 --len=24
#
# Or just plain made up:
#
#   $ scalemogrifier --intervals=1,2,3,5,7 --dir=53 --relative --len=24
#
# Scales can also be rendered backwards:
#
#   $ scalemogrifier --dir=-1
#
# Or with the interval order reversed:
#
#   $ scalemogrifier --rev
#
# The scale generated can be fed back into a different output scale (the
# direction and reverse options only apply to the --intervals option
# scale, not the --ois scale):
#
#   $ scalemogrifier --intervals=c,cis,dis,e,g,nl --ois=aes,bes,ces,ees,fes \
#      --len=48 --flats --rel
#
# Practical application of the results to music theory or composition
# left as an exercise to the user. The output can be fed to `ly-fu` for
# playback and display, for example:
#
#   $ ly-fu --abs -l --open $(scalemogrifier ...)
#   $ ly-fu       -l --open $(scalemogrifier --relative ...)
#
# Consider http://oeis.org/ to lookup or find interesting interval series;
# for example, search for the major interval sequence for numeric
# sequences that contain it:
#
# http://oeis.org/search?q=2,2,1,2,2,2,1
#
# ZSH completion available at: https://github.com/thrig/zsh-compdef

use strict;
use warnings;

use Getopt::Long qw/GetOptions/;
use List::Util qw/sum/;
use Text::Wrap qw/wrap/;

# XXX but these have no concept of direction, which for some scales
# changes the notes, in particular:
#
# * mminor - melodic minor, should only be used ascending here.
#
# * amdorian - anti-melodic dorian, mixin from locrian, like melodic
#   minor, except for downwards trending notes? Conventional voice
#   leading tricky due to the diminished chords.
my %modes = (
  ionian     => [qw(2 2 1 2 2 2 1)],
  lydian     => [qw(2 2 2 1 2 2 1)],
  mixolydian => [qw(2 2 1 2 2 1 2)],
  dorian     => [qw(2 1 2 2 2 1 2)],
  amdorian   => [qw(2 1 2 1 2 2 2)],
  aeolian    => [qw(2 1 2 2 1 2 2)],
  mminor     => [qw(2 1 2 2 2 2 1)],
  hminor     => [qw(2 1 2 2 1 3 1)],
  hunminor   => [qw(2 1 3 2 1 3 1)],
  phrygian   => [qw(1 2 2 2 1 2 2)],
  locrian    => [qw(1 2 2 1 2 2 2)],
  'p-major'  => [qw(2 2 3 2 3)],
  'p-minor'  => [qw(3 2 2 3 2)],
  'p-sakura' => [qw(1 4 2 1 4)],
);
$modes{'major'} = $modes{'ionian'};
$modes{'minor'} = $modes{'aeolian'};

# Accepted note names to pitch number for user input
my %note2num = qw(c 0 cis 1 d 2 dis 3 e 4 f 5 fis 6 g 7 gis 8 a 9 ais 10 b 11
  ces 11 des 1 ees 3 fes 4 ges 6 aes 8 bes 10 eis 5 bis 0);

# Note names for program output
my %num2note = (
  'ly-sharp' =>
    {qw/0 c 1 cis 2 d 3 dis 4 e 5 f 6 fis 7 g 8 gis 9 a 10 ais 11 b/},
  'ly-flat' =>
    {qw/0 c 1 des 2 d 3 ees 4 e 5 f 6 ges 7 g 8 aes 9 a 10 bes 11 b/},
);
my $num2note_flavor = 'ly-';

# Not The Scale, but to map back to That Other Scale.
my $DEG_IN_SCALE = 12;

my @interval_vector = @{ $modes{'major'} };
my $length          = 8;
my $direction       = 1;
my $in_reverse      = 0;
my $relative        = 0;
my $transpose;

my $output_delimiter = " ";
my ( @output_intervals, $output_sum );

########################################################################
#
# MAIN

GetOptions(
  'direction=i'            => \$direction,
  'flats'                  => \my $use_flats,
  'help|h|?'               => \&print_help,
  'intervals=s'            => \my $intervals,
  'listmodes'              => \my $list_modes,
  'minor'                  => \my $use_minor,
  'mode=s'                 => \my $mode,
  'ors=s'                  => \$output_delimiter,
  'output_intervals|ois=s' => \my $output_intervals,
  'relative'               => \$relative,
  'length=i'               => \$length,
  'raw'                    => \my $raw_output,
  'reverse'                => \$in_reverse,
  'transpose|t=s'          => \$transpose,
) || die "error: could not parse options\n";

print_help() if @ARGV;

if ($list_modes) {
  print "$_\n" for sort keys %modes;
  exit 0;
}

$direction = int($direction);
die "error: a direction of zero is a bit too aimless\n" if $direction == 0;
$length = int($length);
die "error: length must be at least one\n" if $length < 1;

if ( defined $transpose ) {
  if ( exists $note2num{$transpose} ) {
    $transpose = $note2num{$transpose};
  } elsif ( $transpose =~ m/^(-?\d+)$/ ) {
    $transpose = $1;
    $transpose %= $DEG_IN_SCALE;
  } else {
    die "error: do not know how to transpose by $transpose\n";
  }
} else {
  $transpose = 0;
}

$mode = 'minor' if $use_minor;
if ( defined $mode ) {
  die "error: no such mode '$mode'" unless exists $modes{$mode};
  @interval_vector = @{ $modes{$mode} };
} elsif ( defined $intervals ) {
  @interval_vector =
    names2intervalseries( map lc, split /[\s,]+/, $intervals );
}

if ( defined $output_intervals ) {
  my @output_args = map lc, split /[\s,]+/, $output_intervals;
  @output_intervals = names2intervalseries(@output_args);
  $output_sum       = sum @output_intervals;
}
$output_delimiter =~ s/(\\.)/qq!"$1"!/eeg;

$num2note_flavor .= $use_flats ? 'flat' : 'sharp';

@interval_vector = reverse @interval_vector if $in_reverse;

my $pitch      = 0;
my $prev_pitch = $pitch;

for my $i ( 0 .. $length - 1 ) {
  if ( !$raw_output ) {
    my $output_pitch = $pitch;

    if (@output_intervals) {
      my $pitch_reg = int( $output_pitch / @output_intervals );    # XXX buggy
      my $pitch_mod = $output_pitch % @output_intervals - 1;

      $output_pitch = $pitch_reg * $output_sum +
        ( $pitch_mod >= 0 ? sum( @output_intervals[ 0 .. $pitch_mod ] ) : 0 );
    }

    my $ly_reg = "";
    if ( !$relative and $i > 0 ) {
      if ( $output_pitch < 0 ) {
        $ly_reg = q{,} x
          ( ( abs($output_pitch) + $DEG_IN_SCALE - 1 ) / $DEG_IN_SCALE );
      } elsif ( $output_pitch >= $DEG_IN_SCALE ) {
        $ly_reg = q{'} x ( $output_pitch / $DEG_IN_SCALE );
      }
    }

    print $num2note{$num2note_flavor}
      ->{ ( $output_pitch + $transpose ) % $DEG_IN_SCALE }, $ly_reg;
  } else {
    print $pitch + $transpose;
  }
  print $output_delimiter if $i < $length - 1;

  $prev_pitch = $pitch;
  $pitch += $interval_vector[ $i % @interval_vector ] * $direction;
}
print "\n";

exit 0;

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

# Convert between intput of 'c cis dis e g' to an interval series, so
# user can input arbitrary scales using note names. Mixing note names
# with interval numbers is not supported in this implementation.
sub names2intervalseries {
  my @input = @_;
  my @iseries;
  my $is_conversion      = 0;
  my $is_complete_octave = 1;

  if ( $input[-1] eq 'nl' ) {
    $is_complete_octave = 0;
    pop @input;
  }
  my @indexes = 0 .. $#input;
  push @indexes, 0 if $is_complete_octave;

  my $prev_pitch;
  for my $i (@indexes) {
    if ( $input[$i] !~ m/^-?\d+$/ ) {
      if ( !exists $note2num{ $input[$i] } ) {
        warn "error: unknown note: '$input[$i]'\n";
        print_help();
      }
      $is_conversion = 1;
      if ( defined $prev_pitch ) {
        my $delta = $note2num{ $input[$i] } - $prev_pitch;
        if ( abs($delta) > $DEG_IN_SCALE / 2 ) {
          $delta = ( $DEG_IN_SCALE - abs($delta) ) * ( $delta > 0 ? -1 : 1 );
        }
        push @iseries, $delta;
      }
      $prev_pitch = $note2num{ $input[$i] };
    }
  }

  @iseries = @input unless $is_conversion;
  return @iseries;
}

sub print_help {
  my @startnotes = sort { $note2num{$a} <=> $note2num{$b} } keys %note2num;
  $Text::Wrap::columns = 78;
  my $sc = wrap( '  ', '  ', @startnotes, '  nl' );
  my $modes = wrap( '  ', '  ', sort keys %modes );

  warn <<"END_HELP";
Usage: $0 [options]
  --listmodes       Shows list of available modes.

Options affecting input:
  --direction       Positive, scale goes up, negative, down. Magnitudes
                    greater than one multiply the interval.
  --intervals       List of intervals or notes of the scale.
  --length          How many notes to generate in output.
  --mode            Specify named interval series instead of --intervals.
  --minor           Use minor mode instead of --intervals (default: major).
  --reverse         Reverses order of intervals.

Options affecting output:
  --flats           Use flats in output, instead of default sharps.
  --ois             Custom scale or interval set output will be mapped into.
  --ors             What will be printed between output elements.
                    Defaults to the space character.
  --raw             Emit pitch numbers instead of note names.
  --relative        Generate relative lilypond output (default: absolute).
  --transpose       Number to transpose the output by.

Possible note names for the --intervals or --ois options (or instead
specify just interval numbers):

$sc

Available modes for --modes option:

$modes
END_HELP
  exit 64;
}

END {
  # Report problems when writing to stdout (perldoc perlopentut)
  unless ( close(STDOUT) ) {
    warn "error: problem closing STDOUT: $!\n";
    exit 74;
  }
}
