#!/usr/bin/perl -w

# nombre.pl : écriture de nombres en toutes lettres
# en français. Les très grands nombres sont exprimés
# dans le système proposé par John Horton Conway et Richard K. Guy
# dans "The Book of Numbers" (Springer Verlag, 1996).

# nombre.pl -help pour le mode d'emploi

# (C) 2001-2003 Nicolas Graner
# Référence : http://graner.name/nicolas/nombres/

# version 1.1 - avril 2003
# préservation du pluriel de cent et vingt devant les substantifs.
# Exemple : deux cents millions au lieu de deux cent millions

# version 1.0 - janvier 2001
# première version publique

$usage = "Usage :
$0 [+|-]N
      affiche le nombre N en toutes lettres
$0 -e N
      affiche 10**N en toutes lettres
$0 -z N
      affiche 10**(6*N) c'est-à-dire le N-ème nombre en \"...illion\"
$0 N1 N2
      affiche en toutes lettres tous les nombres de N1 à N2 inclus
$0
      recopie l'entrée standard en remplaçant tous les nombres
      écrits en chiffres par leur équivalent en lettres
$0 -h
      affiche ce message d'aide
";

use integer ;

sub centaines {
    # renvoie le début du nom de $n jusqu'au mot cent inclus,
    # pour 100 <= $n < 1000
    my($n) = @_;

    ($n < 200) ?
        'cent' :
         $base[$n/100] . ' cent' . ($n%100 == 0 ? 's' : '') ;
}

sub milliers {
    # renvoie le début du nom de $n jusqu'au mot mille inclus,
    # pour 1000 <= $n < 1000000
    my($n) = @_;

    ($n < 2000) ?
        'mille' :
        petit_nombre($n/1000) . ' mille' ;
}

sub petit_nombre {
    # renvoie le nom "brut" de $n pour 0 < $n < 1000000
    my($n) = @_;

    return $base[$n]
        if ( $n < 100 ) ;
    my($nom) = ($n < 1000) ?
        centaines($n) . ' ' . $base[$n % 100] :
        milliers($n) . ' ' . petit_nombre($n % 1000) ;
    # enlève les s indésirables
    $nom =~ s/(cent|vingt)s(.*\S)/$1$2/g ;
    return($nom);
}

sub zillion_prefixe {
    # renvoie le nom de 10^(6*$p) (terminé par illi) pour $p < 1000
    my($p) = @_;

    return $petit_zillion[$p] . 'illi'
        if $p < 10 ;
    return $unites_zillions[$p%10]
           . $dizaines_zillions[($p/10)%10]
           . $centaines_zillions[$p/100]
           . 'illi' ;
}

sub zillion {
    # renvoie le nom "brut" de 10^(6*$p) pour $p chaine de chiffres quelconque.
    # Ajoute un 's' à la fin si $m > 1.

    my($p,$m) = @_;
    my($d,$z);

    return '' if $p =~ /^0+$/ ;

    for ( $z = '' ; ($d,$p) = ($p =~ /^(.{1,3})((...)*)$/) ; ) {
        $z .= zillion_prefixe($d) ;
    }
    return $z . ($m > 1 ? 'ons' : 'on');
}

sub retouche {
    # $nom est un nom de nombre "brut". Effectue un nettoyage
    # syntaxique pour en faire un nom correct.
    my($nom) = @_;

    # enlève les blancs surnuméraires
    $nom =~ s/(^\s+|\s+$)//g ;
    $nom =~ s/\s{2,}/ /g ;
    # applique les règles d'assimilation aux préfixes latins :
    # si on trouve une lettre deux fois entre < > on la garde,
    # sinon on efface tout ce qui est entre < >.
    # S'il y a plusieurs lettres dans ce cas, on garde la première.
    $nom =~ s/><//g ;
    $nom =~ s/<\w*?(\w)\w*\1\w*>/$1/g ;
    $nom =~ s/<\w*>//g ;
    # enlève la voyelle finale des préfixes
    $nom =~ s/[aei]illi/illi/g ;

    return $nom ;
}

sub nombre {
    # $n est une chaine de chiffres quelconque ne contenant pas que des 0.
    # Renvoie le nom exact du nombre correspondant.
    my($n) = @_;
    my($d,$s,$tranches);

    for ( $s = '', $tranches = (length($n)-1) / 6 ;
          ($d,$n) = ($n =~ /^(.{1,6})((......)*)$/) ;
          $tranches-- ) {
        $s .= ' '.petit_nombre($d).' '.zillion($tranches,$d)
            unless $d == 0;
    }
    return retouche($s) ;
}

