#! /usr/bin/rexx
/* - Pour les systemes UNIX ou Gnu/LINUX, verifier et adapter la        */
/* premiere ligne ci-dessus ; pour les autres : la retirer              */
/* - For Unix and Gnu/Linux, check and adapt the first line above. For  */
/* others you can delete it                                             */
/* ******************************************                           */
/* DGNUMF - CONVERTISSEUR NOMBRES-MOTS                                  */
/* version 0.9.999 du 2005-06-03                                        */
/* Copyright 2002 Dominique Guebey                                      */
/* http://www.dg77.net                                                  */
/* COMMENTAIRES SUPPLEMENTAIRES : voir en fin de listing                */
/* MORE COMMENTS : see at the bottom                                    */
/* ******************************************                           */
/* INITIALISATIONS */
SIGNAL ON ERROR  NAME err
SIGNAL ON HALT NAME err
SIGNAL ON SYNTAX NAME err
/* test/demo/appel depuis la console */
PARSE UPPER PULL num param1 param2 param3 .
/* AS400 : appel de ce programme avec passage d'arguments */
/* PARSE UPPER ARG num param1 param2 param3 . */
/* ---------------------------------- */
phrase = ""
sign = "plus"
flagm = ""
flagu = ""
flagt = ""
/* ------------------------------------- */
/* gerer le signe			*/
SELECT
	WHEN num < 0 THEN DO
		phrase = "MOINS"
		signe = "-"
		m = num * -1 ; num = m
		END
	OTHERWISE phrase = ""
END
/* ------------------------------------- */
/* conserver les decimales		*/
dec = 0
calc = TRUNC(num, 0)
xdec = num - calc
/* entiers = num - dec */
PARSE VAR num entiers '.' dec
IF entiers == 0 THEN DO
	zon = phrase "ZERO" ; phrase = zon
	END
/* ------------------------------------- */
call traite
/* PLURIEL ***************************** */
IF num >= 2 THEN plur = "X"
/* ------------------------------------- */
/* Mettre l'unite s'il y a lieu  (4e argument) */
IF param3 \== "" & param3 \== 'param3' & plur == "X" THEN DO
/* ne rien faire pour mot termine par "s" ou "x" */
lz = LENGTH(param3)
/* mot > 1 car et fini par "al" */
IF lz > 1 & SUBSTR(param3,(lz-1),2) == "AL" THEN DO
	IF param3 \== 'AVAL' & param3 \== 'BAL' & param3 \== 'CARACAL' & ,
	param3 \== 'CARNAVAL' & param3 \== 'CEREMONIAL' & param3 \== 'CHACAL' & ,
	param3 \== 'CHORAL' & param3 \== 'COPAL' & param3 \== 'FESTIVAL' & ,
	param3 \== 'FINAL' & param3 \== 'GAVIAL' & param3 \== 'MISTRAL' & ,
	param3 \== 'NARVAL' & param3 \== 'NAVAL' & param3 \== 'NOPAL' & ,
	param3 \== 'PAL' & param3 \== 'RECITAL' & param3 \== 'REGAL' & ,
	param3 \== 'RORQUAL' & param3 \== 'SERVAL' & param3 \== 'SISAL' THEN DO
		ztrav = SUBSTR(param3,1,(lz-1)) || 'UX' ; param3 = ztrav
		END
		ELSE DO
		/* on met simplement "s" a la fin */
		zon = param3 || 'S' ; param3 = zon
		END
	END

/* mot > 2 car et fini par "ail" */
IF lz > 2 & SUBSTR(param3,(lz-2),3) == "AIL" THEN DO
       IF param3 \== 'ATTIRAIL' & param3 \== 'BERCAIL' & param3 \== 'CAMAIL' & ,
       param3 \== 'CHANDAIL' & param3 \== 'DETAIL' & param3 \== 'EPOUVANTAIL' & ,
       param3 \== 'EVENTAIL' & param3 \== 'GOUVERNAIL' & param3 \== 'MAIL' & ,
       param3 \== 'PORTAIL' & param3 \== 'RAIL' & param3 \== 'SERAIL' THEN DO
	       ztrav = SUBSTR(param3,1,(lz-2)) || 'UX' ; param3 = ztrav
	       END
	       ELSE DO
		/* on met simplement "s" a la fin */
		zon = param3 || 'S' ; param3 = zon
		END
	END

