#!perl

# Command line interface to the atonal routines in the Music::AtonalUtil
# module. Run perldoc(1) on this script for additional documentation.
#
# ZSH completion script available in the zsh-compdef directory of the
# App::MusicTools distribution.

# XXX improve emit_pitch_set (returns a string, so caller can then do
# what it will -- or have LilyPondUtil sub that knows how to format a
# pitch set? (among other possible code cleanups/simplifications)

use strict;
use warnings;

use Getopt::Long qw/GetOptionsFromArray/;
use List::MoreUtils qw/all any/;
use Music::AtonalUtil    ();
use Music::LilyPondUtil  ();
use Music::Tension::Cope ();
# untested with --tension
#use Music::Tension::PlompLevelt ();
use Parse::Range qw/parse_range/;
use Scalar::Util qw/looks_like_number/;

my %modes = (
  basic            => \&basic,
  circular_permute => \&circular_permute,
  combos           => \&combos,
  complement       => \&complement,
  # TODO
  #dur2notes              => \&dur2notes,
  equivs                 => \&equivs,
  findall                => \&findall,
  findin                 => \&findin,
  fnums                  => \&fnums,
  forte2pcs              => \&forte2pcs,
  freq2pitch             => \&freq2pitch,
  interval_class_content => \&interval_class_content,
  invariance_matrix      => \&invariance_matrix,
  invariants             => \&invariants,
  invert                 => \&invert,
  ly2pitch               => \&ly2pitch,
  multiply               => \&multiply,
  normal_form            => \&normal_form,
  # TODO
  #notes2dur              => \&notes2time,
  pcs2forte           => \&pcs2forte,
  pitch2freq          => \&pitch2freq,
  pitch2intervalclass => \&pitch2intervalclass,
  pitch2ly            => \&pitch2ly,
  prime_form          => \&prime_form,
  recipe              => \&recipe,
  retrograde          => \&retrograde,
  rotate              => \&rotate,
  set_complex         => \&set_complex,
  subsets             => \&subsets,
  tcis                => \&tcis,
  tcs                 => \&tcs,
  tension             => \&tension,
  transpose           => \&transpose,
  transpose_invert    => \&transpose_invert,
  variances           => \&variances,
  zrelation           => \&zrelation,
);

my ( $Flag_Flat, $Flag_Lyout, $Flag_Quiet, $Flag_Tension );
my @Std_Opts = (
  'flats!'    => \$Flag_Flat,
  'ly'        => \$Flag_Lyout,
  'quiet!'    => \$Flag_Quiet,
  'tension=s' => \$Flag_Tension,
);

my @leading_args;
while ( @ARGV and !exists $modes{ $ARGV[0] } ) {
  push @leading_args, shift @ARGV;
}

GetOptionsFromArray(
  \@leading_args,
  @Std_Opts,
  'help'           => \&print_help,
  'listmodes'      => sub { print "$_\n" for sort keys %modes; exit 0 },
  'scaledegrees=s' => \my $scale_degrees,
) or print_help();
$scale_degrees //= Music::AtonalUtil->new->scale_degrees();
my $mode = shift;

print_help() if !defined $mode or !exists $modes{$mode};

my $Atu = Music::AtonalUtil->new( DEG_IN_SCALE => $scale_degrees );
my $Lyu = Music::LilyPondUtil->new(
  chrome => ( $Flag_Flat ? 'flats' : 'sharps' ),
  ignore_register => 1,
  keep_state      => 0,
  mode            => 'relative'
);
my $Tension;

$modes{$mode}->(@ARGV);
exit 0;

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

sub _init_tension {
  my ($override) = @_;
  $Flag_Tension = $override if defined $override;

  if ( defined $Flag_Tension ) {
    if ( $Flag_Tension eq 'cope' ) {
      $Tension = Music::Tension::Cope->new;
      # untested with --tension
      #   } elsif ( $Flag_Tension eq 'pl' ) {
      #     $Tension = Music::Tension::PlompLevelt->new;
    } else {
      die "unknown tension method '$Flag_Tension'\n";
    }
  }
}

sub args2pitchset {
  my (@args) = @_;

  if ( !@args or ( @args == 1 and $args[0] eq '-' ) ) {
    chomp( @args = readline STDIN );
  }

  my $pitch_set;
  if ( $args[0] =~ m/^\d-/ ) {
    $pitch_set = $Atu->forte2pcs( $args[0] );
    die "unknown Forte Number '$args[0]'\n" if !defined $pitch_set;
  } else {
    for my $arg (@args) {
      for my $p ( $arg =~ /([\d\w]+)/g ) {
        push @$pitch_set, $Lyu->notes2pitches($p);
      }
    }
  }

  return $pitch_set;
}

