#!/usr/local/bin/perl

use strict;
use POSIX;

##############################################################################
####                                                                         #
####  rtp.pl --   A program to find RTP patterns in African music based on   #
####              scorefiles                                                 #
####                                                                         #
####       usage: perl rtp.pl -fSCOREFILE                                    #
####                                                                         #
##############################################################################

## Initialize

my $bc = 12;
my ($word_length, $gap) = (12,0);
my ($measure_size, $initial_offset) = (6,5);
my $print_summary = 0;
my $print_all_words = 0;
my $print_score = 0;
my $minimum_score = 1;
my $require_firstbeat_attack = 0;
my $require_preceeding_silence = 0;
my $title = '';

my @comp_array;
my $line = '';

#### Process Arguments

foreach (@ARGV) {
  if (/-f([\w|\.]+)/) {
    open(SCOREFILE, $1) || die "Couldn't open $1 for reading";
    my @score_contents = <SCOREFILE>;
    close (SCOREFILE);
    foreach (@score_contents) {
      next if /^\#/;
      process_arg($_);
    }     
  } else {
    process_arg($_)
  }
}

print_summary() if $print_summary;

#### Run Program

$line ||= join '', <STDIN>;

my $fill_ref = {};
for (my $rtp = 1; $rtp <= $bc; $rtp++) {
  my $striped_line = strip_line($line, $rtp);
  foreach my $comp_ref (@comp_array) {
    compare($striped_line, $fill_ref, $rtp, $comp_ref);
  }
}
print_match($fill_ref, (strip_line($line,0)), $bc);
print ''; ## for the debugger

###############################################################################
####                                                                          #
####  subroutines: process_arg -- sets vars based on cmdline or scorefiles    #
####               print_summary -- sends out what a well commented scorefile #
####                                should already tell you                   #
####                                                                          #
###############################################################################