/* mot > 2 car et fini par "ou" */
IF lz > 2 & SUBSTR(param3,(lz-1),2) == "OU" THEN DO
       IF param3 \== 'BIJOU' & param3 \== 'CAILLOU' & param3 \== 'CHOU' & ,
       param3 \== 'GENOU' & param3 \== 'HIBOU' & param3 \== 'JOUJOU' & , 
       & param3 \== 'POU' THEN DO
		zon = param3 || 'S' ; param3 = zon
	       END
	       ELSE DO
		/* "x" a la fin */
		zon = param3 || 'X' ; param3 = zon
		END
	END

/* cas general */
lz = LENGTH(param3)
IF SUBSTR(param3,lz,1) \== 's' & SUBSTR(param3,lz,1) \== 'S' ,
& SUBSTR(param3,lz,1) \== 'x' & SUBSTR(param3,lz,1) \== 'X' THEN DO
		zon = param3 || 'S' ; param3 = zon
		END
END
zon = phrase param3 ; phrase = zon
/* ------------------------------------- */
/* traiter les decimales			*/
IF dec > 0 THEN DO
IF param3 == "" THEN DO
	param3 = "VIRGULE"
	zon = phrase param3 ; phrase = zon
	END
/* "ZERO..." initiaux */
mult = 1
DO UNTIL ndec = 0
	mult = mult * 10
	calc = xdec * mult
	edec = TRUNC(calc, 0)
	IF edec == 0 THEN DO
		zon = phrase "ZERO" ; phrase = zon
		END
	ndec = calc - edec
	END
/* num = calc */
num = dec
/* ------------------------------------- */
call traite
END
/* ------------------------------------- */
/* SORTIE : cf aussi fin "err" */
sortie:
/* AS400 */
/* 'CHGDTAARA DTAARA(*LDA (201 328)) VALUE('''phrase''')' */
/* EXIT */
/* standard : */
say phrase
pull
RETURN phrase
/* ************************************** */
/* TRAITE : separe le nombre en groupes de */
/* 3 chiffres, appelle TRANSF pour chacun */
traite:
/* limitation a 999 999 999 999		*/
IF num > 999999999999 THEN DO
	calc = num/1000000000000
	calc2 = TRUNC(calc, 0)
	calc3 = calc2 * 1000000000000
	calc2 = num - calc3
	num = calc2
	END
/* ------------------------------------- */
/* traiter les milliards			*/
IF num > 999999999 THEN DO
	calc = num/1000000000
	m9 = TRUNC(calc, 0) ; n = m9
	cal9 = m9 * 1000000000 ; calc2 = num - cal9
	num = calc2
	IF n > 0 THEN DO
		flagm = " "
		CALL TRANSF
		flagm = " "
		IF n == 1 THEN mot = "MILLIARD"
			ELSE mot = "MILLIARDS"
		zon = phrase mot ; phrase = zon
		END
	END
/* ------------------------------------- */
/* traiter les millions				*/
IF num > 999999 THEN DO
	calc = num/1000000
	m9 = TRUNC(calc, 0) ; n = m9
	cal9 = m9 * 1000000 ; calc2 = num - cal9
	num = calc2
	IF n > 0 THEN DO
		flagm = " "
		CALL TRANSF
		flagm = " "
		IF n == 1 THEN mot = "MILLION"
			ELSE mot = "MILLIONS"
		zon = phrase mot ; phrase = zon
		END
	END