sub basic {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;

  my $pset = args2pitchset(@args);

  emit_pitch_set( $Atu->prime_form($pset), rs => ',' );
  emit_pitch_set(
    scalar $Atu->interval_class_content($pset),
    lyflag => 0,
    rs     => '',
  );

  my $forte = $Atu->pcs2forte($pset) // '';
  print $forte, "\n";

  if ($Flag_Tension) {
    _init_tension();
    printf "%.03f  %.03f  %.03f\n", $Tension->vertical($pset);
  }
}

sub circular_permute {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  emit_pitch_set( $Atu->circular_permute( args2pitchset(@args) ) );
}

sub combos {
  my (@args) = @_;
  my $mode = 'absolute';
  GetOptionsFromArray(
    \@args, @Std_Opts,
    'pitches'    => \my $Flag_Pitches,
    'relative=s' => \my $relative
  ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;

  $Lyu->ignore_register(0);
  $Lyu->keep_state(1);
  $Lyu->sticky_state(1);
  if ($relative) {
    $Lyu->mode('relative');
    $Lyu->prev_note($relative);
  } else {
    $Lyu->mode('absolute');
  }

  # for the parent class pitch/frequency conversion methods
  _init_tension('cope');

  my @freqs;
  if ( @args == 1 and $args[0] eq '-' ) {
    while ( my $line = readline STDIN ) {
      push @freqs, split ' ', $line;
    }
  } else {
    for my $arg (@args) {
      push @freqs, split ' ', $arg;
    }
  }

  if ( @freqs < 2 ) {
    die "Usage: $0 combos [--pitches [--relative=note]] f1 f2 [f3...]\n";
  }

  # turn on pitch mode if first note look more a note than a number
  if ( $Flag_Pitches or $freqs[0] =~ m/[a-g]/ ) {
    @freqs = map $Tension->pitch2freq($_), $Lyu->notes2pitches(@freqs);
  }

  for my $i ( 1 .. $#freqs ) {
    my $plus  = $freqs[0] + $freqs[1];
    my $minus = $freqs[$i] - $freqs[0];

    # (try to) Figure out MIDI pitch of combination tone, and what the
    # error is due to presumed equal temperament tuning of said MIDI
    # pitches.
    my $plus_pitch  = 0;
    my $minus_pitch = 0;
    my $plus_delta  = 0;
    my $minus_delta = 0;
    my $errstr      = '';
    eval {
      $plus_pitch  = $Tension->freq2pitch($plus);
      $minus_pitch = $Tension->freq2pitch($minus);
      $plus_delta  = $Tension->pitch2freq($plus_pitch) - $plus;
      $minus_delta = $Tension->pitch2freq($minus_pitch) - $minus;
    };
    if ($@) {
      $errstr = "\t/!\\ pitch out of bounds";
    }

    # best effort to get a note name, revert to pitch numbers if out of range
    if ( $Flag_Lyout and length $errstr == 0 ) {
      eval {
        $plus_pitch  = $Lyu->p2ly($plus_pitch);
        $minus_pitch = $Lyu->p2ly($minus_pitch);
      };
      if ($@) {
        $errstr = "\t/!\\ ly note out of bounds";
      }
    }

    printf "%.2f+%.2f = %.2f\t(%s error %.2f)%s\n", $freqs[0], $freqs[$i],
      $plus,
      $plus_pitch, $plus_delta, $errstr;
    printf "%.2f-%.2f = %.2f\t(%s error %.2f)%s\n", $freqs[$i], $freqs[0],
      $minus,
      $minus_pitch, $minus_delta, $errstr;
  }
}

sub complement {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  emit_pitch_set( $Atu->complement( args2pitchset(@args) ) );
}

sub dur2notes {
  # TODO
}

sub emit_pitch_set {
  my ( $pset, %params ) = @_;

  my $lyify = exists $params{lyflag} ? $params{lyflag} : $Flag_Lyout;
  my $rs    = exists $params{rs}     ? $params{rs}     : ' ';

  my $has_nl = 0;
  my $str    = '';
  for my $i (@$pset) {
    if ( ref $i eq 'ARRAY' ) {
      $has_nl = emit_pitch_set( $i, %params );
    } else {
      $str .= ( $lyify ? $Lyu->p2ly($i) : $i ) . $rs;
    }
  }
  $str =~ s/$rs\z//;
  $str .= "\n" unless $has_nl;
  print $str;
  return 1;
}

sub equivs {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;

  my ( @transpose, @transpose_invert, %seen );
  my $pset = args2pitchset(@args);

  for my $i ( 0 .. $Atu->scale_degrees - 1 ) {
    my $set = $Atu->normal_form( $Atu->transpose( $pset, $i ) );
    if ( !$seen{"@$set"}++ ) {
      push @transpose, $set;
      my $iset = $Atu->normal_form( $Atu->transpose_invert( $pset, $i ) );
      push @transpose_invert, $iset if !$seen{"@$iset"}++;
    }
  }

  emit_pitch_set( \@transpose )        if @transpose;
  emit_pitch_set( \@transpose_invert ) if @transpose_invert;
}

sub findall {
  my (@args) = @_;
  GetOptionsFromArray(
    \@args, @Std_Opts,
    'exclude=s' => \my $excludes,
    'fn=s'      => \my $desired_forte_nums,
    'root=s'    => \my $root_pitch
  );
  $Lyu->chrome('flats') if $Flag_Flat;

  my $desired = args2pitchset(@args);
  my %excludes;
  @excludes{ $Lyu->notes2pitches( split /[, ]+/, $excludes ) } = ()
    if defined $excludes;
  $root_pitch = $Lyu->notes2pitches($root_pitch) if defined $root_pitch;
  my $fn_re = '^[' . join( '', parse_range($desired_forte_nums) ) . ']$';

  my $fnums = $Atu->fnums;
  for my $fnum ( sort keys %$fnums ) {
    if ( defined $desired_forte_nums ) {
      ( my $prefix = $fnum ) =~ s/[-].+//;
      next if $prefix !~ m/$fn_re/;
    }
    _findps( $fnums->{$fnum}, $desired, $root_pitch, \%excludes, $fnum );
  }
}

sub findin {
  my (@args) = @_;
  GetOptionsFromArray(
    \@args, @Std_Opts,
    'exclude=s'    => \my $excludes,
    'pitchset|P=s' => \my $base_input,
    'root=s'       => \my $root_pitch
  ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;

  my $ps_base;
  if ( $base_input =~ m/^\d-/ ) {
    $ps_base = $Atu->forte2pcs($base_input);
    die "unknown Forte Number '$base_input'\n" if !defined $ps_base;
  } else {
    $ps_base = args2pitchset( split /[ ,]/, $base_input );
  }
  my $desired = args2pitchset(@args);
  my %excludes;
  @excludes{ $Lyu->notes2pitches( split /[, ]+/, $excludes ) } = ()
    if defined $excludes;
  $root_pitch = $Lyu->notes2pitches($root_pitch) if defined $root_pitch;

  if ( @$desired > @$ps_base ) {
    die "cannot desire more than is present\n";
  }

  _findps( $ps_base, $desired, $root_pitch, \%excludes );
}

sub _findps {
  my ( $ps_base, $desired, $root_pitch, $excludes, $fnum ) = @_;
  $fnum //= '-';
  $excludes //= {};

  _init_tension() if $Flag_Tension;

  my $ps_width = 24 - ( $Flag_Lyout ? 0 : 6 );

TRANS: for my $i ( 0 .. $Atu->scale_degrees - 1 ) {
    my %tps;
    @tps{ @{ $Atu->transpose( $ps_base, $i ) } } = ();
    if ( all { exists $tps{$_} } @$desired ) {
      my @pitches = @{ $Atu->transpose( $ps_base, $i ) };
      next if defined $root_pitch and $pitches[0] != $root_pitch;
      if (%$excludes) {
        for my $p (@pitches) {
          next TRANS if exists $excludes->{$p};
        }
      }

      my $tstr = '';
      if ($Flag_Tension) {
        $tstr = sprintf "\t%.03f  %.03f  %.03f",
          $Tension->vertical( \@pitches );
      }

      @pitches = $Lyu->p2ly(@pitches) if $Flag_Lyout;

      printf "%s\tT(%d)\t%-${ps_width}s%s\n", $fnum, $i,
        join( ',', @pitches ), $tstr;
    }
  }

TRANSINV: for my $i ( 0 .. $Atu->scale_degrees - 1 ) {
    my %ips;
    @ips{ @{ $Atu->transpose_invert( $ps_base, $i ) } } = ();
    if ( all { exists $ips{$_} } @$desired ) {
      my @pitches = @{ $Atu->transpose_invert( $ps_base, $i ) };
      next if defined $root_pitch and $pitches[0] != $root_pitch;
      if (%$excludes) {
        for my $p (@pitches) {
          next TRANSINV if exists $excludes->{$p};
        }
      }

      my $tstr = '';
      if ($Flag_Tension) {
        $tstr = sprintf "\t%.03f  %.03f  %.03f",
          $Tension->vertical( \@pitches );
      }

      @pitches = $Lyu->p2ly(@pitches) if $Flag_Lyout;

      printf "%s\tTi(%d)\t%-${ps_width}s%s\n", $fnum, $i,
        join( ',', @pitches ), $tstr;
    }
  }
}

sub fnums {
  my (@args) = @_;

  my $fns = $Atu->fnums;
  for my $fn ( sort keys %$fns ) {
    my $pset = $fns->{$fn};
    my $icc  = $Atu->interval_class_content($pset);

    my $tstr = '';
    if ($Flag_Tension) {
      $tstr = sprintf "\t%.03f  %.03f  %.03f", $Tension->vertical($pset);
    }

    printf "%s\t%-16s\t%-8s%s\n", $fn, join( ',', @$pset ),
      join( '', @$icc ), $tstr;
  }
}

sub forte2pcs {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();

  emit_pitch_set( $Atu->forte2pcs( $args[0] ), rs => ',' );
}

sub freq2pitch {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();

  _init_tension('cope');

  if ( @args == 1 and $args[0] eq '-' ) {
    chomp( @args = readline STDIN );
  }

  # Not the default, so if things persist or chain due to some rewrite,
  # would need to save the old or create a new object or whatever
  $Lyu->keep_state(1);
  $Lyu->mode('absolute');

  for my $freq ( grep looks_like_number $_, map { split ' ', $_ } @args ) {
    die "frequency '$freq' out of range" if $freq < 8 or $freq > 4200;

    my $p = $Tension->freq2pitch($freq);
    $p = $Lyu->p2ly($p) if $Flag_Lyout;
    printf "%.2f\t%s\n", $freq, $p;
  }
}

sub interval_class_content {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts );
  emit_pitch_set(
    scalar $Atu->interval_class_content( args2pitchset(@args) ),
    lyflag => 0,
    rs     => '',
  );
}

sub invariance_matrix {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts );
  emit_pitch_set(
    $Atu->invariance_matrix( args2pitchset(@args) ),
    lyflag => 0,
    rs     => ','
  );
}

