#!/usr/bin/perl
#
# Programmer:    Craig Stuart Sapp <craig@ccrma.stanford.edu>
# Creation Date: Fri Apr 23 12:10:07 PDT 2010
# Last Modified: Fri Apr 23 12:17:51 PDT 2010
# Filename:      makecoord
# Syntax:        perl 5
#
# Description:   Calculate the fraction of major and minor sonorities
#                in a chorale, also extracting the tonality of the
#                chorale from the original data.
#
# Example output for chorale 1:
# 	"chor001"	0	0.5	0.113
# Where "chor001" is the label from the filename, 0 is the tonality (major),
#  0.5 is the fraction of sonorities which are major (50%), and 0.113 is
#  the fraction of sonorities which are minor (11.3%).
#

use strict;

my $SUM = 0.0;
my %contents = readContents($ARGV[0]);
my $base = $ARGV[0];
$base =~ s/\..*$//;
my $key = getKey("$base.krn");

my $majorfrac = $contents{'maj'} * 1.0 / $SUM;
my $minorfrac = $contents{'min'} * 1.0 / $SUM;
$majorfrac = int($majorfrac * 1000.0 + 0.5) / 1000.0;
$minorfrac = int($minorfrac * 1000.0 + 0.5) / 1000.0;

print "\"$base\"\t$key\t$majorfrac\t$minorfrac\n";
exit(0);

###########################################################################

##############################
##
## readContents -- reads a datafile which looks like this:
##     40 maj
##     12 X
##      9 min
##      6 domsev
##      5 minmin
##      4 dim
##      2 majmaj
##      1 minminx5
##      1 domsevx5
## which is the output of the command:
##     sonority -t chor001.krn | grep -v = | rid -GLId | sort | uniq -c | sort -nr
##

sub readContents {
   my ($file) = @_;
   open (FILE, $file) or die;
   my %output;
   my $line;
   my @data;
   while ($line = <FILE>) {
      chomp $line;
      $line =~ s/^\s*//;
      $line =~ s/\s*$//;
      @data = split(/\s+/, $line);
      next if @data != 2;
      $output{$data[1]} = $data[0];
      $SUM += $data[0];
   }
   close FILE;
   return %output;
}



##############################
##
## getKey -- input is a Humdrum file with **kern data.  Output is
##   a number:  0 = first key designation in file is major, 
##              1 = first key designation in file is minor,
##             -1 = no key designations in file.

sub getKey {
   my ($file) = @_;
   open (FILE, $file) or die;
   my $output = -1;
   my $line;
   my $mode;
   while ($line = <FILE>) {
      if ($line =~ /^\*([A-Ga-g])[#-]?:/) {
         $mode = $1;
         if ($mode =~ /[A-G]/) {
            $output = 0;
            return $output;
         } else {
            $output = 1;
            return $output;
         }
      }
   }
   close FILE;
   return $output;
}