/* ------------------------------------- */
/* traiter les milliers				*/
IF num > 999 THEN DO
	calc = num/1000
	m9 = TRUNC(calc, 0) ; n = m9
	cal9 = m9 * 1000 ; calc2 = num - cal9
	num = calc2
	IF n > 0 THEN DO
		flagm = "X"
		CALL TRANSF
		flagm = " "
		mot = "MILLE"
		zon = phrase mot ; phrase = zon
		END
	END
/* ------------------------------------- */
/* traiter les unites				*/
IF num > 0 THEN DO
	calc = num
	m9 = TRUNC(calc, 0) ; n = m9
	cal9 = m9 ; calc2 = num - cal9
	num = calc2
	IF n > 0 THEN DO
		flagu = "X"
		CALL TRANSF
		flagu = ""
		END
	END
RETURN
/* ************************************** */
/* TRANSF : separe centaines (c) dizaines (d) unites(u) */
/* d'un nombre de trois chiffres, puis effectue la  */
/* conversion en mots */
transf:
calc = n/100
c = TRUNC(calc, 0)
cent = c * 100
diz = n - cent
calc = diz/10
d = TRUNC(calc, 0)
calc = d*10
u = diz-calc

/* CENTAINES					   */
mot = " "
SELECT
	WHEN c == 2 THEN mot = "DEUX"
	WHEN c == 3 THEN mot = "TROIS"
	WHEN c == 4 THEN mot = "QUATRE"
	WHEN c == 5 THEN mot = "CINQ"
	WHEN c == 6 THEN mot = "SIX"
	WHEN c == 7 THEN mot = "SEPT"
	WHEN c == 8 THEN mot = "HUIT"
	WHEN c == 9 THEN mot = "NEUF"
	OTHERWISE
END
IF mot \== " " THEN DO
	zon = phrase mot ; phrase = zon
	END
mot = " "
IF c = 1 THEN mot = "CENT"
IF c > 1 THEN
	DO
	testot = d + u
	IF testot = 0 THEN mot = "CENTS"
		ELSE mot = "CENT"
	END
IF mot \== " " THEN DO
	zon = phrase mot ; phrase = zon
	END

/* DIZAINES				   */
mot = " "
SELECT
	WHEN d == 1 THEN IF u == 0 THEN mot = "DIX"
	WHEN d == 2 THEN mot = "VINGT"
	WHEN d == 3 THEN mot = "TRENTE"
	WHEN d == 4 THEN mot = "QUARANTE"
	WHEN d == 5 THEN mot = "CINQUANTE"
	WHEN d == 6 THEN mot = "SOIXANTE"
	WHEN d == 7 THEN IF param1 == "b" | param1 == "B" THEN mot = "SEPTANTE"
				ELSE mot = "SOIXANTE"
	WHEN d == 8 THEN DO
				IF u == 0 THEN mot = "QUATRE-VINGTS"
				ELSE mot = "QUATRE-VINGT"
				flagt = 'z'
				END
	WHEN d == 9 THEN  DO
			IF param1 == "b" | param1 == "B" THEN mot = "NONANTE"
			ELSE mot = "QUATRE-VINGT"
			flagt = 't'
			END
	OTHERWISE
END
IF mot \== " " THEN DO
	zon = phrase mot ; phrase = zon
	END

/* UNITES				     */
mot = " "
SELECT
WHEN u == 0 THEN SELECT
/*		WHEN d == 1 THEN mot = "DIX" */
WHEN d == 7 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "DIX"
WHEN d == 9 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "DIX"
	OTHERWISE
END
WHEN u == 1 THEN DO
	zun = "UN"
IF flagu = "X" & param2 == "f" | flagu = "X" & param2 == "F" THEN zun = "UNE"
	SELECT
	WHEN d == 0 & c > 0 & flagm == "X" THEN mot = zun
	WHEN d == 0 THEN if flagm \== "X" THEN mot = zun
	WHEN d == 8 THEN mot = zun
	WHEN d == 1 THEN mot = "ONZE"
	WHEN d == 7 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "ET ONZE"
		ELSE mot = "ET" zun
	WHEN d == 9 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "ONZE"
		ELSE mot = "ET" zun
	OTHERWISE mot = "ET" zun
	END
	END