sub invariants {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  my $ps = args2pitchset(@args);

  my %seen;
  @seen{@$ps} = ();

  my $icc = scalar $Atu->interval_class_content($ps);
  print '[',
    join( ',', map { $Flag_Lyout ? $Lyu->p2ly($_) : $_ } @$ps ),
    '] icc ', join( '', @$icc ), "\n";

  my $ps_len = 2 + @$ps * ( $Flag_Lyout ? 3 : 2 );

  for my $t ( 1 .. $Atu->scale_degrees - 1 ) {
    my $tps = $Atu->transpose( $ps, $t );
    my @t_invary;
    for my $p (@$tps) {
      push @t_invary, $p if exists $seen{$p};
    }
    if (@t_invary) {
      printf "%-6s [ %-${ps_len}s ] %s [ %-${ps_len}s ]\n", "T($t)",
        join( ',', map { $Flag_Lyout ? $Lyu->p2ly($_) : $_ } @$tps ),
        'invariants are:',
        join( ',', map { $Flag_Lyout ? $Lyu->p2ly($_) : $_ } @t_invary );

    }
  }

  for my $t ( 1 .. $Atu->scale_degrees - 1 ) {
    my $ips = $Atu->transpose_invert( $ps, $t );
    my @i_invary;
    for my $p (@$ips) {
      push @i_invary, $p if exists $seen{$p};
    }
    if (@i_invary) {
      printf "%-6s [ %-${ps_len}s ] %s [ %-${ps_len}s ]\n", "Ti($t)",
        join( ',', map { $Flag_Lyout ? $Lyu->p2ly($_) : $_ } @$ips ),
        'invariants are:',
        join( ',', map { $Flag_Lyout ? $Lyu->p2ly($_) : $_ } @i_invary );
    }
  }
}

