make rules pl- for Sharing Code and Text.

PERL 43

make rules pl

Guest on 12th February 2023 03:24:08 AM

#!/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 = ();
}

Raw Paste

#!/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 = ();
}