/* (gH) -_- REXXUT.rex ; TimeStamp (unix) : 08 Décembre 2006 vers 11:02 */ /* */ /******************************************************************************/ /* */ /* */ /* */ /* Fichier : REXXUT.rex v-2.6 */ /* */ /* */ /* Gilles.HUNAULT@univ-angers.fr */ /* http://www.info.univ-angers.fr/~gh/ */ /* */ /* */ /* " Sous-programmes rex d'intérêt général " */ /* */ /* */ /******************************************************************************/ /* */ /* Liste des fonctions disponibles : */ /* (attention aux majuscules ! sAy2 est incorrect à cause du A) */ /* */ /* sans paramètres : */ /* */ /* versionRu */ /* dateHeure */ /* */ /* avec 1 paramètre : */ /* */ /* triPhrase */ /* asg (qui renvoie nbl, moy, var, ect et cdv) */ /* */ /* avec 2 paramètres : */ /* */ /* formatZero */ /* racine */ /* surncard */ /* surncarg */ /* say2 écrit à l'écran et dans un fichier */ /* cor renvoie le coefficient de corrélation linéaire */ /* getcol récupère une colonne d'un fichier */ /* */ /******************************************************************************/ /* */ /* Exemples d'utilisation : (le caractère ^ sert de séparateur) */ /* */ /* r = rexxut("racine^"n) */ /* */ /******************************************************************************/ /* */ /* Pour forcer le type du système d'exploitation, on peut utiliser la */ /* variable d'environnement OSTYPE. Par exemple : */ /* */ /* export OSTYPE=UNX (sous Linux sous bash, à mettre dans .bashrc) */ /* set OSTYPE=DOS (sous Dos/Windows, à mettre dans autoexec.bat) */ /* */ /******************************************************************************/ /* */ /* Pour que ce fichier soit accessible par tout script Rexx/Regina, il */ /* faut positionner la variable d'environnement REGINA_MACROS. */ /* Par exemple : */ /* */ /* export REGINA_MACROS=/usr/local/bin (sous Linux) */ /* set REGINA_MACROS=C:\Scripts (sous Dos/Windows) */ /* */ /******************************************************************************/ /* trim ltrim rtrim via strip b l t */ parse arg largs dbg = 0 /* 1 for normal debug, 0 for normal operation, */ rxu. = "" if dbg=1 then do say say " entering REXXUT ; requested : = " largs say end /* fin de si dbg=1 */ largs = largs"^" if dbg=1 then do say say " transformed largs = " largs end /* fin de si dbg=1 */ /* gestion des paramètres */ nf = -1 idc = index(largs,"^") do while idc > 0 nf = nf + 1 if nf = 0 then prog = substr(largs,1,idc-1) else rxu.nf = substr(largs,1,idc-1) largs = substr(largs,idc+1) if dbg=1 then say " remaining args : " largs idc = index(largs,"^") end /* fin tant que idc > 0 */ if dbg=1 then say " prog " prog " rxu1 =" rxu.1 " rxu2 =" rxu.2 " rxu3 =" rxu.3 resRu = " ??? ??? -- ???? --- ??? " /* gestion des fonctions qui demandent une variable en retour dans le stack */ select when prog = "asg" then call asg rxu.1 when prog = "dateHeure" then call dateHeure when prog = "formatZero" then call formatZero rxu.1 rxu.2 when prog = "getcol" then call getcol rxu.1 rxu.2 when prog = "racine" then call racine rxu.1 when prog = "say2" then call say2 rxu.1 rxu.2 when prog = "surncard" then call surncard rxu.1 rxu.2 when prog = "surncarg" then call surncarg rxu.1 rxu.2 when prog = "triPhrase" then call triphrase rxu.1 when prog = "versionRu" then call versionRu when prog = "minu" then call minu rxu.1 otherwise do return " unkown file action'"||prog"' ; bad spelling ?" end /* fin de otherwise */ end /* fin de select sur prog */ return resRu /* fin de programme rexxut */ /******************************************************************************/ /******************************************************************************/ /* procédure qui ajoute des 0 à gauche de numer pour faire longr caractères */ formatZero: procedure expose dbg resRu parse arg numer longr chFmt = numer do while length(chFmt) < longr chFmt = "0"||chFmt end /* fin tant que */ resRu = chFmt return 0 /******************************************************************************/ /* procédure qui traduit en minuscule */ minu: procedure expose dbg resRu parse arg chenEnt chenSor = translate(chenEnt,"abcdefghijklmnopqrstuvwxyzee","ABCDEFGHIJKLMNOPQRSTUVWXYZÉË") resRu = chenSor return 0 /******************************************************************************/ /* procédure qui calcule la racine carrée */ racine: procedure expose dbg resRu numeric digits 15 arg x if dbg=1 then say " on veut la racine de " x if x> 1 then rr = 1 else rr = 0.9 do i = 1 to 20 rr = (x/(2*rr)) + rr/2 end /* fin pour */ resRu = rr return 0 /******************************************************************************/ /* procédure qui calcule les statistiques élémentaires */ asg: procedure expose dbg resRu numeric digits 15 arg x if dbg=1 then say " on veut les stat de " x n = words(x) if n = 0 then do moy = 0 var = 0 ect = 0 cdv = -1 end ; else do som = 0 /* somme des valeurs */ sdc = 0 /* somme des carrés */ do i = 1 to n vc = word(x,i) som = som + vc sdc = sdc + vc*vc end /* fin pour */ moy = som / n var = (sdc/n) - moy*moy ect = rexxut("racine^"var) if moy=0 then cdv = -1 else cdv = 100.0*ect/moy end /* fin si */ resRu = n moy var ect cdv return 0 /******************************************************************************/ /* procédure qui écrit dans le fichier et à l'écran */ say2: procedure expose dbg resRu parse arg nf lal if dbg=1 then say " say2 pour " nf " et " lal say lal call lineout nf , lal return 0 /******************************************************************************/ /* procédure qui cadre à gauche sur long la variable chen */ surncarg: procedure expose dbg resRu parse arg long chen if dbg=1 then say " surncarg cadrage sur " long " de " chen do while length(chen)0 lig = linein(fn) lacol = lacol word(lig,numc) end /* fin tant que */ if dbg=1 then say " on renvoie " lacol rf = fileut("closeFile^"fn) resRu = lacol return 0 /******************************************************************************/ /* procédure qui renvoie trie une phrase par ordre numérique de ses mots */ triPhrase: procedure expose resRu parse arg lis /* conversion en tableau */ nt. = "" ; do i = 1 to words(lis) ; nt.i = word(lis,i) ; end /* tri du tableau */ do i = 1 to words(lis) do j = i+1 to words(lis) if nt.i > nt.j then do etmp = nt.i nt.i = nt.j nt.j = etmp end /* fin de si */ end /* fin pour j */ end /* fin pour i */ /* reconversion en phrase */ nlis = "" ; do i = 1 to words(lis) ; nlis = nlis nt.i ; end resRu = nlis return 0 /******************************************************************************/ /* procédure qui renvoie la version de rexxut */ versionRu: procedure expose resRu if dbg=1 then say " Os is : " fileut("osName") resRu = word(sourceline(6),4) word(sourceline(6),5) return 0 /* fin de fonction versionFu */ /******************************************************************************/ /* procédure qui renvoie la date et l'heure */ dateHeure: procedure expose resRu if dbg=1 then say " Os is : " fileut("osName") resRu = date() || " vers " || time() return 0 /* fin de fonction versionFu */ /******************************************************************************/ /******* fin de fichier rexxut.rex ****************************************/ /* faut-il implémenter dosUnit dosFileUnit ucfirst explode=split join iota sum psum avg pavg std pstd ln exp rpos(right) nword(negative) lastword nsorta(numeric,array) asorta(alphabetic,array) nsorts(numeric,sentence) asorts(alphabetic,sentence) avalues(array) svalues(string) dir=ls selectSimpleMySql selectMultipleMySql wait progBar (barre de progression) noDblChar cadreTexte: parse arg long , chen return substr(chen copies(" ",long) , 1 , long ) */