sub invert {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts, 'axis|n=s' => \my $axis, )
    or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  $axis = defined $axis ? $Lyu->notes2pitches($axis) : 0;
  emit_pitch_set( $Atu->invert( args2pitchset(@args), $axis ), rs => ',' );
}

sub ly2pitch {
  my (@args) = @_;
  my $mode = 'absolute';
  GetOptionsFromArray( \@args, @Std_Opts, 'relative=s' => \my $relative, )
    or print_help();

  $Lyu->ignore_register(0);
  $Lyu->keep_state(1);
  $Lyu->sticky_state(1);
  if ($relative) {
    $Lyu->mode('relative');
    $Lyu->prev_note($relative);
  } else {
    $Lyu->mode('absolute');
  }

  my @notes;
  if ( @args == 1 and $args[0] eq '-' ) {
    chomp( @args = readline STDIN );
  }

  # split input, as lilypond ' really do not suit the Unix shell, so
  # are best enclosed in "" blocks
  for my $arg (@args) {
    push @notes, split ' ', $arg;
  }

  if ( !@notes ) {
    die "Usage: $0 ly2pitch [--relative=note] [-|notes...]\n";
  }

  print join( ' ', $Lyu->notes2pitches(@notes) ), "\n";
}

sub multiply {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts, 'factor|n=s' => \my $factor, )
    or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  $factor //= 1;
  die "factor must be number\n" unless looks_like_number $factor;
  emit_pitch_set( $Atu->multiply( args2pitchset(@args), $factor ) );
}