WHEN u == 2 THEN SELECT
	WHEN d == 1 THEN mot = "DOUZE"
	WHEN d == 7 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "DOUZE"
					ELSE mot = "DEUX"
	WHEN d == 9 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "DOUZE"
					ELSE mot = "DEUX"
	OTHERWISE mot = "DEUX"
	END
WHEN u == 3 THEN SELECT
	WHEN d == 1 THEN mot = "TREIZE"
	WHEN d == 7 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "TREIZE"
					ELSE mot = "TROIS"
	WHEN d == 9 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "TREIZE"
					ELSE mot = "TROIS"
	OTHERWISE mot = "TROIS"
	END
WHEN u == 4 THEN SELECT
	WHEN d == 1 THEN mot = "QUATORZE"
WHEN d == 7 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "QUATORZE"
				ELSE mot = "QUATRE"
WHEN d == 9 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "QUATORZE"
				ELSE mot = "QUATRE"
	OTHERWISE mot = "QUATRE"
	END
WHEN u == 5 THEN SELECT
	WHEN d == 1 THEN mot = "QUINZE"
	WHEN d == 7 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "QUINZE"
			ELSE mot = "CINQ"
	WHEN d == 9 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "QUINZE"
			ELSE mot = "CINQ"
		OTHERWISE mot = "CINQ"
		END
WHEN u == 6 THEN SELECT
	WHEN d == 1 THEN mot = "SEIZE"
	WHEN d == 7 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "SEIZE"
			ELSE mot = "SIX"
	WHEN d == 9 THEN IF param1 \== "b" & param1 \== "B" THEN mot = "SEIZE"
		ELSE mot = "SIX"
	OTHERWISE mot = "SIX"
	END
	WHEN u == 7 THEN SELECT
		WHEN d == 1 THEN mot = "DIX SEPT"
		WHEN d == 7 THEN IF param1 \== "b" & param1 \== "B" THEN DO
					IF flagt == 't' THEN mot = "DIX-SEPT"
							ELSE mot = "DIX SEPT"
							END
					ELSE mot = "SEPT"
		WHEN d == 9 THEN IF param1 \== "b" & param1 \== "B"  THEN DO
					IF flagt == 't' THEN mot = "DIX-SEPT"
							ELSE mot = "DIX SEPT"
							END
					ELSE mot = "SEPT"
		OTHERWISE mot = "SEPT"
		END
	WHEN u == 8 THEN SELECT
		WHEN d == 1 THEN mot = "DIX HUIT"
		WHEN d == 7 THEN IF param1 \== "b" & param1 \== "B"  THEN DO
					IF flagt == 't' THEN mot = "DIX-HUIT"
							ELSE mot = "DIX HUIT"
							END
					ELSE mot = "HUIT"
		WHEN d == 9 THEN IF param1 \== "b" & param1 \== "B" THEN DO
					IF flagt == 't' THEN mot = "DIX-HUIT"
							ELSE mot = "DIX HUIT"
							ENd
					ELSE mot = "HUIT"
		OTHERWISE mot = "HUIT"
		END
	WHEN u == 9 THEN SELECT
		WHEN d == 1 THEN mot = "DIX NEUF"
		WHEN d == 7 THEN IF param1 \== "b" & param1 \== "B"  THEN DO
					IF flagt == 't' THEN mot = "DIX-NEUF"
							ELSE mot = "DIX HUIT"
							END
					ELSE mot = "NEUF"
		WHEN d == 9 THEN IF param1 \== "b" & param1 \== "B"  THEN DO
					IF flagt == 't' THEN mot = "DIX-NEUF"
							ELSE mot = "DIX HUIT"
							END
					ELSE mot = "NEUF"
		OTHERWISE mot = "NEUF"
		END
	OTHERWISE
	END
IF mot \== " " THEN DO
	IF flagt \== 't' THEN DO
	zon = phrase mot
	END
	ELSE DO
	zon = phrase || '-' || mot
	END
