#!/usr/bin/perl

open XDY,">$ARGV[0].xdy";
open DOC,">$ARGV[0]-doc.tex";
open TEST,">$ARGV[0].raw";
open TESTXDY,">$ARGV[0]-test.xdy";

print XDY ";; Rules for xindy; generated by make-rules.pl\n";
print XDY ";; language: $language\n\n";

if ($prefix) {
    $prefix = $prefix . '-';
}

print TESTXDY "(require \"lang/$ARGV[0].xdy\")\n";
print TESTXDY "(define-sort-rule-orientations (forward backward forward forward))\n";
print TESTXDY "(use-rule-set :run 0\n";
print TESTXDY "	      :rule-set (\"".$prefix."alphabetize\" \"".$prefix."ignore-special\"))\n";
print TESTXDY "(use-rule-set :run 1\n";
print TESTXDY "	      :rule-set (\"".$prefix."resolve-diacritics\" \"".$prefix."ignore-special\"))\n";
print TESTXDY "(use-rule-set :run 2\n";
print TESTXDY "	      :rule-set (\"".$prefix."resolve-case\" \"".$prefix."ignore-special\"))\n";
print TESTXDY "(use-rule-set :run 3\n";
print TESTXDY "	      :rule-set (\"".$prefix."resolve-special\"))\n";
close TESTXDY;

$fn = "test.xdy";
! -f $fn && -f "$INC[0]/$fn"  and  $fn = "$INC[0]/$fn";
-f $fn  or  die "$fn: $!";
system("cat $fn >> $ARGV[0]-test.xdy");

$begin = 128;
# $begin =  97 if ($script eq "cyrillic");
# $begin = 150 if ($script eq "latin");
# $begin =  65 if ($script eq "greek");

if (!$begin) {
    $begin = 65;
}

print "Alphabet has " . @{$alphabet} . " elements.\n";

for ($i = 0; $i < @{$alphabet}; $i++) {
  if (defined($alphabet->[$i][0])) {
    $letter = $alphabet->[$i][0];
    $lout = $letter;
    $lout =~ s/\~/~~/g;
    $lout =~ s/\"/~\"/g;
    $token = chr($i+$begin);
    $token =~ s/\~/~~/g;
    $token =~ s/\"/~\"/g;
    if ($after ne $lout) {
      print XDY "\"))\n" if ($i);
      print XDY "(define-letter-group \"$lout\"";
      print XDY " :after \"$after\"" if ($i);
      print XDY " :prefixes (\"";
    } else {
      print XDY "\" \"";
    }
    print XDY "$token";
    $after = $lout;
  }
}

print XDY "\"))\n\n";

$ref = \$i;
$offset = $begin;
$f = 1;
make_tokens();

# print test raw file
# alphabet
  $p = 1;
  foreach $letter (keys %tokens) {
    print TEST "(indexentry :key (\"$letter\") :locref \"$p\")\n";
    $p++;
  }
# end

process_ligatures();

print_tokens($prefix . "alphabetize");

$ref = \$j;
$offset = 161;
$f = 1;
make_tokens();

for ($i = 0; $i < @{$ligatures}; $i++) {
  if ($ligatures->[$i][1] eq "before") {
    $token = chr(161);
  } else {
    $token = chr(255);
  }
  foreach $ligature_variant (@{$ligatures->[$i][0]}) {
    $tokens{$ligature_variant} = $token;
  }
}

print_tokens($prefix . "resolve-diacritics");

$ref = \$k;
$offset = 48;
$f = 1;
if ($sortcase eq "Aa") {
  $offset = 57;
  $f = -1;
}

make_tokens();

process_ligatures();

print_tokens($prefix . "resolve-case");

foreach $character (@special) {
  $tokens{$character} = "" unless ($character eq "letters");
}

print_tokens($prefix . "ignore-special");

$offset = 161;
$f = 1;

for ($l = 0; $l < @special; $l++) {
  if (@special[$l] eq "letters") {
    $ref = \$l;
    make_tokens();
    process_ligatures();
  } else {
    $token = chr($l+$offset);
    $tokens{@special[$l]} = $token;
  }
}

print_tokens($prefix . "resolve-special");