sub normal_form {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  emit_pitch_set( $Atu->normal_form( args2pitchset(@args) ), rs => ',' );
}

sub notes2dur {
  my (@args) = @_;
  my ( @durations, $tempo );

  for my $arg (@args) {
    # last matching tempo wins; this allows for aliases "foo 'atonal-
    # util notes2dur 4=120'" to set a default tempo, except that 'foo
    # 4=144 ...' then wins over that default.
    if ( $arg =~ m/([^=]+)=(\d+)/ ) {
      # TODO but must multiply it as cannot assume LHS is quarternote...
      # convert to "beats per second" or the like?
      $tempo = $2;

    } elsif ( $arg =~ m/(\d+)([.]*)/ ) {
      my $note = $1;
      my $dots = $2 // '';

      # convert these to "beat counts" in some unit, shove onto durations?

    } else {
      die "unable to parse duration from '$arg'\n";
    }
  }

  if ( !defined $tempo ) {
    warn "notice: using tempo 4=120 as none specified\n" unless $Flag_Quiet;
  }

  # tally up "beat counts" and figure how much time occupied in total,
  # print that formatted into buckets.
}

sub pcs2forte {
  my (@args) = @_;
  my $fn = $Atu->pcs2forte( args2pitchset(@args) ) || "";
  print $fn, "\n";
}

sub pitch2freq {
  my (@args) = @_;

  _init_tension('cope');

  if ( @args == 1 and $args[0] eq '-' ) {
    chomp( @args = readline STDIN );
  }

  for my $pitch ( map int, grep looks_like_number $_,
    map { split ' ', $_ } @args ) {
    die "pitch '$pitch' out of range\n" if $pitch < 0 or $pitch > 108;
    printf "%d\t%.2f\n", $pitch, $Tension->pitch2freq($pitch);
  }
}

sub pitch2intervalclass {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  die "$0 pitch2intervalclass pitch\n"
    unless defined $args[0] and $args[0] =~ m/^\d+$/;
  print $Atu->pitch2intervalclass( $args[0] ), "\n";
}

sub pitch2ly {
  my (@args) = @_;
  my $mode = 'absolute';
  GetOptionsFromArray( \@args, @Std_Opts, 'mode=s' => \$mode, )
    or print_help();

  # Not the default, so if things persist or chain due to some rewrite,
  # would need to save the old or create a new object or whatever
  $Lyu->keep_state(1);

  $Lyu->mode($mode) if defined $mode;

  my @pitches;
  if ( @args == 1 and $args[0] eq '-' ) {
    chomp( @args = readline STDIN );
    for my $arg (@args) {
      push @pitches, split ' ', $arg;
    }
  } else {
    @pitches = @args;
  }

  print join( ' ', $Lyu->p2ly(@pitches) ), "\n";
}

sub prime_form {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  emit_pitch_set( $Atu->prime_form( args2pitchset(@args) ), rs => ',' );
}

