#!/usr/bin/env perl
#
# Command line interface to the atonal routines in the Music::AtonalUtil
# module. Run perldoc(1) on this script for additional documentation.

use strict;
use warnings;

use Getopt::Long qw/GetOptions GetOptionsFromArray/;
use Music::AtonalUtil;

my %modes = (
  basic                  => \&basic,
  circular_permute       => \&circular_permute,
  complement             => \&complement,
  equivs                 => \&equivs,
  interval_class_content => \&interval_class_content,
  invariance_matrix      => \&invariance_matrix,
  invert                 => \&invert,
  multiply               => \&multiply,
  normal_form            => \&normal_form,
  pitch2intervalclass    => \&pitch2intervalclass,
  prime_form             => \&prime_form,
  recipe                 => \&recipe,
  retrograde             => \&retrograde,
  rotate                 => \&rotate,
  set_complex            => \&set_complex,
  tcs                    => \&tcs,
  tcis                   => \&tcis,
  transpose              => \&transpose,
  transpose_invert       => \&transpose_invert,
  variances              => \&variances,
  zrelation              => \&zrelation,
);

my %ly2pitch = qw/
  bis 0 c 0 cis 1 des 1 d 2 dis 3 ees 3 e 4 fes 4 eis 5 f 5
  fis 6 ges 6 g 7 gis 8 aes 8 a 9 ais 10 bes 10 b 11
  /;
my %pitch2ly = (
  'sharps' =>
    {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/},
  'flats' =>
    {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 $Flavor = 'sharps';

my ( $Flag_Flat, $Flag_Lyout );
my @Std_Opts = (
  'flats' => \$Flag_Flat,
  'ly'    => \$Flag_Lyout,
);

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,
) || print_help();
$scale_degrees //= Music::AtonalUtil->new->scale_degrees();
my $mode = shift;

print_help() if !defined $mode || !exists $modes{$mode};
my $atu = Music::AtonalUtil->new( DEG_IN_SCALE => $scale_degrees );

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

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

sub args2pitchset {
  my ( $atu, @args ) = @_;
  my $dis = $atu->scale_degrees;

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

  my $pitch_set;
  for my $arg (@args) {
    for my $p ( $arg =~ /([\d\w]+)/g ) {
      if ( $p =~ m/^\d+/ ) {
        push @$pitch_set, $p % $dis;
      } elsif ( exists $ly2pitch{ lc $p } ) {
        push @$pitch_set, $ly2pitch{ lc $p } % $dis;
      } else {
        die "error: unknown pitch '$p' in input\n";
      }
    }
  }

  return $pitch_set;
}

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

sub circular_permute {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts );
  emit_pitch_set( $atu->circular_permute( args2pitchset( $atu, @args ) ) );
}

sub complement {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts );
  emit_pitch_set( $atu->complement( args2pitchset( $atu, @args ) ) );
}

sub equivs {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts );

  my ( @transpose, @transpose_invert, %seen );
  my $pset = args2pitchset( $atu, @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 );
  emit_pitch_set( \@transpose_invert );
}

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

  my $lyify = exists $params{lyflag} ? $params{lyflag} : $Flag_Lyout;
  $Flavor = 'flats' if $Flag_Flat;

  my $has_nl = 0;
  for my $i (@$pset) {
    if ( ref $i eq 'ARRAY' ) {
      $has_nl = emit_pitch_set( $i, %params );
    } else {
      print( $lyify ? $pitch2ly{$Flavor}{$i} : $i, " " );
    }
  }
  print "\n" unless $has_nl;
  return 1;
}

sub interval_class_content {
  my ( $atu, @args ) = @_;
  emit_pitch_set(
    scalar $atu->interval_class_content( args2pitchset( $atu, @args ) ),
    lyflag => 0 );
}

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

sub invert {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts, 'axis|n=s' => \my $axis, );
  $axis //= 0;
  emit_pitch_set( $atu->invert( args2pitchset( $atu, @args ), $axis ) );
}

sub multiply {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts, 'factor|n=s' => \my $factor, );
  $factor //= 1;
  emit_pitch_set( $atu->multiply( args2pitchset( $atu, @args ), $factor ) );
}

sub normal_form {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts );
  emit_pitch_set( $atu->normal_form( args2pitchset( $atu, @args ) ) );
}

