#! /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)
----------------------------------------- */