sub print_help {
  warn <<"END_USAGE";
Usage: $0 [options] mode mode-args

Atonal music analysis utilities. Options:

  --flats               Show flats instead of sharps when --ly used.
  --help                Print this message.
  --listmodes           Show available modes (see Music::AtonalUtil for docs).
  --ly                  Show lilypond note names instead of pitch numbers.
  --scaledegrees=n      Set a custom number of scale degrees (default: 12).

Most modes accept a pitch set (a list of positive integers or lilypond
note names (see source for supported names)) either as arguments, or
specified on STDIN if the arguments list is blank, or the final argument
is a hyphen. Exceptions include:

  invert    --n=N       Custom inversion axis (default is 0).
  multiply  --n=N       Multiply the pitch set by a factor (default is 1).
  pitch2intervalclass   Accepts a single pitch, not a pitch set.
  transpose --n=N       Custom transposition (default is 0).

Forte Numbers should be usable anywhere a pitch set can be specified.
The output will vary depending on the mode, and may include Cope
tension numbers.

Example:
  $0 invert --axis=3  0 3 6 7

The following require two pitch sets; specify the pitch sets on STDIN
(one per line) instead of in the arguments:

  variances        Emits three lines: the intersection, the difference,
                   and the union of the supplied pitch sets.
  zrelation        Emits 1 if pitch sets zrelated, 0 if not.

Example:
  (echo 0,1,3,7; echo 0,1,4,6) | $0 zrelation

There is also a 'basic' mode that computes both the prime form and
interval class content (and Forte Number, if possible):

  $0 --ly basic c e g

Run perldoc(1) on this script for additional documentation.

END_USAGE
  exit 64;
}

sub recipe {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts, 'file=s' => \my $rfile )
    or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;

  my $ps  = args2pitchset(@args);
  my $wps = [@$ps];

  open my $fh, '<', $rfile or die "could not open '$rfile': $!\n";
  eval {
    while ( my ( $method, @margs ) = split ' ', readline $fh ) {
      next if !$method or $method =~ m/^[\s#]/;
      chomp @margs;
      die "not a ", ref $Atu, " method" unless $Atu->can($method);
      $wps = $Atu->$method( $wps, @margs );
    }
  };
  if ($@) {
    chomp $@;
    die "recipe error at '$rfile' line $.: $@\n";
  }
  emit_pitch_set( $wps, rs => ',' );
}

sub retrograde {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  emit_pitch_set( $Atu->retrograde( args2pitchset(@args) ), rs => ',' );
}

sub rotate {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts, 'rotate|n=s' => \my $r, )
    or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  $r //= 0;
  die "rotate must be number\n" unless looks_like_number $r;
  emit_pitch_set( $Atu->rotate( args2pitchset(@args), $r ), rs => ',' );
}

sub set_complex {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  emit_pitch_set( $Atu->set_complex( args2pitchset(@args) ), rs => ',' );
}

sub subsets {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts, 'length|len=i' => \my $l, )
    or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  emit_pitch_set( $Atu->subsets( args2pitchset(@args), $l ), rs => ',' );
}

sub stdin2pitchsets {
  my @ss;
  while ( my $line = readline STDIN ) {
    my @pset;
    if ( $line =~ m/(\d-[zZ\d]+)/ ) {
      @pset = @{ $Atu->forte2pcs($1) };
      die "unknown Forte Number '$1'\n" if !@pset;
    } else {
      for my $p ( $line =~ /([\d\w]+)/g ) {
        push @pset, $Lyu->notes2pitches($p);
      }
    }
    push @ss, \@pset;
  }

  return \@ss;
}

sub tcs {
  my (@args) = @_;
  emit_pitch_set( $Atu->tcs( args2pitchset(@args) ), lyflag => 0 );
}

sub tcis {
  my (@args) = @_;
  emit_pitch_set( $Atu->tcis( args2pitchset(@args) ), lyflag => 0 );
}

sub tension {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();

  $Flag_Tension = 'cope' unless defined $Flag_Tension;
  _init_tension();

  my ( $t_avg, $t_min, $t_max, $t_ref ) =
    $Tension->vertical( args2pitchset(@args) );
  printf "%.03f  %.03f  %.03f\t%s\n", $t_avg, $t_min, $t_max,
    join( ',', @$t_ref );
}

sub transpose {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts, 'transpose|n=s' => \my $t, )
    or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  $t //= 0;

  my $pset = args2pitchset(@args);

  # if a number, transpose by that; if note, transpose to that note
  if ( !looks_like_number($t) ) {
    $t = $Lyu->notes2pitches($t) - $pset->[0];
  }
  emit_pitch_set( $Atu->transpose( $pset, $t ), rs => ',' );
}