sub nombre_signe {
    # Renvoie le nom du nombre $n.
    # $n doit être de la forme ^[+-]?\d+$
    my($n) = @_;

    return( 'zero' )              if $n =~ /^[+-]?0+$/ ;
    return( 'plus '.nombre($') )  if $n =~ /^\+0*/ ;
    return( 'moins '.nombre($') ) if $n =~ /^-0*/ ;
    return( nombre($') )          if $n =~ /^0*/ ;
}

############################################################


# noms des nombres inférieurs à 100
@base = ('', 'un', 'deux', 'trois', 'quatre', 'cinq', 'six',
         'sept', 'huit', 'neuf', 'dix', 'onze', 'douze', 'treize',
         'quatorze', 'quinze', 'seize', 'dix-sept', 'dix-huit',
         'dix-neuf', 'vingt', 'vingt et un', 'vingt-deux',
         'vingt-trois', 'vingt-quatre', 'vingt-cinq', 'vingt-six',
         'vingt-sept', 'vingt-huit', 'vingt-neuf', 'trente',
         'trente et un', 'trente-deux', 'trente-trois',
         'trente-quatre', 'trente-cinq', 'trente-six', 'trente-sept',
         'trente-huit', 'trente-neuf', 'quarante', 'quarante et un',
         'quarante-deux', 'quarante-trois', 'quarante-quatre',
         'quarante-cinq', 'quarante-six', 'quarante-sept',
         'quarante-huit', 'quarante-neuf', 'cinquante',
         'cinquante et un', 'cinquante-deux', 'cinquante-trois',
         'cinquante-quatre', 'cinquante-cinq', 'cinquante-six',
         'cinquante-sept', 'cinquante-huit', 'cinquante-neuf',
         'soixante', 'soixante et un', 'soixante-deux',
         'soixante-trois', 'soixante-quatre', 'soixante-cinq',
         'soixante-six', 'soixante-sept', 'soixante-huit',
         'soixante-neuf', 'soixante-dix', 'soixante et onze',
         'soixante-douze', 'soixante-treize', 'soixante-quatorze',
         'soixante-quinze', 'soixante-seize', 'soixante-dix-sept',
         'soixante-dix-huit', 'soixante-dix-neuf', 'quatre-vingts',
         'quatre-vingt-un', 'quatre-vingt-deux', 'quatre-vingt-trois',
         'quatre-vingt-quatre', 'quatre-vingt-cinq',
         'quatre-vingt-six', 'quatre-vingt-sept', 'quatre-vingt-huit',
         'quatre-vingt-neuf', 'quatre-vingt-dix', 'quatre-vingt-onze',
         'quatre-vingt-douze', 'quatre-vingt-treize',
         'quatre-vingt-quatorze', 'quatre-vingt-quinze',
         'quatre-vingt-seize', 'quatre-vingt-dix-sept',
         'quatre-vingt-dix-huit', 'quatre-vingt-dix-neuf', );

## préfixes des zillions d'après Conway & Guy
@petit_zillion = ('n', 'm', 'b', 'tr', 'quatr', 'quint',
                  'sext', 'sept', 'oct', 'non');

# la marque de 'se' doit être 'xs' pour que ce soit le x
# qui l'emporte quand il y a le choix entre x et s.
@unites_zillions = ('<', 'un<', 'duo<', 'tre<s', 'quattuor<',
                    'quinqua<', 'se<xs', 'septe<nm', 'octo<',
                    'nove<nm');

@dizaines_zillions = ('><', 'n>déci<', 'ms>viginti<', 'ns>triginta<',
                      'ns>quadraginta<', 'ns>quinquaginta<',
                      'n>sexaginta<', 'n>septuaginta<', 'mxs>octoginta<',
                      '>nonaginta<');

@centaines_zillions = ('>', 'nxs>cent', 'n>ducent', 'ns>trecent',
                       'ns>quadringent', 'ns>quingent',
                       'n>sescent', 'n>septingent', 'mxs>octingent',
                       '>nongent');

############################################################

sub divise_par_6 {
    # $n est une chaine de chiffres.
    # Renvoie deux chaines représentant le quotient et le reste de la
    # division de ce nombre par 6.
    my($n) = @_;
    my($q,$r,$c) = ('',0);

    while ( ($c,$n) = ($n =~ /^(.{1,8})(.*)$/) ) {
        $r = 10**length($c)*$r + $c;
        $q .= sprintf "%0".length($c)."d", $r/6;
        $r %= 6;
    }
    $q =~ s/^0+(.)/$1/; # enleve les 0 initiaux, sans faire une chaine vide
    return ($q,$r);
}

sub affiche_stdin {
    while(<>) {
        s/[+-]?\d+/nombre_signe($&)/eg ;
        print ;
    }
}

sub affiche_n {
    my($n) = @_;
    print nombre_signe($n), "\n";
}

sub affiche_10_n {
    my($n) = @_;
    my($q,$r) = divise_par_6($n);
    print retouche(nombre('1'.'0'x$r) . ' ' . zillion($q,$r+1)), "\n";
}

sub affiche_10_6n {
    my($n) = @_;
    print retouche('un '.zillion($n,1)), "\n";
}

sub affiche_intervalle {
    my($min,$max) = @_;
    # ramène les deux chaines à la même longueur pour que l'ordre
    # lexicographique corresponde à l'ordre numérique.
    my($diff) = length($max) - length($min) ;
    my($i);
    $min = '0' x  $diff . "$min"
	if $diff > 0 ;
    $max = '0' x -$diff . "$max"
	if $diff < 0 ;
    # Ajoute un zéro de plus pour éviter certains débordements.
    for ( $i = "0$min" ; $i le "0$max" ; $i++ ) { # incrément "magique"
        # appelle nombre_signe au lieu de nombre, pour le cas ou $min == 0
        print nombre_signe($i), "\n";
    }
}

# Traitement des arguments

affiche_stdin, exit
    if $#ARGV == -1;
affiche_n($ARGV[0]), exit
    if $#ARGV == 0 && $ARGV[0] =~ /^[+-]?\d+$/;
affiche_10_n($ARGV[1]), exit
    if $#ARGV == 1 && $ARGV[0] eq '-e' && $ARGV[1] =~ /^\d+$/;
affiche_10_6n($ARGV[1]), exit
    if $#ARGV == 1 && $ARGV[0] eq '-z' && $ARGV[1] =~ /^\d+$/;
affiche_intervalle($ARGV[0],$ARGV[1]), exit
    if $#ARGV == 1 && $ARGV[0] =~ /^\d+$/ && $ARGV[1] =~ /^\d+$/;
print($usage), exit
    if $#ARGV == 0 && $ARGV[0] =~ /^-+h/; # accepte aussi -help --help etc.

die "Argument incorrect. Faites \"$0 -h\" pour avoir de l'aide.\n";