phrase = zon
flagt = ''
END
RETURN
/* *********************************** */
err:
phrase = num
/* AS400 */
/* 'CHGDTAARA DTAARA(*LDA (201 328)) VALUE('''phrase''')' */
/* EXIT */
/* standard : */
say phrase
pull
RETURN phrase
/* ********************************************************************
   Variables : 
   flagt : pour mettre le tiret au lieu d'espace si "quatre-vingt..."
   flagm : pour omettre le "un" devant "mille" si c'est ..001000
   flagu : pour savoir si "un" a la fin du groupe (..11, ou ..81 etc...
   plur  : gerer le pluriel                                             */
/* ********************************************************************
                           *** DGNUMF ***
   Ce programme a pour fonction la conversion d'un nombre en              
   une proposition en francais. Voir exemples plus bas                    
   ******************************************                             
   CONDITIONS D'UTILISATION                                               
   Ce programme est offert sans aucune garantie de fonctionnement.        
   Ce programme est librement utilisable, modifiable et diffusable,       
   meme contre paiement, sous la condition que les memes termes seront    
   applicables a la version ainsi distribuee.                             
   ******************************************                             
   PARTICULARITES : language REXX, utilisation des fonctions              
   integrees LENGTH, SUBSTR et TRUNC.                                     
   La presente version s'applique a des nombres limites a :               
   - 9 chiffres pour les entiers ;                                        
   - 8 chiffres pour les nombres negatifs ou avec decimales ;             
   - 7 chiffres pour les nombres negatifs et avec decimales.              
   Pour des longeurs superieures, le comportement peut varier selon       
   l'interpreteur utilise.                                                
   ******************************************                             
   PARAMETRES :                                                           
   0- "num" : nombre a traiter.                                           
   1- "param1" : "b" si belgo-suisse ("septante..."), sinon tout autre    
   caractere ; facultatif si parametres suivants non utilises.            
   2- "param2" : "f" si feminin ("une"), sinon tout autre caractere ;     
   facultatif si parametre suivant non utilise.                           
   3- "param3" : unite facultative ("EURO", "KILO", "BANANE"), a defaut   
   le mot "VIRGULE" sera insere s'il y a lieu entre les unites et         
   decimales.                                                             
   ******************************************                             
   EXEMPLES                                                               
        19.5 -> "DIX NEUF VIRGULE CINQ"                                   
        19.50 x x EURO -> "DIX NEUF EUROS CINQUANTE"                      
        91 b f BANANE -> "NONANTE ET UNE BANANES"                         
        93 x x CHEVAL -> "QUATRE-VINGT-TREIZE CHEVAUX"                    
        93 x x CHACAL -> "QUATRE-VINGT-TREIZE CHACALS"                    
        -101101 x f -> "MOINS CENT UN MILLE CENT UNE"                     
   ******************************************                             
   VERSION 0.9.0 : 2002-05-09                                             
   VERSION 0.9.9 : 2002-06-01                                             
   - optimisation : traitement commun partie entiere/partie decimale.     
   - nombres en quatre-vingt : separation par tirets et non pas espaces   
   - gestion amelioree du pluriel de l'unite :                            
        - correction : pas de "s" ajoute si deja s ou x a la fin de       
        l'unite                                                           
        - test ameliore (mots en al et ail...)                            
        - plus besoin du 4eme parametre                                   
   VERSION 0.9.99 : 2002-10-04                                            
   - en cas d'erreur, retourne la valeur entree et non pas null.          
   - largeur des lignes limitee a 80 caracteres (facilite sur AS400)      
   VERSION 0.9.999 : 2005-05-27                                           
   - pluriels ameliores (ou...)                                           
   ******************************************                             
   Reste a voir / TODO :                                                  
   - Gerer les nombres tres longs                                         
   - Cas des unites de mesure                                             
   - Nombres ordinaux (premier...)                                        
   - Gestion de la casse (minuscules/majuscules)                          
   -----------------------------------------                            */