# print doc:
# alphabet
  for ($i = 0; $i < @{$alphabet}; $i++) {
    for ($j = 1; $j < @{$alphabet->[$i]}; $j++) {
        push @l,join("\\,", (@{$alphabet->[$i][$j]}));
    }
    if ((@l)) {
	push @m, join(" & ", (@l));
    }
#    push @m, "`".$alphabet->[$i][0]."':\\>".join(" -- ", (@l));
    @l = ();
  }
  print DOC "\\subsection{$language";
  print DOC " ($variant)" if ($variant);
  print DOC "}\n\n";
  print DOC "\\subsubsection{Alphabet}\n";
  print DOC "\\icod\\fcod\n";
  print DOC "\\begin{alphabet}\n";
  print DOC join("\\\\\n", (@m));
  print DOC "\n\\end{alphabet}\n";
  print DOC "\\idef\\fdef\n";

# ligatures
  print DOC "\n\\subsubsection{Ligatures}\n";
  print DOC "\\begin{flushleft}\n";
  print DOC "None.\n" unless @{$ligatures};
  @m = ();
  for ($i = 0; $i < @{$ligatures}; $i++) {
    for ($j = 0; $j < @{$ligatures->[$i][0]}; $j++) {
      push @m, "`$ligatures->[$i][0][$j]' is sorted like `" .
        join("\\,", (@{$ligatures->[$i][2][$j]})) .
        "', but \\emph{$ligatures->[$i][1]} it in otherwise equal words.";
    }
  }
  print DOC join("\\\\\n", (@m));
  print DOC "\n\\end{flushleft}\n";

# case
  print DOC "\n\\subsubsection{Upper-/lowercase words}\n";
  if ($sortcase eq "Aa") {
    print DOC "Capitalized or uppercase words are sorted \\emph{before} ";
    print DOC "otherwise equal lowercase words.\n";
  } else {
    print DOC "Capitalized or uppercase words are sorted \\emph{after} ";
    print DOC "otherwise equal lowercase words.\n";
  }

# special
print DOC "\n\\subsubsection{Special characters}\n";
print DOC "The order of special characters and letters is:\n";
print DOC "\\begin{flushleft}\n";
print DOC join("\\hspace{4mm}", (@special));
print DOC "\n\\end{flushleft}\n";
print DOC "\\newpage\n";

# end

# print test raw file

#  for ($i = 0; $i < @{$alphabet}; $i++) {
#    for ($j = 1; $j < @{$alphabet->[$i]}; $j++) {
#      foreach $letter (@{$alphabet->[$i][$j]}) {
#        print TEST "(indexentry :key (\"$letter\") :locref \"$p\")\n";
#	$p++;
#      }
#    }
#  }

# ligatures
  for ($i = 0; $i < @{$ligatures}; $i++) {
    for ($j = 0; $j < @{$ligatures->[$i][0]}; $j++) {
      print TEST
        "(indexentry :key (\"$ligatures->[$i][0][$j]\") :locref \"$p\")\n";
      $p++;
      print TEST "(indexentry :key (\"" .
        join("", (@{$ligatures->[$i][2][$j]})) . "\") :locref \"$p\")\n";
      $p++;
    }
  }

# special
foreach $letter (@special) {
  if ($letter ne "letters") {
    print TEST "(indexentry :key (\"$letter\") :locref \"$p\")\n";
    $p++;
  }
}

# end

sub make_tokens {
  for ($i = 0; $i < @{$alphabet}; $i++) {
    for ($j = 1; $j < @{$alphabet->[$i]}; $j++) {
      for ($k = 0; $k < @{$alphabet->[$i][$j]}; $k++) {
        $token = chr($f*$$ref+$offset);
	if ($alphabet->[$i][$j][$k]) {
	  $tokens{$alphabet->[$i][$j][$k]} = $token;
	}
      }
    }
  }
}

sub process_ligatures {
  for ($i = 0; $i < @{$ligatures}; $i++) {
    for ($j = 0; $j < @{$ligatures->[$i][0]}; $j++) {
      $token = "";
      foreach $ligature_component (@{$ligatures->[$i][2][$j]}) {
        $token = $token.$tokens{$ligature_component};
      }
      $tokens{$ligatures->[$i][0][$j]} = $token;
    }
  }
}

sub print_tokens {
  print XDY "(define-rule-set \"$_[0]\"\n\n  :rules  (";
  foreach $letter (sort {
    (length($b) <=> length($a)) || ($tokens{$a} cmp $tokens{$b})
  } (keys %tokens)) {
    $lout = $letter;
    $lout =~ s/\~/~~/g;
    $lout =~ s/\"/~\"/g;
    $tout = $tokens{$letter};
    $tout =~ s/\~/~~/g;
    $tout =~ s/\"/~\"/g;
    print XDY "(\"$lout\" \"$tout\" :string)\n           ";
  }
  print XDY "))\n\n";
  %tokens = ();
}