use strict;
use warnings;

package Signif::PlaceBundle;
use fields qw{phon place};
# place and voice are lists of nums representing multiple features

use constant LABIAL => 0;
use constant DENTAL => 4;
use constant PALATAL => 6;
use constant VELAR => 9;
use constant POSTVELAR => 10;

sub Place($) {
  my $phon = shift(@_);
  my $place = [];
  if ($phon =~ m{ʙ|ɸ|β|ɓ|ṽ|ʘ|ø|œ|ɶ|ɵ|ɞ|ɔ|ʉ|ʏ|ɒ|ʍ|ɥ|ʷ|̹|[pbmouwy]|ɱ|ʋ|[fv]}) {
    push(@$place, LABIAL);
  }
  if ($phon =~ m{ð|θ|̼|ɾ|ɬ|ɮ|ɹ|ǀ|ǃ|ǁ|ɗ|ɺ|ɫ|̪|̺|̻|[tdnrszl]}) {
    push(@$place, DENTAL); #or alveolar
  }
  if ($phon =~ m{ʃ|ʒ|ǂ|ɧ|ɕ|ʑ|ʈ|ɖ|ɳ|ɽ|ʂ|ʐ|ɻ|ɭ|ɟ|ɲ|ç|ʝ|ʎ|ʄ|
        ȅ|ê|é|ḛ|è|ē|ě|ë|ẽ|ɛ|ɶ|ȉ|î|í|ḭ|ì|ī|ǐ|ĭ|ï|ḯ|ĩ|ɪ|
        ʏ|ŷ|ý|ỳ|ȳ|ẙ|ÿ|ø|œ|ɶ|æ|ǽ|ǣ|ʲ|[ciejy]}x) {
    push(@$place, PALATAL); #including front vowels, postalveolars
  }
  if ($phon =~ m{ɡ|ŋ|ɣ|ɰ|ʟ|ɠ|ɫ|ɨ|ʉ|ɘ|ə|ɚ|ɜ|ɝ|ɞ|ɐ|ȁ|â|á|à|ā|ǎ|ă|ắ|ằ|ḁ|ä|ǟ|ã|
        ȍ|ô|ó|ò|ō|ǒ|ő|ŏ|ö|ȫ|õ|ṍ|ȭ|õ|ṍ|ȭ|ɔ|ɒ|ɑ|
        ȕ|û|ú|ṵ|ù|ū|ǔ|ṳ|ű|ŭ|ü|ǘ|ǜ|ǖ|ǚ|ũ|ṹ|ũ|ṹ|ʊ|ʌ|ỹ|ɤ|ɵ|ɧ|ˠ|[akoxu]}x) {
    push(@$place, VELAR); #including nonfront vowels
  }
  if ($phon =~ m{ɢ|ɴ|ʀ|χ|ʁ|ħ|ʕ|ʔ|ɦ|ʛ|ʜ|ʢ|ʡ|ˤ|[hq]}) {
    push(@$place, POSTVELAR); #uvular, pharyngeal, epiglottal, "glottal"
  }
  if (!@$place) {die(qq{No place attributes known for /$phon/});}
  return $place;
}

sub new {
  my $type = shift(@_);
  my $phon = shift(@_);
  my Signif::PlaceBundle $bundle = fields::new($type);
  $bundle->{phon} = $phon;
  $bundle->{place} = Place($phon);
  #print(qq{      place= } . join(q{, }, @{$bundle->{place}}));
  return $bundle;
}

sub score_against {
  my Signif::PlaceBundle $b1 = shift(@_);
  my Signif::PlaceBundle $b2 = shift(@_);
  if ($b1->{phon} eq $b2->{phon}) {return 0;}
  return 0.5 
    + Place_Difference($b1->{place}, $b2->{place});
}

sub Place_Difference($$) {
  my $place1 = shift(@_);
  my $place2 = shift(@_);
  my $best = 100;
  foreach my $f1 (@$place1) {
    foreach my $f2 (@$place2) {
      return 0 if $f1 == $f2;
      my $diff = abs($f1 - $f2);
      if ($diff < $best) {$best = $diff;}
    }
  }
  return $best;
}

1;