sub process_arg {
  $_ = shift;
  if    (/^-m(\d+)/)     {$measure_size = $1}
  elsif (/^-b(\d+)/)     {$bc = $1}
  elsif (/^-o([-|\d]+)/) {$initial_offset = $1}
  elsif (/^-w(\d+)/)     {$word_length = $1}
  elsif (/^-g([-|\d]+)/) {$gap = $1}
  elsif (/^-a/)      {$print_all_words = 1}
  elsif (/^-s/)      {$print_summary = 1}
  elsif (/^-ms(\d+)/) {$minimum_score = $1}
  elsif (/^-ps/)     {$print_score = 1}
  elsif (/^-rs/)     {$require_preceeding_silence = 1}
  elsif (/^-ra/)     {$require_firstbeat_attack = 1}
  elsif (/^-t\s*[\"|\'](.+)[\"|\']/) {$title = $1} 
  elsif (/^-rf\s*\"(.+)\"/) {
    open (READIN, $1) || die "Couldn't open $1 for processing\n";
    $line = join '', (<READIN>);
    close (READIN);
  }
  elsif (/^-c(\d+)\s+(\w+)\s+([-|\w]+)/) {
    if (ref($comp_array[$1]) ne "HASH") {
      $comp_array[$1] = {};
    }
    if ($2 eq "copy") {
      my %temp_hash = %{$comp_array[$3]};
      $comp_array[$1] = \%temp_hash;
    } else {$comp_array[$1]->{$2} = $3}
  }
  elsif (/^-c(\d+),(\d+),(\d+)/) {  ## for command line usage
    my %comp_hash;
    $comp_hash{'word'} = $1;
    $comp_hash{'gap'}  = $2;
    $comp_hash{'score'}= $3;
    push @comp_array, \%comp_hash;
  }
}

sub print_summary {
  my $summary_line = "";
  print "\n";
  print "** $title **\n\n" if $title;
  foreach my $comp_ref (@comp_array) {
    printf("Notes to Match: %2d, Gap between matches: %2d, Score: %2d\n", 
      $comp_ref->{'word'}, $comp_ref->{'gap'}, $comp_ref->{'score'});
    printf("  Score affects RTP %2d beats later.\n", $comp_ref->{'walk_offset'}) if $comp_ref->{'walk_offset'};
    printf("  First beat need not be attacked.\n") if !$comp_ref->{'rfb_attack'};
    printf("  Preceeding $comp_ref->{'rp_silence'} beat(s) must be silent.\n")  if $comp_ref->{'rp_silence'};
    printf("  Pattern will be compared without respect to pitch.\n") if $comp_ref->{'tone_insensitive'};
  }
  print "\n";
  printf("All phrases will be printed, even ones with no matches.\n") if $print_all_words;
  printf("Measure Size  : %2d, First Measure: %2d\n", $measure_size, $initial_offset);
  printf("Minimum Score : %2d\n\n",$minimum_score);
}

###############################################################################
####                                                                          #
####  strip_line -- eliminates beats from the beginning so that the piece is  #
####              in the proper RTP                                           #
####                                                                          #
###############################################################################

sub strip_line {
  my $line = shift;
  my $rtp  = shift;
  my $trim_amount = 0;
  $trim_amount = ($bc + 1 - $rtp) if $rtp;

  $line =~ s/^.{$trim_amount}//;
  return $line;
}


###############################################################################
####                                                                          #
####  make_binary(line_of_012012_etc)                                         #
####              -- eliminates pitch distinctions if any, returns 3/8        #
####                 groups as binary representations                         #
####                                                                          #
###############################################################################

sub make_binary {
  my $line = shift;
  $_  = $line;
  if ($bc % 3 == 0) {
    s/(\d{3})/$1 /g;
    s/0/o/g;
    s/\d/x/g;
    s/xxx /7/g;
    s/xxo /6/g;
    s/xox /5/g;
    s/xoo /4/g;
    s/oxx /3/g;
    s/oxo /2/g;
    s/oox /1/g;
    s/ooo /0/g;
#   s/(\d{4})/$1 /g;
    s/(x*o*x*o*x*o*)$//g;
  } else {
    die "I don't know how to deal with bc of $bc\n";
  }
  return $_;
}

###############################################################################
####                                                                          #
####  compare -- returns a hashref of words which are identical to the        #
####             following one                                                #
####                                                                          #
###############################################################################

sub compare {
  my $line        = shift;
  my $return_hash = shift;
  my $rtp         = shift;
  my $comp_ref    = shift;
  
  my $word_size    = $comp_ref->{'word'};
  my $gap          = $comp_ref->{'gap'}   || 0;
  my $score        = $comp_ref->{'score'} || 0;
  my $rfb_attack   = $comp_ref->{'rfb_attack'} || $require_firstbeat_attack;
  my $rp_silence   = $comp_ref->{'rp_silence'} || $require_preceeding_silence;
  my $walk_offset  = $comp_ref->{'walk_offset'} || 0;
  my $begin_offset = $comp_ref->{'begin_offset'} || 0;
  my $step_size    = $comp_ref->{'step_size'} || $word_size + $gap;
  my $tone_ins     = $comp_ref->{'tone_insensitive'} || 0;

     ## suffix -- tag to print for extraordinary circumstances, such as
     ##        -- idiomatic bridges

  my $suffix       = $comp_ref->{'suffix'} || 0;
  my $cond_suffix  = $comp_ref->{'conditional_suffix'} || 0;
#  my $ignore_word  = $comp_ref->{'ignore_word'} || 0; 

  if ($tone_ins) {
     $line =~ s/0/o/g;
     $line =~ s/\d/1/g;
     $line =~ s/o/0/g;
  }
  
  for (my $walk = $begin_offset; $walk <= (length($line) - 2*$word_size); 
       $walk += $step_size) {
    next if (substr($line, $walk, $word_size) ne 
        substr($line,($walk + $word_size + $gap), $word_size));
    next if ($rfb_attack && (substr($line, $walk, 1) == 0));  ## make sure first beat is not silent
    next if ($rp_silence && (substr($line, $walk-$rp_silence, $rp_silence) > 0)); ## make sure previous $rp_silence beats are silent
    my $affected_walk = $walk + $walk_offset;  ## a match can give a score to another position
    $return_hash->{$affected_walk}->[$rtp] += $score;

    ### hack--store suffix in $bc+1 in the array, and conditional
    ###    suffix in $bc+2
    $return_hash->{$affected_walk}->[$bc+1] = $suffix if $suffix;  ## add suffix for bridges
    $return_hash->{$affected_walk}->[$bc+2] = $cond_suffix if $cond_suffix;  ## add conditional_suffix
  }
  return $return_hash;
}


###############################################################################
####                                                                          #
####  print_match -- print RTP where an n_byte word matches the next word     #
####                 (generated by compare(...) qv)                           #
####                                                                          #
###############################################################################

sub print_match {
  my $fill_ref = shift;
  my $line = shift;
  my $word_size = shift;
  # my $highest_rtp = 99;

  for (my $walk = 0; $walk <= (length($line) - 2*$word_size); 
       $walk += $word_size) {

    my $word = ($walk/$word_size)+1;
    my $measure = POSIX::ceil($walk/$measure_size) + $initial_offset;
    my $printed_word = $print_all_words;
    my $print_line = sprintf("{%04d-%03d} ", $word, $measure);
    my $this_w = $fill_ref->{$walk};
    my $highest_score = 0;
    my $highest_rtp = ",00";
    for (my $rtp = 1; $rtp <= $bc; $rtp++) {
      my $rtp_s = defined($this_w->[$rtp]) ? $this_w->[$rtp] : 0;
      if ($rtp_s > $highest_score and $rtp_s > 0) {
            $highest_score = $rtp_s;
            $highest_rtp = sprintf(",%02d",$rtp);
      } elsif ($rtp_s == $highest_score && $rtp_s > 0) {$highest_rtp .= sprintf(",%02d",$rtp)}
     if ($rtp_s >= $minimum_score) {
        unless ($print_score) {$print_line .= sprintf("%02d ", $rtp)}
        else                  {$print_line .= sprintf("%02d-%02d ", $rtp, $this_w->[$rtp])}
        $printed_word = 1;
      } else {
        unless ($print_score) {$print_line .= " " x 3}
        else                  {$print_line .= " " x 6}
      }
    }
    ### conditional suffix (stored in $bc+2) is applied if no rtp met the minimum score
    if ($this_w->[$bc+2] and $highest_score < $minimum_score) {
        $this_w->[$bc+1] ||= $this_w->[$bc+2];
    }       

    ### print suffix if any
    $print_line .= defined($this_w->[$bc+1]) ? $this_w->[$bc+1] : ' ';
    printf("%s {%3d--%s}\n", $print_line, $highest_score, $highest_rtp) if $printed_word;
  }
}