sub transpose_invert {
  my (@args) = @_;
  GetOptionsFromArray(
    \@args, @Std_Opts,
    'axis|a=s'      => \my $axis,
    'transpose|t=s' => \my $t,
  ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;

  my $pset = args2pitchset(@args);

  $axis = defined $axis ? $Lyu->notes2pitches($axis) : 0;

  # if a number, transpose by that; if note, transpose to that note
  $t //= 0;
  if ( !looks_like_number($t) ) {
    $t = $Lyu->notes2pitches($t) - $pset->[0];
  }

  emit_pitch_set( $Atu->transpose_invert( $pset, $t, $axis ), rs => ',' );
}

sub variances {
  my (@args) = @_;
  GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
  $Lyu->chrome('flats') if $Flag_Flat;
  emit_pitch_set( [ $Atu->variances( @{ stdin2pitchsets() } ) ], rs => ',' );
}

sub zrelation {
  emit_pitch_set( [ $Atu->zrelation( @{ stdin2pitchsets() } ) ],
    lyflag => 0 );
}

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

__END__

=head1 NAME

atonal-util - routines for atonal composition and analysis

=head1 SYNOPSIS

Prime form and APIC vector for a pitch set:

  $ atonal-util basic --ly f fis c

Apply a series of transformations to a pitch set:

  $ cat rules
  retrograde
  invert 6
  transpose 1
  $ atonal-util recipe --file=rules 0 11 3
  4,8,7

Among many other options.

=head1 DESCRIPTION

Routines for atonal music composition and analysis, plus other random
music theory related tasks. Global options and an operating mode
should be supplied, followed by any mode specific arguments and a
pitch set. Pitch sets can be read as arguments or from standard input;
some modes require two pitch sets that must be supplied one per line
on standard input.

The output will vary depending on the mode, and may include Cope tension
numbers (average, min, max tension for the pitch set). Other programs
should not be written to use this program, as the output may change. Use
the underlying code or modules called by this program, as this program
is mostly intended for interactive use.

=head1 OPTIONS

This script currently supports the following global command line switches:

=over 4

=item B<--flats> | B<--noflats>

Uses flats instead of sharps in output (but only with B<--ly>). Specify
B<--noflats> to disable flats, in the event you have an alias that sets
B<--flats> by default. There is currently no B<--sharps> option, sorry.

=item B<--help>

Displays help and exits.

=item B<--listmodes>

Displays supported operation modes.

=item B<--ly>

Show lilypond note names instead of raw pitch numbers.

=item B<--scaledegrees>

Adjust the number of scale degrees (default: 12).

=back

=head1 MODES

Most all modes accept a pitch set (list of raw pitch numbers (0..number
of scale degrees) or lilypond note names (bis, c, des, etc.) either on
the command line or via standard input, though there are exceptions.

The global B<--ly> and B<--flats> can be specified as options to modes
that emit pitches. See also L<Music::AtonalUtil> for more documentation.

=over 4

=item B<basic> I<pitch_set>

Shows the B<prime_form> and B<interval_class_content>.

=item B<circular_permute>

See L<Music::AtonalUtil>.

=item B<combos> I<freq1> I<freq2> [I<freq3> ...]

Shows the combination tones of the input frequencies (or with the
optional I<--pitches> flag, MIDI pitch numbers or lilypond note names)
relative to the first listed frequency. The delta of equal temperament
tuning from the actual combination tone is also shown.

  $ atonal-util --ly combos 220 440
  $ atonal-util --ly combos --pitches "c' g'"

L<https://en.wikipedia.org/wiki/Combination_tone>

=item B<complement>

See L<Music::AtonalUtil>.

=item B<equivs>

Equivalents under transposition and inverse transposition. An optional
axis of inversion (default: 0, though some forms use 6) can be supplied.

=item B<findall> I<[--exclude=p1[,p2]]> I<[--fn=nums]> I<[--root=pitch]> I<pitches>

Find all Forte pitch sets in which the given pitches exist. Like
B<findin>, except iterates over all Forte pitch sets instead of just
the given one.

With I<--exclude>, omits results containing the listed pitches. With I<--
fn>, limits the search to the mentioned forte number prefixes (the
number of pitches in the set). With I<--root>, limits matches to those
with the named root pitch.

  $ atonal-util findall --root=c --fn=4-5 c e g bes

Tensions may be lower than expected if the root pitch creates an open
position chord versus a closed position of that set.

=item B<findin> I<[--exclude=p1[,p2]]> I<[--root=pitch]> I<--pitchset=base_set> I<pitches>

Answers questions such as, given a base pitch set of C<[0,3,7]>, and the
notes d and bes, what pitch sets (via any B<transpose> or
B<transpose_invert> operation) complete the base pitch set. With I<--
exclude>, omits results containing the listed pitches. With I<--root>,
limits matches to those with the named root pitch.

  $ atonal-util findin --exclude=c,ees --pitchset=5-25 d fis a

Tensions may be lower than expected if the root pitch creates an open
position chord versus a closed position of that set.

=item B<fnums>

Return a list of all Forte Numbers and corresponding pitch sets (and
their B<interval_class_content>), plus average tension, min tension, and
max tension via Music::Tension::Cope.

=item B<forte2pcs> I<forte_number>

Given a Forte Number, return the corresponding pitch set.

=item B<freq2pitch> I<frequencies...|->

Converts the listed frequencies (in Hz) into the closest MIDI note
numbers. Reads frequencies line-per-line from standard input if the only
frequency given is a C<->. With I<--ly> also converts the MIDI note
number to a lilypond note name.

=item B<interval_class_content>

See L<Music::AtonalUtil>.

=item B<invariance_matrix>

See L<Music::AtonalUtil>.

=item B<invariants>

Returns list of B<transpose> or B<transpose_invert> operations that have
invariant pitches with the supplied pitch set, along with which pitches
have not varied.

=item B<invert> I<[--axis=inversion_axis]>

See L<Music::AtonalUtil>. Default axis is around 0.

=item B<ly2pitch> I<[--relative=note]> [-|notes...]

Converts lilypond note names to pitch numbers, via absolute mode by
default. The input unlike in other modes may be quoted to protect the
lilypond C<'> register change from shell quoting rules. Example usages:

  $ echo c e g | atonal-util ly2pitch -
  $ atonal-util ly2pitch "c d' e f, g"
  $ atonal-util ly2pitch --relative=a\' a c d b

=item B<multiply>

See L<Music::AtonalUtil>.

=item B<normal_form>

See L<Music::AtonalUtil>.

=item B<pcs2forte>

Given a pitch set, returns the corresponding Forte Number, if any.

=item B<pitch2freq> I<pitches...|->

Converts pitches to a frequency (in Hz) using the standard MIDI note
number conversion equation. Reads pitches line-by-line from standard
input if only pitch given is C<->.

=item B<pitch2intervalclass> I<pitch>

See L<Music::AtonalUtil>.

=item B<pitch2ly> I<[--mode=relative|absolute]> I<pitches...|->

Converts pitches (integers) to lilypond note names. Reads pitches line-by-
line from standard input if only pitch given is C<->. Use the I<--mode>
option to specify relative or absolute conversion.

=item B<prime_form>

See L<Music::AtonalUtil>.

=item B<recipe> I<--file=recipefile>

Apply a series of named operations from a batch file to a pitch set,
for example:

  retrograde
  invert 6
  transpose 1

=item B<retrograde>

See L<Music::AtonalUtil>.

=item B<rotate> I<[--rotate=integer]>

See L<Music::AtonalUtil>.

=item B<set_complex>

See L<Music::AtonalUtil>.

=item B<subsets> I<[--length=integer]>

See L<Music::AtonalUtil>. The length, if supplied, must be a magnitude
equal to or less than the number of pitches supplied, and probably also
2 or higher.

=item B<tcis>

See L<Music::AtonalUtil>.

=item B<tcs>

See L<Music::AtonalUtil>.

=item B<tension> I<pitch_set>

Returns the average, min, max, and tension values for all the tensions
in the passed pitch set, from the first notes in the set up to the last.
(Via Music::Tension::Cope.)

=item B<transpose> I<--transpose=integer_or_note>

See L<Music::AtonalUtil>. Transposes the supplied pitches by the
specified integer (by default 0, or a no-op), or to the specified note.

  $ atonal-util transpose --transpose=4 --ly c e g
  e gis b
  $ atonal-util transpose --transpose=e --ly c e g
  e gis b

=item B<transpose_invert> I<--transpose=integer_or_note> I<[--axis=integer_or_note]>

See L<Music::AtonalUtil>. Transposes supplied pitch set by the specified
integer, or to the specified note. Default axis for inversion is 0 (c).

=item B<variances>

Accepts two pitch sets, one per line, via standard input.

=item B<zrelation>

Accepts two pitch sets, one per line, via standard input.

=back

=head1 FILES

ZSH completion script available in the zsh-compdef directory of the
L<App::MusicTools> distribution.

=head1 BUGS

=head2 Reporting Bugs

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

L<http://github.com/thrig/App-MusicTools>

=head2 Known Issues

Poor naming conventions and standards of underlying music theory and any
associated mistakes in understanding thereof by the author.

=head1 SEE ALSO

L<Music::AtonalUtil>, L<Music::LilyPondUtil>, L<Music::Tension::Cope>

=head1 AUTHOR

Jeremy Mates

=head1 COPYRIGHT

Copyright (C) 2012 by Jeremy Mates

This script is free software; you can redistribute it and/or modify it
under the same terms as Perl itself, either Perl version 5.16 or, at
your option, any later version of Perl 5 you may have available.

=cut
