summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/doc/latex/fmtcount/fmtcount.perl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/doc/latex/fmtcount/fmtcount.perl')
-rw-r--r--Master/texmf-dist/doc/latex/fmtcount/fmtcount.perl2670
1 files changed, 2670 insertions, 0 deletions
diff --git a/Master/texmf-dist/doc/latex/fmtcount/fmtcount.perl b/Master/texmf-dist/doc/latex/fmtcount/fmtcount.perl
new file mode 100644
index 00000000000..bc7d3b9fb4e
--- /dev/null
+++ b/Master/texmf-dist/doc/latex/fmtcount/fmtcount.perl
@@ -0,0 +1,2670 @@
+# File : fmtcount.perl
+# Author : Nicola Talbot
+# Date : 26 May 2007
+# Version : 1.05
+# Description : LaTeX2HTML implementation of fmtcount package
+
+package main;
+
+sub do_fmtcount_raise{
+ local($tmp)="";
+
+ $tmp .= 'sub do_cmd_fmtord{';
+ $tmp .= 'local($_) = @_;';
+ $tmp .= 'local($suffix) = &missing_braces unless (s/$next_pair_pr_rx/$suffix=$2;\'\'/eo);';
+ $tmp .= 'join("", "<SUP>",$suffix,"</SUP>",$_);';
+ $tmp .='}';
+
+ eval($tmp);
+}
+
+sub do_fmtcount_level{
+ local($tmp)="";
+
+ $tmp .= 'sub do_cmd_fmtord{';
+ $tmp .= 'local($_) = @_;';
+ $tmp .= 'local($suffix) = &missing_braces unless (s/$next_pair_pr_rx/$suffix=$2;\'\'/eo);';
+ $tmp .= 'join("", $suffix,$_);';
+ $tmp .='}';
+
+ eval($tmp);
+}
+
+if (not defined &do_cmd_fmtord)
+{
+ &do_fmtcount_raise(@_);
+}
+
+$frenchdialect = 'france';
+$ordinalabbrv = 0;
+
+sub get_ordinal_suffix_english{
+ local($num,$gender) = @_;
+ local($suffix);
+
+ if ((($num % 10) == 1) && ($num%100 != 11))
+ {
+ $suffix = 'st';
+ }
+ elsif ((($num % 10) == 2) && ($num%100 != 12))
+ {
+ $suffix = 'nd';
+ }
+ elsif ((($num % 10) == 3) && ($num%100 != 13))
+ {
+ $suffix = 'rd';
+ }
+ else
+ {
+ $suffix = 'th';
+ }
+
+ $suffix;
+}
+
+sub get_ordinal_suffix_french{
+ local($num,$gender) = @_;
+ local($_);
+
+ if ($ordinalabbrv > 0)
+ {
+ $_ = 'e';
+ }
+ else
+ {
+ if ($num == 1)
+ {
+ $_ = ($gender eq 'f' ? 'ere' : 'er');
+ }
+ else
+ {
+ $_ = 'eme';
+ }
+ }
+}
+
+sub get_ordinal_suffix_spanish{
+ local($num,$gender) = @_;
+
+ ($gender eq 'f' ? 'a' : 'o');
+}
+
+sub get_ordinal_suffix_portuges{
+ local($num,$gender) = @_;
+
+ ($gender eq 'f' ? 'a' : 'o');
+}
+
+sub get_ordinal_suffix_german{
+ local($num,$gender) = @_;
+
+ '';
+}
+
+sub get_ordinal_suffix_ngerman{
+ local($num,$gender) = @_;
+
+ '';
+}
+
+sub get_ordinal_suffix{
+ local($num,$gender) = @_;
+ local($suffix,$suffixsub);
+
+ $suffixsub = "get_ordinal_suffix_$default_language";
+
+ if (defined ($suffixsub))
+ {
+ $suffix = &$suffixsub($num,$gender);
+ }
+ else
+ {
+ $suffix = &get_ordinal_suffix_english($num,$gender);
+ }
+
+ $suffix;
+}
+
+sub getordinal{
+ local($num,$gender) = @_;
+ local($suffix) = &get_ordinal_suffix($num,$gender);
+ local($text)='';
+
+ if ($suffix eq '')
+ {
+ $text = $num;
+ }
+ else
+ {
+ local($br_id) = ++$global{'max_id'};
+ $text = $num . "\\fmtord${OP}$br_id${CP}$suffix${OP}$br_id${CP}";
+ }
+
+ $text;
+}
+
+sub do_cmd_ordinalnum{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+ my($gender)='m';
+ local($suffix)='';
+
+ if (s/\[([mfn])\]//)
+ {
+ $gender = $1;
+ }
+
+ $suffix = &get_ordinal_suffix($num,$gender);
+
+ local($br_id) = ++$global{'max_id'};
+ join('', $num, "\\fmtord${OP}$br_id${CP}$suffix${OP}$br_id${CP}", $_);
+}
+
+sub do_cmd_FCordinal{
+ &do_cmd_ordinal;
+}
+
+sub do_cmd_ordinal{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+ my($gender)='m';
+
+ $_[0] =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_[0]=~s/\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $str eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ join('', '{ORDINAL{', $ctr, '}}', $_[0]);
+ }
+ else
+ {
+ join('', &getordinal($val, $gender), $_[0]);
+ }
+}
+
+sub do_cmd_storeordinal{
+ local($_) = @_;
+ local($key);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ local($ctr, $val, $id, $_) = &read_counter_value($_);
+ my($gender)='m';
+
+ $_ =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_ =~s/\s*\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ $fmtcntvar{$key} = join('', '{ORDINAL{', $ctr, '}}');
+ }
+ else
+ {
+ $fmtcntvar{$key} = &getordinal($val, $gender);
+ }
+
+ $_;
+}
+
+sub do_cmd_storeordinalnum{
+ local($_) = @_;
+ local($key, $val);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ $val = &missing_braces
+ unless (s/$next_pair_pr_rx/$val=$2;''/eo);
+
+ my($gender)='m';
+
+ if ($_ =~s/\s*\[([mfn])\]//)
+ {
+ $gender = $1;
+ }
+
+ $fmtcntvar{$key} = &getordinal($val, $gender);
+
+ $_;
+}
+
+@unitthstring = ('zeroth',
+ 'first',
+ 'second',
+ 'third',
+ 'fourth',
+ 'fifth',
+ 'sixth',
+ 'seventh',
+ 'eighth',
+ 'ninth');
+
+@tenthstring = ('',
+ 'tenth',
+ 'twentieth',
+ 'thirtieth',
+ 'fortieth',
+ 'fiftieth',
+ 'sixtieth',
+ 'seventieth',
+ 'eightieth',
+ 'ninetieth');
+
+@teenthstring = ('tenth',
+ 'eleventh',
+ 'twelfth',
+ 'thirteenth',
+ 'fourteenth',
+ 'fifteenth',
+ 'sixteenth',
+ 'seventeenth',
+ 'eighteenth',
+ 'nineteenth');
+
+@unitstring = ('zero',
+ 'one',
+ 'two',
+ 'three',
+ 'four',
+ 'five',
+ 'six',
+ 'seven',
+ 'eight',
+ 'nine');
+
+@teenstring = ('ten',
+ 'eleven',
+ 'twelve',
+ 'thirteen',
+ 'fourteen',
+ 'fifteen',
+ 'sixteen',
+ 'seventeen',
+ 'eighteen',
+ 'nineteen');
+@tenstring = ('',
+ 'ten',
+ 'twenty',
+ 'thirty',
+ 'forty',
+ 'fifty',
+ 'sixty',
+ 'seventy',
+ 'eighty',
+ 'ninety');
+
+$hundredname = "hundred";
+$hundredthname = "hundredth";
+$thousandname = "thousand";
+$thousandthname = "thousandth";
+
+sub get_numberstringenglish{
+ local($num) = @_;
+ local($name)="";
+
+ unless (($num >= 1000000) || ($num < 0))
+ {
+ if ($num >= 1000)
+ {
+ local($thousands) = &get_numberstringenglish($num/1000);
+ $name .= $thousands . " $thousandname";
+ $num = $num%1000;
+ }
+
+ if ($num >= 100)
+ {
+ if ($_[0] >= 1000) { $name .= " "; }
+
+ local($hundreds) = &get_numberstringenglish($num/100);
+ $name .= $hundreds . " $hundredname";
+ $num = $num%100;
+ }
+
+ if (($_[0] > 100) && ($_[0]%100 > 0)) { $name .= " and "; }
+
+ if ($num >= 20)
+ {
+ $name .= $tenstring[$num/10];
+
+ if ($num%10 > 0) { $name .= '-'; }
+ }
+
+ if (($num >= 10) && ($num < 20))
+ {
+ $name .= $teenstring[$num%10];
+ }
+ elsif (($num%10 > 0) || ($_[0] == 0))
+ {
+ $name .= $unitstring[$num%10];
+ }
+ }
+
+ $name;
+}
+
+@unitthstringfrench = ('zeroi\`eme',
+ 'uni\`eme',
+ 'deuxi\`eme',
+ 'troisi\`eme',
+ 'quatri\`eme',
+ 'cinqui\`eme',
+ 'sixi\`eme',
+ 'septi\`eme',
+ 'huiti\`eme',
+ 'neuvi\`eme');
+
+@tenthstringfrench = ('',
+ 'dixi\`eme',
+ 'vingti\`eme',
+ 'trentri\`eme',
+ 'quaranti\`eme',
+ 'cinquanti\`eme',
+ 'soixanti\`eme',
+ 'septenti\`eme',
+ 'huitanti\`eme',
+ 'nonenti\`eme');
+
+@teenthstringfrench = ('dixi\`eme',
+ 'onzi\`eme',
+ 'douzi\`eme',
+ 'treizi\`eme',
+ 'quatorzi\`eme',
+ 'quinzi\`eme',
+ 'seizi\`eme',
+ 'dix-septi\`eme',
+ 'dix-huiti\`eme',
+ 'dix-neuvi\`eme');
+
+@unitstringfrench = ('zero',
+ 'un',
+ 'deux',
+ 'trois',
+ 'quatre',
+ 'cinq',
+ 'six',
+ 'sept',
+ 'huit',
+ 'neuf');
+
+@teenstringfrench = ('dix',
+ 'onze',
+ 'douze',
+ 'treize',
+ 'quatorze',
+ 'quinze',
+ 'seize',
+ 'dix-sept',
+ 'dix-huit',
+ 'dix-neuf');
+
+@tenstringfrench = ('',
+ 'dix',
+ 'vingt',
+ 'trente',
+ 'quarante',
+ 'cinquante',
+ 'soixante',
+ 'septente',
+ 'huitante',
+ 'nonente');
+
+$hundrednamefrench = "cent";
+$hundredthnamefrench = "centi\\`eme";
+$thousandnamefrench = "mille";
+$thousandthnamefrench = "mili\\`eme";
+
+@unitthstringspanish = ('cero',
+ 'primero',
+ 'segundo',
+ 'tercero',
+ 'cuarto',
+ 'quinto',
+ 'sexto',
+ 's\\\'eptimo',
+ 'octavo',
+ 'noveno');
+
+@tenthstringspanish = ('',
+ 'd\\\'ecimo',
+ 'vig\\\'esimo',
+ 'trig\\\'esimo',
+ 'cuadrag\\\'esimo',
+ 'quincuag\\\'esimo',
+ 'sexag\\\'esimo',
+ 'septuag\\\'esimo',
+ 'octog\\\'esimo',
+ 'nonag\\\'esimo');
+
+@teenthstringspanish = ('d\\\'ecimo',
+ 'und\\\'ecimo',
+ 'duod\\\'ecimo',
+ 'decimotercero',
+ 'decimocuarto',
+ 'decimoquinto',
+ 'decimosexto',
+ 'decimos\\\'eptimo',
+ 'decimoctavo',
+ 'decimonoveno');
+
+@hundredthstringspanish = ('',
+ 'cent\\\'esimo',
+ 'ducent\\\'esimo',
+ 'tricent\\\'esimo',
+ 'cuadringent\\\'esimo',
+ 'quingent\\\'esimo',
+ 'sexcent\\\'esimo',
+ 'septing\\\'esimo',
+ 'octingent\\\'esimo',
+ 'noningent\\\'esimo');
+
+@unitstringspanish = ('cero',
+ 'uno',
+ 'dos',
+ 'tres',
+ 'cuatro',
+ 'cinco',
+ 'seis',
+ 'siete',
+ 'ocho',
+ 'nueve');
+
+@teenstringspanish = ('diez',
+ 'once',
+ 'doce',
+ 'trece',
+ 'catorce',
+ 'quince',
+ 'diecis\\\'eis',
+ 'diecisiete',
+ 'dieciocho',
+ 'diecinueve');
+
+@twentystringspanish = ('viente',
+ 'vientiuno',
+ 'vientid\\\'os',
+ 'vientitr\\\'es',
+ 'vienticuatro',
+ 'vienticinco',
+ 'vientis\\\'eis',
+ 'vientisiete',
+ 'vientiocho',
+ 'vientinueve');
+
+@tenstringspanish = ('',
+ 'diez',
+ 'viente',
+ 'treinta',
+ 'cuarenta',
+ 'cincuenta',
+ 'sesenta',
+ 'setenta',
+ 'ochenta',
+ 'noventa');
+
+@hundredstringspanish = ('',
+ 'ciento',
+ 'doscientos',
+ 'trescientos',
+ 'cuatrocientos',
+ 'quinientos',
+ 'seiscientos',
+ 'setecientos',
+ 'ochocientos',
+ 'novecientos');
+
+$hundrednamespanish = "cien";
+$hundredthnamespanish = "centi\\`eme";
+$thousandnamespanish = "mil";
+$thousandthnamespanish = "mil\\'esimo";
+
+@unitthstringportuges = ('zero',
+ 'primeiro',
+ 'segundo',
+ 'terceiro',
+ 'quatro',
+ 'quinto',
+ 'sexto',
+ 's\\\'etimo',
+ 'oitavo',
+ 'nono');
+
+@tenthstringportuges = ('',
+ 'd\\\'ecimo',
+ 'vig\\\'esimo',
+ 'trig\\\'esimo',
+ 'quadrag\\\'esimo',
+ 'q\"uinquag\\\'esimo',
+ 'sexag\\\'esimo',
+ 'setuag\\\'esimo',
+ 'octog\\\'esimo',
+ 'nonag\\\'esimo');
+
+@hundredthstringportuges = ('',
+ 'cent\\\'esimo',
+ 'ducent\\\'esimo',
+ 'trecent\\\'esimo',
+ 'quadringent\\\'esimo',
+ 'q\"uingent\\\'esimo',
+ 'seiscent\\\'esimo',
+ 'setingent\\\'esimo',
+ 'octingent\\\'esimo',
+ 'nongent\\\'esimo');
+
+@unitstringportuges = ('zero',
+ 'um',
+ 'dois',
+ 'tr\^es',
+ 'quatro',
+ 'cinco',
+ 'seis',
+ 'sete',
+ 'oito',
+ 'nove');
+
+@teenstringportuges = ('dez',
+ 'onze',
+ 'doze',
+ 'treze',
+ 'quatorze',
+ 'quinze',
+ 'dezesseis',
+ 'dezessete',
+ 'dezoito',
+ 'dezenove');
+
+@tenstringportuges = ('',
+ 'dez',
+ 'vinte',
+ 'trinta',
+ 'quaranta',
+ 'cinq\"uenta',
+ 'sessenta',
+ 'setenta',
+ 'oitenta',
+ 'noventa');
+
+@hundredstringportuges = ('',
+ 'cento',
+ 'duzentos',
+ 'trezentos',
+ 'quatrocentos',
+ 'quinhentos',
+ 'seiscentos',
+ 'setecentos',
+ 'oitocentos',
+ 'novecentos');
+
+$hundrednameportuges = "cem";
+$thousandnameportuges = "mil";
+$thousandthnameportuges = "mil\\'esimo";
+
+sub get_numberstringfrench{
+ local($num,$gender) = @_;
+ local($name)="";
+
+ if ($gender eq 'f')
+ {
+ $unitstringfrench[1] = 'une';
+ }
+ else
+ {
+ $unitstringfrench[1] = 'un';
+ }
+
+ unless (($num >= 1000000) || ($num < 0))
+ {
+ if ($num >= 1000)
+ {
+ local($thousands) = '';
+
+ if ($num >= 2000)
+ {
+ $thousands = &get_numberstringfrench($num/1000,$gender).' ';
+ }
+
+ $name .= $thousands . $thousandnamefrench;
+ $num = $num%1000;
+ }
+
+ if ($num >= 100)
+ {
+ if ($_[0] >= 1000) { $name .= " "; }
+
+ local($hundreds) = '';
+
+ if ($num >= 200)
+ {
+ $hundreds = &get_numberstringfrench($num/100,$gender).' ';
+ }
+
+ $name .= $hundreds . $hundrednamefrench;
+ $num = $num%100;
+
+ if (($_[0]%100 == 0) && ($_[0]/100 > 1))
+ {
+ $name .= 's';
+ }
+ }
+
+ if (($_[0] > 100) && ($_[0]%100 > 0)) { $name .= " "; }
+
+ if ($num >= 20)
+ {
+ if ($frenchdialect eq 'france' and $num >= 70)
+ {
+ if ($num < 80)
+ {
+ $name .= $tenstringfrench[6];
+
+ if ($num%10 == 1)
+ {
+ $name .= ' et ';
+ }
+ else
+ {
+ $name .= '-';
+ }
+
+ $num = 10+($num%10);
+ }
+ else
+ {
+ $name .= 'quatre-vingt' . ($num==80?'s':'-');
+
+ if ($num >= 90)
+ {
+ $num = 10+($num%10);
+ }
+ }
+ }
+ elsif ($frenchdialect eq 'belgian'
+ && ($num >= 80) && ($num < 90))
+ {
+ $name .= 'quatre-vingt' . ($num==80?'s':'-');
+ }
+ else
+ {
+ $name .= $tenstringfrench[$num/10];
+
+ if ($num%10 == 1) { $name .= ' et ';}
+ elsif ($num%10 > 0) { $name .= '-'; }
+ }
+ }
+
+ if (($num >= 10) && ($num < 20))
+ {
+ $name .= $teenstringfrench[$num%10];
+ }
+ elsif (($num%10 > 0) || ($_[0] == 0))
+ {
+ $name .= $unitstringfrench[$num%10];
+ }
+ }
+
+ $name;
+}
+
+sub get_numberstringspanish{
+ local($num,$gender) = @_;
+ local($name)="";
+
+ if ($gender eq 'f')
+ {
+ $unitstringspanish[1] = 'una';
+ }
+ else
+ {
+ $unitstringspanish[1] = 'uno';
+ }
+
+ unless (($num >= 1000000) || ($num < 0))
+ {
+ if ($num >= 1000)
+ {
+ local($thousands) = '';
+
+ if ($num >= 2000)
+ {
+ $thousands = &get_numberstringspanish($num/1000,$gender).' ';
+ }
+
+ $name .= $thousands . $thousandnamespanish;
+ $num = $num%1000;
+ }
+
+ if ($num >= 100)
+ {
+ if ($_[0] >= 1000) { $name .= " "; }
+
+ local($hundreds) = '';
+
+ if ($num > 100)
+ {
+ $hundreds = $hundredstringspanish[$num/100];
+ }
+ else
+ {
+ $hundreds = 'cien';
+ }
+
+ $name .= $hundreds;
+ $num = $num%100;
+ }
+
+ if (($_[0] > 100) && ($_[0]%100 > 0)) { $name .= " y "; }
+
+ if ($num >= 30)
+ {
+ $name .= $tenstringspanish[$num/10];
+
+ if ($num%10 > 0) { $name .= ' y '; }
+ }
+
+ if (($num >=20) && ($num < 30))
+ {
+ $name .= $twentystringspanish[$num%10];
+ }
+ elsif (($num >= 10) && ($num < 20))
+ {
+ $name .= $teenstringspanish[$num%10];
+ }
+ elsif (($num%10 > 0) || ($_[0] == 0))
+ {
+ $name .= $unitstringspanish[$num%10];
+ }
+ }
+
+ $name;
+}
+
+sub get_numberstringportuges{
+ local($num,$gender) = @_;
+ local($name)="";
+
+ if ($gender eq 'f')
+ {
+ $unitstringportuges[0] = 'zera';
+ $unitstringportuges[1] = 'uma';
+ $unitstringportuges[2] = 'duas';
+ }
+ else
+ {
+ $unitstringportuges[0] = 'zero';
+ $unitstringportuges[1] = 'um';
+ $unitstringportuges[2] = 'dois';
+ }
+
+ unless (($num >= 1000000) || ($num < 0))
+ {
+ if ($num >= 1000)
+ {
+ local($thousands) = '';
+
+ if ($num >= 2000)
+ {
+ $thousands = &get_numberstringportuges($num/1000,$gender).' ';
+ }
+
+ $name .= $thousands . $thousandnameportuges;
+ $num = $num%1000;
+ }
+
+ if ($num >= 100)
+ {
+ if ($_[0] >= 1000) { $name .= " "; }
+
+ local($hundreds) = '';
+
+ if ($num > 100)
+ {
+ $hundreds = $hundredstringportuges[$num/100];
+
+ if ($gender eq 'f' and $num >= 200)
+ {
+ $hundreds =~s/o(s?)$/a\1/;
+ }
+ }
+ else
+ {
+ $hundreds = $hundrednameportuges;
+ }
+
+ $name .= $hundreds;
+ $num = $num%100;
+ }
+
+ if (($_[0] > 100) && ($_[0]%100 > 0)) { $name .= " e "; }
+
+ if ($num >= 20)
+ {
+ $name .= $tenstringportuges[$num/10];
+
+ if ($num%10 == 1) { $name .= ' e ';}
+ elsif ($num%10 > 0) { $name .= ' '; }
+ }
+
+ if (($num >= 10) && ($num < 20))
+ {
+ $name .= $teenstringportuges[$num%10];
+ }
+ elsif (($num%10 > 0) || ($_[0] == 0))
+ {
+ $name .= $unitstringportuges[$num%10];
+ }
+ }
+
+ $name;
+}
+
+@unitthstringMgerman = ('nullter',
+ 'erster',
+ 'zweiter',
+ 'dritter',
+ 'vierter',
+ 'f\\"unter',
+ 'sechster',
+ 'siebter',
+ 'achter',
+ 'neunter');
+
+@tenthstringMgerman = ('',
+ 'zehnter',
+ 'zwanzigster',
+ 'drei\\ss igster',
+ 'vierzigster',
+ 'f\\"unfzigster',
+ 'sechzigster',
+ 'siebzigster',
+ 'achtzigster',
+ 'neunzigster');
+
+@teenthstringMgerman = ('zehnter',
+ 'elfter',
+ 'zw\\"olfter',
+ 'dreizehnter',
+ 'vierzehnter',
+ 'f\\"unfzehnter',
+ 'sechzehnter',
+ 'siebzehnter',
+ 'achtzehnter',
+ 'neunzehnter');
+
+@unitthstringFgerman = ('nullte',
+ 'erste',
+ 'zweite',
+ 'dritte',
+ 'vierte',
+ 'f\\"unfte',
+ 'sechste',
+ 'siebte',
+ 'achte',
+ 'neunte');
+
+@tenthstringFgerman = ('',
+ 'zehnte',
+ 'zwanzigste',
+ 'drei\\ss igste',
+ 'vierzigste',
+ 'f\\"unfzigste',
+ 'sechzigste',
+ 'siebzigste',
+ 'achtzigste',
+ 'neunzigste');
+
+@teenthstringFgerman = ('zehnte',
+ 'elfte',
+ 'zw\\"olfte',
+ 'dreizehnte',
+ 'vierzehnte',
+ 'f\\"unfzehnte',
+ 'sechzehnte',
+ 'siebzehnte',
+ 'achtzehnte',
+ 'neunzehnte');
+
+@unitthstringNgerman = ('nulltes',
+ 'erstes',
+ 'zweites',
+ 'drittes',
+ 'viertes',
+ 'f\\"unte',
+ 'sechstes',
+ 'siebtes',
+ 'achtes',
+ 'neuntes');
+
+@tenthstringNgerman = ('',
+ 'zehntes',
+ 'zwanzigstes',
+ 'drei\\ss igstes',
+ 'vierzigstes',
+ 'f\\"unfzigstes',
+ 'sechzigstes',
+ 'siebzigstes',
+ 'achtzigstes',
+ 'neunzigstes');
+
+@teenthstringNgerman = ('zehntes',
+ 'elftes',
+ 'zw\\"olftes',
+ 'dreizehntes',
+ 'vierzehntes',
+ 'f\\"unfzehntes',
+ 'sechzehntes',
+ 'siebzehntes',
+ 'achtzehntes',
+ 'neunzehntes');
+
+@unitstringgerman = ('null',
+ 'ein', # eins dealt with separately (this is for prefixes)
+ 'zwei',
+ 'drei',
+ 'vier',
+ 'f\\"unf',
+ 'sechs',
+ 'sieben',
+ 'acht',
+ 'neun');
+
+@teenstringgerman = ('zehn',
+ 'elf',
+ 'zw\\"olf',
+ 'dreizehn',
+ 'vierzehn',
+ 'f\\"unfzehn',
+ 'sechzehn',
+ 'siebzehn',
+ 'achtzehn',
+ 'neunzehn');
+
+@tenstringgerman = ('',
+ 'zehn',
+ 'zwanzig',
+ 'drei\\ss ig',
+ 'vierzig',
+ 'f\\"unfzig',
+ 'sechzig',
+ 'siebzig',
+ 'achtzig',
+ 'neunzig');
+
+sub do_cmd_einhundert{
+ local($_) = @_;
+
+ "einhundert$_";
+}
+
+sub do_cmd_eintausend{
+ local($_) = @_;
+
+ "eintausend$_";
+}
+
+sub get_numberunderhundredgerman{
+ local($num)=@_;
+ local($name)='';
+
+ if ($num == 1)
+ {
+ $name = 'eins';
+ }
+ elsif ($num < 10)
+ {
+ $name = $unitstringgerman[$num];
+ }
+ elsif ($num%10 == 0)
+ {
+ $name = $tenstringgerman[$num/10];
+ }
+ else
+ {
+ $name = join('und', $unitstringgerman[$num%10],
+ $tenstringgerman[$num/10]);
+ }
+
+ $name;
+}
+
+sub get_numberstringgerman{
+ local($orgnum,$gender) = @_;
+ local($name)="";
+
+ local($num) = $orgnum;
+
+ unless (($num >= 1000000) || ($num < 0))
+ {
+ if ($num >= 1000 and $num < 2000)
+ {
+ $name = &translate_commands("\\eintausend ");
+ }
+ elsif ($num >= 2000)
+ {
+ $name = &get_numberunderhundredgerman($num/1000)
+ . "tausend";
+ }
+
+ $num = $orgnum%1000;
+
+ if ($num >= 100 and $num < 200)
+ {
+ if ($orgnum > 1000)
+ {
+ $name .= "einhundert";
+ }
+ else
+ {
+ $name = &translate_commands("\\einhundert ");
+ }
+ }
+ elsif ($num >= 200)
+ {
+ $name .= $unitstringgerman[$num/100]."hundert";
+ }
+
+ $num = $num%100;
+
+ if ($orgnum == 0)
+ {
+ $name = 'null';
+ }
+ elsif ($num > 0)
+ {
+ $name .= &get_numberunderhundredgerman($num);
+ }
+ }
+
+ $name;
+}
+
+sub get_numberstring{
+ local($val,$gender) = @_;
+
+ if ($default_language eq 'french')
+ {
+ &get_numberstringfrench($val,$gender);
+ }
+ elsif ($default_language eq 'spanish')
+ {
+ &get_numberstringspanish($val,$gender);
+ }
+ elsif ($default_language eq 'portuges')
+ {
+ &get_numberstringportuges($val,$gender);
+ }
+ elsif ($default_language eq 'german'
+ or $default_language eq 'ngerman')
+ {
+ &get_numberstringgerman($val,$gender);
+ }
+ else
+ {
+ &get_numberstringenglish($val);
+ }
+}
+
+sub do_cmd_numberstringnum{
+ local($_) = @_;
+ local($num,$gender);
+ $num = &missing_braces unless
+ s/$next_pair_pr_rx/$num=$2;''/eo;
+
+ if (s/\[(m|f|n)\]//)
+ {
+ $gender = $1;
+ }
+ else
+ {
+ $gender = 'm';
+ }
+
+ join('', &get_numberstring($num,$gender), $_);
+}
+
+sub do_cmd_numberstring{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+ my($gender)='m';
+
+ $_[0] =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_[0]=~s/\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ join('', '{NUMBERSTRING{', $ctr, '}}', $_[0]);
+ }
+ else
+ {
+ join('', &get_numberstring($val, $gender), $_[0]);
+ }
+}
+
+sub do_cmd_storenumberstring{
+ local($_) = @_;
+ local($key);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ local($ctr, $val, $id, $_) = &read_counter_value($_);
+ my($gender)='m';
+
+ $_ =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_ =~s/\s*\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ $fmtcntvar{$key} = join('', '{NUMBERSTRING{', $ctr, '}}');
+ }
+ else
+ {
+ $fmtcntvar{$key} = join('', &get_numberstring($val, $gender));
+ }
+
+ $_;
+}
+
+sub do_cmd_storenumberstringnum{
+ local($_) = @_;
+ local($key, $val);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ $val = &missing_braces
+ unless (s/$next_pair_pr_rx/$val=$2;''/eo);
+
+ my($gender)='m';
+
+ if ($_ =~s/\s*\[([mfn])\]//)
+ {
+ $gender = $1;
+ }
+
+ $fmtcntvar{$key} = join('', &get_numberstring($val, $gender));
+
+ $_;
+}
+
+sub get_Numberstring{
+ local($val,$gender) = @_;
+ local($string) = &get_numberstring($val,$gender);
+
+ if ($default_language=~m/german/)
+ {
+ $string =~ s/([a-z])([^\s\-]+)/\u\1\2/;
+ }
+ else
+ {
+ $string =~ s/([a-z])([^\s\-]+)/\u\1\2/g;
+
+ if ($default_language eq 'french')
+ {
+ $string =~ s/ Et / et /g;
+ }
+ elsif ($default_language eq 'spanish')
+ {
+ $string =~ s/ Y / y /g;
+ }
+ elsif ($default_language eq 'portuges')
+ {
+ $string =~ s/ E / e /g;
+ }
+ else
+ {
+ $string =~ s/ And / and /g;
+ }
+ }
+
+ $string;
+}
+
+sub do_cmd_Numberstringnum{
+ local($_) = @_;
+ local($num,$gender);
+ $num = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ if (s/\[(m|f|n)\]//)
+ {
+ $gender = $1;
+ }
+ else
+ {
+ $gender = 'm';
+ }
+
+ join('', &get_Numberstring($num,$gender), $_);
+}
+
+sub do_cmd_Numberstring{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+ my($gender)='m';
+
+ $_[0] =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_[0]=~s/\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ join('', '{NNUMBERSTRING{', $ctr, '}}', $_[0]);
+ }
+ else
+ {
+ join('', &get_Numberstring($val, $gender), $_[0]);
+ }
+}
+
+sub do_cmd_storeNumberstring{
+ local($_) = @_;
+ local($key);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ local($ctr, $val, $id, $_) = &read_counter_value($_);
+ my($gender)='m';
+
+ $_ =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_ =~s/\s*\[([mfn])\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ $fmtcntvar{$key} = join('', '{NNUMBERSTRING{', $ctr, '}}');
+ }
+ else
+ {
+ $fmtcntvar{$key} = join('', &get_Numberstring($val, $gender));
+ }
+
+ $_;
+}
+
+sub do_cmd_storeNumberstringnum{
+ local($_) = @_;
+ local($key, $val);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ $val = &missing_braces
+ unless (s/$next_pair_pr_rx/$val=$2;''/eo);
+
+ my($gender)='m';
+
+ if ($_ =~s/\s*\[([mfn])\]//)
+ {
+ $gender = $1;
+ }
+
+ $fmtcntvar{$key} = join('', &get_Numberstring($val, $gender));
+
+ $_;
+}
+
+sub do_cmd_NUMBERstringnum{
+ local($_) = @_;
+ local($num,$gender);
+ $num = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ if (s/\[(m|f|n)\]//)
+ {
+ $gender = $1;
+ }
+ else
+ {
+ $gender = 'm';
+ }
+
+ join('', uc(&get_numberstring($num,$gender)), $_);
+}
+
+sub do_cmd_NUMBERstring{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+ my($gender)='m';
+
+ $_[0] =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_[0]=~s/\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ join('', '{CAPNUMBERSTRING{', $ctr, '}}', $_);
+ }
+ else
+ {
+ join('', uc(&get_numberstring($val, $gender)), $_);
+ }
+}
+
+sub do_cmd_storeNUMBERstring{
+ local($_) = @_;
+ local($key);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ local($ctr, $val, $id, $_) = &read_counter_value($_);
+ my($gender)='m';
+
+ $_ =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_ =~s/\s*\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ $fmtcntvar{$key} = join('', '{CAPNUMBERSTRING{', $ctr, '}}');
+ }
+ else
+ {
+ $fmtcntvar{$key} = uc(&get_numberstring($val, $gender));
+ }
+
+ $_;
+}
+
+sub do_cmd_storeNUMBERstringnum{
+ local($_) = @_;
+ local($key, $val);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ $val = &missing_braces
+ unless (s/$next_pair_pr_rx/$val=$2;''/eo);
+
+ my($gender)='m';
+
+ if ($_ =~s/\s*\[([mfn])\]//)
+ {
+ $gender = $1;
+ }
+
+ $fmtcntvar{$key} = uc(&get_numberstring($val, $gender));
+
+ $_;
+}
+
+sub get_ordinalstringenglish{
+ local($num) = @_;
+ local($name)="";
+
+ unless (($num >= 1000000) || ($num < 0))
+ {
+ if ($num >= 1000)
+ {
+ local($thousands) = &get_numberstring($num/1000);
+ $name .= $thousands;
+
+ if ($num%1000 > 0)
+ {
+ $name .= " $thousandname";
+ }
+ else
+ {
+ $name .= " $thousandthname";
+ }
+
+ $num = $num%1000;
+ }
+
+ if ($num >= 100)
+ {
+ if ($_[0] >= 1000) { $name .= " "; }
+
+ local($hundreds) = &get_numberstring($num/100);
+ $name .= $hundreds;
+
+ if ($num%100 > 0)
+ {
+ $name .= " $hundredname";
+ }
+ else
+ {
+ $name .= " $hundredthname";
+ }
+
+ $num = $num%100;
+ }
+
+ if (($_[0] > 100) && ($_[0]%100 > 0)) { $name .= " and "; }
+
+ if ($num >= 20)
+ {
+ if ($num%10 > 0)
+ {
+ $name .= $tenstring[$num/10] . '-';
+ }
+ else
+ {
+ $name .= $tenthstring[$num/10];
+ }
+ }
+
+ if (($num >= 10) && ($num < 20))
+ {
+ $name .= $teenthstring[$num%10];
+ }
+ elsif (($num%10 > 0) || ($_[0] == 0))
+ {
+ $name .= $unitthstring[$num%10];
+ }
+ }
+
+ $name;
+}
+
+sub get_ordinalstringfrench{
+ local($num,$gender) = @_;
+ local($name)="";
+
+ unless (($num >= 1000000) || ($num < 0))
+ {
+ if ($num >= 1000)
+ {
+ local($thousands) = '';
+
+ if ($num >= 2000)
+ {
+ $thousands = &get_numberstringfrench($num/1000,$gender).' ';
+ }
+
+ $num = $num%1000;
+
+ if ($num > 0)
+ {
+ $name .= $thousands . $thousandnamefrench;
+ }
+ else
+ {
+ $name .= $thousands . $thousandthnamefrench;
+ }
+ }
+
+ if ($num >= 100)
+ {
+ if ($_[0] >= 1000) { $name .= " "; }
+
+ local($hundreds) = '';
+
+ if ($num >= 200)
+ {
+ $hundreds = &get_numberstringfrench($num/100,$gender).' ';
+ }
+
+ $num = $num%100;
+
+ if ($num > 0)
+ {
+ $name .= $hundreds . $hundrednamefrench;
+ }
+ else
+ {
+ $name .= $hundreds . $hundredthnamefrench;
+ }
+ }
+
+ if (($_[0] > 100) && ($_[0]%100 > 0)) { $name .= " "; }
+
+ if ($num >= 20)
+ {
+ if ($frenchdialect eq 'france' and $num >= 70)
+ {
+ if ($num < 80)
+ {
+ if ($num%10 > 0)
+ {
+ $name .= $tenstringfrench[6];
+ }
+ else
+ {
+ $name .= $tenthstringfrench[6];
+ }
+
+ if ($num%10 == 1)
+ {
+ $name .= ' et ';
+ }
+ else
+ {
+ $name .= '-';
+ }
+
+ $num = 10+($num%10);
+ }
+ else
+ {
+ $name .= 'quatre-vingt' . ($num==80?'i\`eme':'-');
+
+ if ($num >= 90)
+ {
+ $num = 10+($num%10);
+ }
+ }
+ }
+ elsif ($frenchdialect eq 'belgian' and $num >= 80)
+ {
+ $name .= 'quatre-vingt' . ($num==80?'i\`eme':'-');
+
+ if ($num >= 90)
+ {
+ $num = 10+($num%10);
+ }
+ }
+ else
+ {
+ if ($num%10 > 0)
+ {
+ $name .= $tenstringfrench[$num/10];
+ }
+ else
+ {
+ $name .= $tenthstringfrench[$num/10];
+ }
+
+ if ($num%10 == 1) { $name .= ' et ';}
+ elsif ($num%10 > 0) { $name .= '-'; }
+ }
+ }
+
+ if (($num >= 10) && ($num < 20))
+ {
+ $name .= $teenthstringfrench[$num%10];
+ }
+ elsif ($_[0] == 1)
+ {
+ $name = 'premi\`ere';
+ }
+ elsif (($num%10 > 0) || ($_[0] == 0))
+ {
+ $name .= $unitthstringfrench[$num%10];
+ }
+ }
+
+ $name;
+}
+
+sub get_ordinalstringspanish{
+ local($num,$gender) = @_;
+ local($name)="";
+ local($str);
+
+ unless (($num >= 1000000) || ($num < 0))
+ {
+ if ($num >= 1000)
+ {
+ if ($num >= 2000)
+ {
+ local($thousands) = &get_ordinalstringspanish($num/1000);
+
+ if ($gender eq 'f')
+ {
+ $thousands =~s/o(s?)$/a\1/;
+ }
+
+ $name .= $thousands. " ";
+ }
+ else
+ {
+ $name = "";
+ }
+
+ $name .= "$thousandthnamespanish";
+
+ if ($gender eq 'f')
+ {
+ $name =~s/o$/a/;
+ }
+
+ $num = $num%1000;
+ }
+
+ if ($num >= 100)
+ {
+ if ($_[0] >= 1000) { $name .= " "; }
+
+ local($hundreds) = $hundredthstringspanish[$num/100];
+
+ if ($gender eq 'f')
+ {
+ $hundreds =~s/o$/a/;
+ }
+
+ $name .= $hundreds;
+
+ $num = $num%100;
+ }
+
+ if (($_[0] > 100) && ($_[0]%100 > 0)) { $name .= " "; }
+
+ local($lastbit)="";
+
+ if ($num >= 20)
+ {
+ $lastbit = $tenthstringspanish[$num/10];
+
+ if ($num%10 > 0)
+ {
+ $lastbit .= ' ';
+ }
+
+ if ($gender eq 'f')
+ {
+ $lastbit =~s/o([ s]*)$/a\1/;
+ }
+
+ $name .= $lastbit;
+
+ $lastbit = "";
+ }
+
+ if (($num >= 10) && ($num < 20))
+ {
+ $lastbit = $teenthstringspanish[$num%10];
+ }
+ elsif (($num%10 > 0) || ($_[0] == 0))
+ {
+ $lastbit = $unitthstringspanish[$num%10];
+ }
+
+ if ($gender eq 'f')
+ {
+ $lastbit =~s/o([ s]*)$/a\1/;
+ }
+
+ $name .= $lastbit;
+ }
+
+ $name;
+}
+
+sub get_ordinalstringportuges{
+ local($num,$gender) = @_;
+ local($name)="";
+ local($str);
+
+ unless (($num >= 1000000) || ($num < 0))
+ {
+ if ($num >= 1000)
+ {
+ if ($num >= 2000)
+ {
+ local($thousands) = &get_ordinalstringportuges($num/1000);
+
+ if ($gender eq 'f')
+ {
+ $thousands =~s/o(s?)$/a\1/;
+ }
+
+ $name .= $thousands. " ";
+ }
+ else
+ {
+ $name = "";
+ }
+
+ $name .= "$thousandthnameportuges";
+
+ if ($gender eq 'f')
+ {
+ $name =~s/o$/a/;
+ }
+
+ $num = $num%1000;
+ }
+
+ if ($num >= 100)
+ {
+ if ($_[0] >= 1000) { $name .= " "; }
+
+ local($hundreds) = $hundredthstringportuges[$num/100];
+
+ if ($gender eq 'f')
+ {
+ $hundreds =~s/o$/a/;
+ }
+
+ $name .= $hundreds;
+
+ $num = $num%100;
+ }
+
+ if (($_[0] > 100) && ($_[0]%100 > 0)) { $name .= "-"; }
+
+ local($lastbit)="";
+
+ if ($num >= 10)
+ {
+ $lastbit = $tenthstringportuges[$num/10];
+
+ if ($num%10 > 0)
+ {
+ $lastbit .= '-';
+ }
+
+ if ($gender eq 'f')
+ {
+ $lastbit =~s/o([ s]*)$/a\1/;
+ }
+
+ $name .= $lastbit;
+
+ $lastbit = "";
+ }
+
+ if (($num%10 > 0) || ($_[0] == 0))
+ {
+ $lastbit = $unitthstringportuges[$num%10];
+ }
+
+ if ($gender eq 'f')
+ {
+ $lastbit =~s/o([ s]*)$/a\1/;
+ }
+
+ $name .= $lastbit;
+ }
+
+ $name;
+}
+
+sub get_numberunderhundredthgerman{
+ local($num,$gender)=@_;
+ local($name)='';
+
+ if ($num < 10)
+ {
+ if ($gender eq 'F')
+ {
+ $name = $unitthstringFgerman[$num];
+ }
+ elsif ($gender eq 'N')
+ {
+ $name = $unitthstringNgerman[$num];
+ }
+ else
+ {
+ $name = $unitthstringMgerman[$num];
+ }
+ }
+ elsif ($num%10 == 0)
+ {
+ if ($gender eq 'F')
+ {
+ $name = $tenthstringFgerman[$num/10];
+ }
+ elsif ($gender eq 'N')
+ {
+ $name = $tenthstringNgerman[$num/10];
+ }
+ else
+ {
+ $name = $tenthstringMgerman[$num/10];
+ }
+ }
+ else
+ {
+ local($tenth);
+ if ($gender eq 'F')
+ {
+ $tenth = $tenthstringFgerman[$num/10];
+ }
+ elsif ($gender eq 'N')
+ {
+ $tenth = $tenthstringNgerman[$num/10];
+ }
+ else
+ {
+ $tenth = $tenthstringMgerman[$num/10];
+ }
+
+ $name = join('und', $unitstringgerman[$num%10], $tenth);
+ }
+
+ $name;
+}
+
+sub get_ordinalstringgerman{
+ local($orgnum,$gender) = @_;
+ local($name)="";
+ local($suffix)='';
+
+ $gender = uc($gender);
+
+ if ($gender eq 'F')
+ {
+ $suffix = 'ste';
+ }
+ elsif ($gender eq 'N')
+ {
+ $suffix = 'stes';
+ }
+ else
+ {
+ $suffix = 'ster';
+ $gender = 'M';
+ }
+
+ local($num) = $orgnum;
+
+ unless (($num >= 1000000) || ($num < 0))
+ {
+ if ($num >= 1000 and $num < 2000)
+ {
+ $name = &translate_commands("\\eintausend ");
+ }
+ elsif ($num >= 2000)
+ {
+ $name = &get_numberunderhundredgerman($num/1000)
+ . "tausend";
+ }
+
+ $num = $orgnum%1000;
+
+ # is that it or is there more?
+ if ($orgnum >= 1000 and $num == 0)
+ {
+ $name .= $suffix;
+ return $name;
+ }
+
+ if ($num >= 100 and $num < 200)
+ {
+ if ($orgnum > 1000)
+ {
+ $name .= "einhundert";
+ }
+ else
+ {
+ $name = &translate_commands("\\einhundert ");
+ }
+ }
+ elsif ($num >= 200)
+ {
+ $name .= $unitstringgerman[$num/100]."hundert";
+ }
+
+ $num = $num%100;
+
+ # is that it or is there more?
+ if ($orgnum >= 100 and $num == 0)
+ {
+ $name .= $suffix;
+ return $name;
+ }
+
+ if ($orgnum == 0)
+ {
+ if ($gender eq 'F')
+ {
+ $name = $unitthstringFgerman[0];
+ }
+ elsif ($gender eq 'N')
+ {
+ $name = $unitthstringNgerman[0];
+ }
+ else
+ {
+ $name = $unitthstringMgerman[0];
+ }
+ }
+ elsif ($num > 0)
+ {
+ $name .= &get_numberunderhundredthgerman($num,$gender);
+ }
+ }
+
+ $name;
+}
+
+sub get_ordinalstring{
+ local($val,$gender) = @_;
+
+ if ($default_language eq 'french')
+ {
+ &get_ordinalstringfrench($val,$gender);
+ }
+ elsif ($default_language eq 'spanish')
+ {
+ &get_ordinalstringspanish($val,$gender);
+ }
+ elsif ($default_language eq 'portuges')
+ {
+ &get_ordinalstringportuges($val,$gender);
+ }
+ elsif ($default_language eq 'german'
+ or $default_language eq 'ngerman')
+ {
+ &get_ordinalstringgerman($val,$gender);
+ }
+ else
+ {
+ &get_ordinalstringenglish($val);
+ }
+}
+
+sub do_cmd_ordinalstringnum{
+ local($_) = @_;
+ local($num,$gender);
+ $num = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ if (s/\[(m|f|n)\]//)
+ {
+ $gender = $1;
+ }
+ else
+ {
+ $gender = 'm';
+ }
+
+ join('', &get_ordinalstring($num,$gender), $_);
+}
+
+sub do_cmd_ordinalstring{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+ my($gender)='m';
+
+ $_[0] =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_[0]=~s/\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ join('', '{ORDINALSTRING{', $ctr, '}}', $_);
+ }
+ else
+ {
+ join('', &get_ordinalstring($val, $gender), $_);
+ }
+}
+
+ %fmtcntvar = ();
+
+sub do_cmd_FMCuse{
+ local($_) = @_;
+ local($key);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ $fmtcntvar{$key}.$_;
+}
+
+sub do_cmd_storeordinalstring{
+ local($_) = @_;
+ local($key);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ local($ctr, $val, $id, $_) = &read_counter_value($_);
+ my($gender)='m';
+
+ $_ =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_ =~s/\s*\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ $fmtcntvar{$key} = join('', '{ORDINALSTRING{', $ctr, '}}');
+ }
+ else
+ {
+ $fmtcntvar{$key} = join('', &get_ordinalstring($val, $gender));
+ }
+
+ $_;
+}
+
+sub do_cmd_storeordinalstringnum{
+ local($_) = @_;
+ local($key, $val);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ $val = &missing_braces
+ unless (s/$next_pair_pr_rx/$val=$2;''/eo);
+
+ my($gender)='m';
+
+ if ($_ =~s/\s*\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ $fmtcntvar{$key} = join('', &get_ordinalstring($val, $gender));
+
+ $_;
+}
+
+sub get_Ordinalstring{
+ local($val,$gender) = @_;
+ local($string) = &get_ordinalstring($val,$gender);
+
+ if ($default_language=~m/german/)
+ {
+ $string =~ s/\b([a-z])([^\s\-]+)/\u\1\2/;
+ }
+ else
+ {
+ $string =~ s/\b([a-z])([^\s\-]+)/\u\1\2/g;
+
+ if ($default_language eq 'french')
+ {
+ $string =~ s/ Et / et /g;
+ }
+ else
+ {
+ $string =~ s/ And / and /g;
+ }
+ }
+
+ $string;
+}
+
+sub do_cmd_Ordinalstringnum{
+ local($_) = @_;
+ local($num,$gender);
+ $num = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ if (s/\[(m|f|n)\]//)
+ {
+ $gender = $1;
+ }
+ else
+ {
+ $gender = 'm';
+ }
+
+ join('', &get_Ordinalstring($num,$gender), $_);
+}
+
+sub do_cmd_Ordinalstring{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+ my($gender)='m';
+
+ $_[0] =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_[0]=~s/\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ join('', '{OORDINALSTRING{', $ctr, '}}', $_[0]);
+ }
+ else
+ {
+ join('', &get_Ordinalstring($val, $gender), $_[0]);
+ }
+}
+
+sub do_cmd_storeOrdinalstring{
+ local($_) = @_;
+ local($key);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ local($ctr, $val, $id, $_) = &read_counter_value($_);
+ my($gender)='m';
+
+ $_ =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_ =~s/\s*\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ $fmtcntvar{$key} = join('', '{OORDINALSTRING{', $ctr, '}}');
+ }
+ else
+ {
+ $fmtcntvar{$key} = join('', &get_Ordinalstring($val, $gender));
+ }
+
+ $_;
+}
+
+sub do_cmd_storeOrdinalstringnum{
+ local($_) = @_;
+ local($key, $val);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ $val = &missing_braces
+ unless (s/$next_pair_pr_rx/$val=$2;''/eo);
+
+ my($gender)='m';
+
+ if ($_ =~s/\s*\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ $fmtcntvar{$key} = join('', &get_Ordinalstring($val, $gender));
+
+ $_;
+}
+
+sub do_cmd_ORDINALstringnum{
+ local($_) = @_;
+ local($num,$gender);
+ $num = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ if (s/\[(m|f|n)\]//)
+ {
+ $gender = $1;
+ }
+ else
+ {
+ $gender = 'm';
+ }
+
+ join('', uc(&get_ordinalstring($num,$gender)), $_);
+}
+
+sub do_cmd_ORDINALstring{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+ my($gender)='m';
+
+ $_[0] =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_[0]=~s/\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ join('', '{CAPORDINALSTRING{', $ctr, '}}', $_);
+ }
+ else
+ {
+ join('', uc(&get_ordinalstring($val, $gender)), $_);
+ }
+}
+
+sub do_cmd_storeORDINALstring{
+ local($_) = @_;
+ local($key);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ local($ctr, $val, $id, $_) = &read_counter_value($_);
+ my($gender)='m';
+
+ $_ =~ s/${OP}$id${CP}$ctr${OP}$id${CP}//;
+
+ if ($_ =~s/\s*\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ if ($ctr eq 'DAY' or $ctr eq 'MONTH' or $ctr eq 'YEAR')
+ {
+ # this is a cludge to make it work with newdateformat
+ $fmtcntvar{$key} = join('', '{CAPORDINALSTRING{', $ctr, '}}');
+ }
+ else
+ {
+ $fmtcntvar{$key} = uc(&get_ordinalstring($val, $gender));
+ }
+
+ $_;
+}
+
+sub do_cmd_storeORDINALstringnum{
+ local($_) = @_;
+ local($key, $val);
+
+ $key = &missing_braces
+ unless ((s/$next_pair_pr_rx//o)&&($key=$2));
+
+ $val = &missing_braces
+ unless (s/$next_pair_pr_rx/$val=$2;''/eo);
+
+ my($gender)='m';
+
+ if ($_ =~s/\s*\[(.)\]//)
+ {
+ $gender = $1;
+ }
+
+ $fmtcntvar{$key} = uc(&get_ordinalstring($val, $gender));
+
+ $_;
+}
+
+sub do_cmd_fmtcountsetoptions{
+ local($_) = @_;
+ local($options) = &missing_braces unless ($_[0]=~(s/$next_pair_pr_rx//o)&&($options=$2));
+
+ if ($options =~ m/french=?(\w*)(,|$)/)
+ {
+ if ($1 eq 'france' or $1 eq 'swiss' or $1 eq 'belgian')
+ {
+ $frenchdialect = $1;
+
+ print "Using French dialect: $1" if ($VERBOSITY > 0) ;
+ }
+ elsif ($1 eq '')
+ {
+ $frenchdialect = 'france';
+
+ print "Using French dialect: france" if ($VERBOSITY > 0);
+ }
+ else
+ {
+ &write_warnings("unknown french dialect '$1'");
+ }
+ }
+
+ if ($options =~ m/abbrv=?(\w*)(,|$)/)
+ {
+ if ($1 eq 'true' or $1 eq '')
+ {
+ $ordinalabbrv = 1;
+
+ print "Setting abbrv=true" if ($VERBOSITY > 0);
+ }
+ elsif ($1 eq 'false')
+ {
+ $ordinalabbrv = 0;
+
+ print "Setting abbrv=false" if ($VERBOSITY > 0);
+ }
+ else
+ {
+ &write_warnings("fmtcountsetoptions key abbrv: unknown value '$1'.");
+ }
+ }
+
+ if ($options =~ m/fmtord=(\w*)(,|$)/)
+ {
+ if ($1 eq 'raise')
+ {
+ &do_fmtcount_raise();
+
+ print "Using raised ordinals" if ($VERBOSITY > 0);
+ }
+ elsif ($1 eq 'level')
+ {
+ &do_fmtcount_level();
+
+ print "Using level ordinals" if ($VERBOSITY > 0);
+ }
+ elsif ($1 eq 'user')
+ {
+ # do nothing
+
+ print "Using user defined fmtord" if ($VERBOSITY > 0);
+ }
+ else
+ {
+ &write_warnings("unknown fmtcount option fmtord=$1");
+ }
+ }
+
+ $_[0];
+}
+
+$padzeroes = 0;
+
+sub do_cmd_padzeroes{
+ local($_) = @_;
+ local($val,$pat) = &get_next_optional_argument;
+
+ if ($val eq '')
+ {
+ $padzeroes = 17;
+ }
+ else
+ {
+ $padzeroes = $val;
+ }
+
+ $_;
+}
+
+sub get_binary{
+ local($num) = @_;
+ local($val) = "";
+
+ for (my $i=17; $i>=0; $i--)
+ {
+ if (($i < $padzeroes) || ($num & (1 << $i)) || !($val eq ""))
+ {
+ $val .= ($num & (1 << $i) ? 1 : 0);
+ }
+ }
+
+ $val;
+}
+
+sub do_cmd_binary{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+
+ join('', &get_binary($val), $_);
+}
+
+sub do_cmd_binarynum{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ join('', &get_binary($num), $_);
+}
+
+sub get_decimal{
+ local($num) = @_;
+
+ sprintf "%0${padzeroes}d", $num;
+}
+
+sub do_cmd_decimal{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+
+ join('', &get_decimal($val), $_);
+}
+
+sub do_cmd_decimalnum{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ join('', &get_decimal($num), $_);
+}
+
+sub get_hexadecimal{
+ local($num) = @_;
+
+ sprintf "%0${padzeroes}lx", $num;
+}
+
+sub do_cmd_hexadecimal{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+
+ join('', &get_hexadecimal($val), $_);
+}
+
+sub do_cmd_hexadecimalnum{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ join('', &get_hexadecimal($num), $_);
+}
+
+sub get_Hexadecimal{
+ local($num) = @_;
+
+ sprintf "%0${padzeroes}lX", $num;
+}
+
+sub do_cmd_Hexadecimal{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+
+ join('', &get_Hexadecimal($val), $_);
+}
+
+sub do_cmd_Hexadecimalnum{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ join('', &get_Hexadecimal($num), $_);
+}
+
+sub get_octal{
+ local($num) = @_;
+
+ sprintf "%0${padzeroes}lo", $num;
+}
+
+sub do_cmd_octal{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+
+ join('', &get_octal($val), $_);
+}
+
+sub do_cmd_octalnum{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ join('', &get_octal($num), $_);
+}
+
+sub get_aaalph{
+ local($num) = @_;
+ local($rep) = int($num/26) + 1;
+ local($c) = chr(ord('a')-1+$num%26);
+
+ local($_) = $c x $rep;
+}
+
+sub do_cmd_aaalph{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+
+ join('', &get_aaalph($val), $_);
+}
+
+sub get_AAAlph{
+ local($num) = @_;
+ local($rep) = int($num/26) + 1;
+ local($c) = chr(ord('A')-1+$num%26);
+
+ local($_) = $c x $rep;
+}
+
+sub do_cmd_AAAlph{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+
+ join('', &get_AAAlph($val), $_);
+}
+
+sub do_cmd_aaalphnum{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ join('', (sprintf "%${padzeroes}s", &get_aaalph($num)), $_);
+}
+
+sub do_cmd_AAAlphnum{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ join('', uc(sprintf "%${padzeroes}s", &get_aaalph($num)), $_);
+}
+
+sub get_abalph{
+ local($num) = @_;
+ local($str);
+
+ if ($num == 0)
+ {
+ $str = '';
+ }
+ elsif ($num > 0 && $num <= 26)
+ {
+ $str = chr(ord('a')-1+$num);
+ }
+ else
+ {
+ $str = &get_abalph(int($num/26)) . chr(ord('a')-1+($num%26));
+ }
+
+ $str;
+}
+
+sub do_cmd_abalph{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+
+ join('', (sprintf "%${padzeroes}s", &get_abalph($val)), $_);
+}
+
+sub do_cmd_abalphnum{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ join('', (sprintf "%${padzeroes}s", &get_abalph($num)), $_);
+}
+
+sub do_cmd_ABAlph{
+ local($ctr, $val, $id, $_) = &read_counter_value($_[0]);
+
+ join('', uc(sprintf "%${padzeroes}s", &get_abalph($val)), $_);
+}
+
+sub do_cmd_ABAlphnum{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ join('', uc(sprintf "%${padzeroes}s", &get_abalph($num)), $_);
+}
+
+sub get_twodigit{
+ local($num) = @_;
+
+ sprintf "%02d", $num;
+}
+
+sub do_cmd_twodigit{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ # this is a cludge
+ if ($num eq "THEDAY" or $num eq "THEYEAR" or $num eq "THEMONTH")
+ {
+ join('', 'TWODIGIT{', $num, '}', $_);
+ }
+ else
+ {
+ join('', &get_twodigit($num), $_);
+ }
+}
+
+# this was put here to help with the definition of \datelatin
+
+sub do_cmd_romannumeral{
+ local($_) = @_;
+ local($num) = &missing_braces
+ unless (s/$next_pair_pr_rx/$num=$2;''/eo);
+
+ # this is a cludge
+ if ($num eq "THEDAY" or $num eq "THEYEAR" or $num eq "THEMONTH")
+ {
+ join('', 'ROMANNUMERAL{', $num, '}', $_);
+ }
+ else
+ {
+ join('', &froman($num), $_);
+ }
+}
+
+# load configuration file if it exists
+# Note: The configuration file should be loaded before
+# the package options are executed.
+
+# why doesn't this work? If I call this subroutine it
+# causes an infinite loop.
+
+sub load_fmtcount_cfg{
+ local($file,$found);
+
+ $file = &fulltexpath('fmtcount.cfg');
+
+ $found = (-f $file);
+
+ if (!$found)
+ {
+ foreach $texpath (split /$envkey/, $TEXINPUTS)
+ {
+ $file = "$texpath${dd}fmtcount.cfg";
+
+ last if ($found = (-f $file));
+ }
+ }
+
+ if ($found)
+ {
+ print "\nusing configuration file $file\n";
+
+ &slurp_input($file);
+ &pre_process;
+ &substitute_meta_cmds if (%new_command || %new_environment);
+ &wrap_shorthand_environments;
+ $_ = &translate_commands(&translate_environments($_));
+
+ print "\n processed size: ".length($_)."\n" if ($VERBOSITY>1)
+ }
+ else
+ {
+ print "\nNo configuation file fmtcount.cfg found\n" if ($VERBOSITY>1)
+ }
+}
+
+1;
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-20 13:36:10 +0000