sub pitch2intervalclass {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts );
  die "$0 pitch2intervalclass pitch\n"
    unless defined $args[0] and $args[0] =~ m/^\d+$/;
  print $atu->pitch2intervalclass( $args[0] );
}

sub prime_form {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts );
  emit_pitch_set( $atu->prime_form( args2pitchset( $atu, @args ) ) );
}

sub recipe {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts, 'file=s' => \my $rfile );

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

  open my $fh, '<', $rfile or die "could not open '$rfile': $!\n";
  eval {
    while ( my ( $method, @margs ) = split ' ', readline $fh ) {
      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);
}

sub retrograde {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts );
  emit_pitch_set( $atu->retrograde( args2pitchset( $atu, @args ) ) );
}

sub rotate {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts, 'rotate|n=s' => \my $r, );
  $r //= 0;
  emit_pitch_set( $atu->rotate( args2pitchset( $atu, @args ), $r ) );
}

sub set_complex {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts );
  emit_pitch_set( $atu->set_complex( args2pitchset( $atu, @args ) ) );
}

sub stdin2pitchsets {
  my ($atu) = @_;
  my $dis = $atu->scale_degrees;

  my @ss;
  while ( my $line = readline STDIN ) {
    my @pset;
    for my $p ( $line =~ /([\d\w]+)/g ) {
      if ( $p =~ m/^\d+/ ) {
        push @pset, $p % $dis;
      } elsif ( exists $ly2pitch{ lc $p } ) {
        push @pset, $ly2pitch{ lc $p } % $dis;
      } else {
        die "error: unknown pitch '$p' in input\n";
      }
    }
    push @ss, \@pset;
  }

  return \@ss;
}

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

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

sub transpose {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts, 'transpose|n=s' => \my $t, );
  $t //= 0;
  emit_pitch_set( $atu->transpose( args2pitchset( $atu, @args ), $t ) );
}

sub transpose_invert {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray(
    \@args, @Std_Opts,
    'axis|a=s'      => \my $axis,
    'transpose|t=s' => \my $t,
  );
  $axis //= 0;
  $t    //= 0;
  emit_pitch_set(
    $atu->transpose_invert( args2pitchset( $atu, @args ), $t, $axis ) );
}

sub variances {
  my ( $atu, @args ) = @_;
  GetOptionsFromArray( \@args, @Std_Opts );
  emit_pitch_set( [ $atu->variances( @{ stdin2pitchsets($atu) } ) ] );
}

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

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).

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 of the input pitch set:

  $0 --ly basic c e g

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

END_USAGE
  exit 64;
}

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
  c cis fis
  1 0 0 0 1 1 

Apply a series of transformations to a pitch set:

  $ cat rules
  retrograde
  invert 6
  transpose 1
  $ atonal-util recipe --file=~/tmp/asdf --ly 0 11 3
  4 8 7

=head1 DESCRIPTION

Routines for atonal music composition and analysis. 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.

See also L<Music::AtonalUtil> for more documentation.

=head1 OPTIONS

This script currently supports the following global command line switches:

=over 4

=item B<--flats>

Uses flats instead of sharps in output (but only with B<--ly>).

=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 gobal 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<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<interval_class_content>

See L<Music::AtonalUtil>.

=item B<invariance_matrix>

See L<Music::AtonalUtil>.

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

See L<Music::AtonalUtil>.

=item B<multiply>

See L<Music::AtonalUtil>.

=item B<normal_form>

See L<Music::AtonalUtil>.

=item B<pitch2intervalclass> I<pitch>

See L<Music::AtonalUtil>.

=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>

See L<Music::AtonalUtil>.

=item B<set_complex>

See L<Music::AtonalUtil>.

=item B<tcis>

See L<Music::AtonalUtil>.

=item B<tcs>

See L<Music::AtonalUtil>.

=item B<transpose>

See L<Music::AtonalUtil>.

=item B<transpose_invert>

See L<Music::AtonalUtil>.

=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

There is an associated C<_atonal-util> completion script for the Z-Shell
(ZSH) that can assist with tab completion of options and modes.

=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.

http://github.com/thrig/Music-AtonalUtil

=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

perl(1), L<Music::AtonalUtil>

=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.14.2 or, at
your option, any later version of Perl 5 you may have available.

=cut
