Author: ksprotte
Date: Sun Jul 15 10:27:06 2007
New Revision: 23
Modified:
trunk/morphologie.asd
trunk/src/morphologie.lisp
trunk/src/utils.lisp
Log:
file-dialog and external-format :latin-1
Modified: trunk/morphologie.asd
==============================================================================
--- trunk/morphologie.asd (original)
+++ trunk/morphologie.asd Sun Jul 15 10:27:06 2007
@@ -1,5 +1,8 @@
(in-package :asdf)
+;; This is a hack to read latin-1 instead of utf-8
+#+sbcl (setq sb-impl::*default-external-format* :latin-1)
+
(defsystem :morphologie
:version "3.0"
:components
Modified: trunk/src/morphologie.lisp
==============================================================================
--- trunk/src/morphologie.lisp (original)
+++ trunk/src/morphologie.lisp Sun Jul 15 10:27:06 2007
@@ -5,12 +5,15 @@
;;;* IRCAM, Paris, november 1998 for Morphologie 1.0 *
;;;* may 1999 for Morphologie 2.0 *
;;;* *
-;;;* Fonctions d'analyse, reconnaissance de pattern et classification morphologiques des profiles géometriques *
+;;;* Fonctions d'analyse, reconnaissance de pattern et classification morphologiques des profiles g�ometriques *
;;;* Analysis fonctions, pattern recognition and morphological classification of geometric profiles *
;;;* *
;;;*************************************************************************************************************
;;;
+;;; the encoding of this file is latin-1
+;;; that's the best common demoninator
+
(in-package :morph)
;;; watch out for functions like OM::....
@@ -142,7 +145,7 @@
(define-box pattern-ridond ((lista nil) &optional (n nil))
"Restituisce tutte le ripetizioni di tutti i sotto-pattern in
- cui può essere scomposta la sequenza in lista."
+ cui pu� essere scomposta la sequenza in lista."
:non-generic t
(let ((ris nil) (x (scom lista n)) y)
(loop :while x
@@ -244,8 +247,8 @@
(step nil) (set nil))
"Avance dans la sequence LIST avec avec une taille de fenetre WINDW
et un pas d'avancement (optionnel) STEP .
-Renvoie pour chaque fenêtre le nombre d'occurrences d'un élément.
-L'entrée optionnelle SET specifie les segments recherches dans LIST>"
+Renvoie pour chaque fen�tre le nombre d'occurrences d'un �l�ment.
+L'entr�e optionnelle SET specifie les segments recherches dans LIST>"
:non-generic t
(count-ptrn-win list windw step set))
@@ -348,8 +351,8 @@
les segments d'elements et leurs positions dans la sequence.
optionnels :
- LENGTH : longueur des segments. 2 par defaut.
-- PTRN : segment dont les permutations sont recherchés.
-tous par défaut. desactive LENGTH>
+- PTRN : segment dont les permutations sont recherch�s.
+tous par d�faut. desactive LENGTH>
Returns all permutations of two elements in SEQ with
their respective positions in seq.
@@ -446,7 +449,7 @@
(defparameter **alpha** (quote
(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
#\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z
- #\°)))
+ #\�)))
(defparameter **num** (quote (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
@@ -736,24 +739,24 @@
(define-box structure-1 ((seq (a b c a b c d a c c d a a b c a)) &optional (alpha? :alpha) (smooth? :yes)
(result :extend) (levels 1) (smth2? :no))
- "Donne toutes les structures possibles d'une séquence de nombres ou de symboles
-selon une segmentation contrastive, et ce de manière récursive.
+ "Donne toutes les structures possibles d'une s�quence de nombres ou de symboles
+selon une segmentation contrastive, et ce de mani�re r�cursive.
INPUT
-seq : séquence de symboles ou nombres (liste);
-alpha? : résultat en mode alphabétique ou numérique (YES NO), optional;
+seq : s�quence de symboles ou nombres (liste);
+alpha? : r�sultat en mode alphab�tique ou num�rique (YES NO), optional;
lisse? : optional YES : suppression des elements repetes immediatements dans seq .
-result : menu déroulant, quatre possibilités :
- short = liste des critères de segmentation et leur segmentation respective;
- exten = analyse détaillée;
+result : menu d�roulant, quatre possibilit�s :
+ short = liste des crit�res de segmentation et leur segmentation respective;
+ exten = analyse d�taill�e;
- save = analyse détaillée écrite en un fichier texte.
+ save = analyse d�taill�e �crite en un fichier texte.
OUTPUT
en mode short, pour le traitement de l'analyse, liste de liste selon le format :
-\((critères de segmentation)
-\(forme selon critère)...)"
+\((crit�res de segmentation)
+\(forme selon crit�re)...)"
:non-generic t
:menu (alpha? :alpha :num)
:menu (smooth? :yes :no)
@@ -1111,10 +1114,10 @@
(define-box rma-1 ((seq nil) (smoo1 1) (levels 1) &optional (smoo2 0)
(alpha? 1) (result 0))
"
-même fonction que structure-1, mais récursive :
-s'applique aussi aux structures trouvées, avec LEVELS
+m�me fonction que structure-1, mais r�cursive :
+s'applique aussi aux structures trouv�es, avec LEVELS
comme niveau de recursion.
-memes caractéristiques que structure-1
+memes caract�ristiques que structure-1
Recursive Mark Analysis. Returns only found structures."
:non-generic t
(when (< levels 1)
@@ -1874,7 +1877,7 @@
The classe number is arbitrary"
(class-1 (l-matrix matrix) n alpha? centers verbose))
-(defun CENTRE-GRAVIT\é (x)
+(defun CENTRE-GRAVIT\� (x)
(let (sum
g
(n (nth 1 (array-dimensions x)))
@@ -1886,9 +1889,9 @@
(setf (aref g 0 i) (float (/ sum m))))))
(define-box matrix-center ((matrix nil))
- "Donne les coordonnées du centre de gravité d'une matrice
- des coordonnées de points en n-dimensions (utiliser l-matrix
-pour convertir une liste de coordonnées de points en matrice).
+ "Donne les coordonn�es du centre de gravit� d'une matrice
+ des coordonn�es de points en n-dimensions (utiliser l-matrix
+pour convertir une liste de coordonn�es de points en matrice).
"
:non-generic t
(let (sum
@@ -1902,18 +1905,18 @@
(setf (aref g 0 i) (float (/ sum m))))))
-(defun X-CENTR\éE (x)
- (let ((g (CENTRE-GRAVIT\é x))
+(defun X-CENTR\�E (x)
+ (let ((g (CENTRE-GRAVIT\� x))
(n (nth 1 (array-dimensions x)))
(m (nth 0 (array-dimensions x)))
- CENTR\éE)
- (setq CENTR\éE (make-array (list m n)))
- (dotimes (i m CENTR\éE)
- (dotimes (j n) (setf (aref CENTR\éE i j) (aref g 0 j))))
- (setf CENTR\éE (subtract-two-matrices x CENTR\éE))))
+ CENTR\�E)
+ (setq CENTR\�E (make-array (list m n)))
+ (dotimes (i m CENTR\�E)
+ (dotimes (j n) (setf (aref CENTR\�E i j) (aref g 0 j))))
+ (setf CENTR\�E (subtract-two-matrices x CENTR\�E))))
(defun dist-grav (x)
- (let ((grav (CENTRE-GRAVIT\é x))
+ (let ((grav (CENTRE-GRAVIT\� x))
d-grav
diff
(m (nth 0 (array-dimensions x)))
@@ -1989,7 +1992,7 @@
collect (aref mat-dist i j)))))
(defun rand-classes (m n)
- "crée une m-liste aléatoire de n nombres différents"
+ "cr�e une m-liste al�atoire de n nombres diff�rents"
(let ((alea nil) (alea-test nil))
(dotimes (a m alea) (push (random n) alea))
(setf alea-test (remove-duplicates alea))
@@ -1997,7 +2000,7 @@
(defun centre-classes (x classes *m* *n* *n-cl*)
"input = matrice des points
- liste-vecteur des classes attribuées à chaque point
+ liste-vecteur des classes attribu�es � chaque point
output = matrice des centres de chaque classe"
(let (nuage point c tc centres)
(setf centres (make-array (list *n-cl* *n*)))
@@ -2012,7 +2015,7 @@
(cond ((eq (nth a classes) b)
(setf point (+ point 1))
(dotimes (d *n*) (setf (aref nuage (- point 1) d) (aref x a d)))
- (setf tc (CENTRE-GRAVIT\é nuage)))))
+ (setf tc (CENTRE-GRAVIT\� nuage)))))
(dotimes (d *n*) (setf (aref centres b d) (aref tc 0 d))))))
(define-box class-center ((matrix nil) (classes nil))
@@ -2042,7 +2045,7 @@
(setf point (+ point 1))
(dotimes (d *n*)
(setf (aref nuage (- point 1) d) (aref matrix a d)))
- (setf tc (CENTRE-GRAVIT\é nuage)))))
+ (setf tc (CENTRE-GRAVIT\� nuage)))))
(dotimes (d *n*) (setf (aref centres b d) (aref tc 0 d))))))
@@ -2066,7 +2069,7 @@
data : list of classes distribution (typically data from class-1;
OUT
Shannon entropie value, 0 <= entropie <= (log n 2).
-Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde,
+Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde,
Seuil, Paris, 1997."
(let ((cl (remove-duplicates data)) (n (length data)) (p nil))
(dolist (ci cl (- 0 (apply #'+ (mapcar #'(lambda (x) (* x (log x 2))) p))))
@@ -2081,7 +2084,7 @@
Shannon entropie value
0 <= entropy <= (log n 2) if res = absolute;
0 <= entropy <= 1.0 if res = relative.
-Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde,
+Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde,
Seuil, Paris, 1997."
:menu (res (:abs "absolute") (:rel "relative"))
(declare (ignore class res))
@@ -2095,7 +2098,7 @@
Shannon entropie value
0 <= entropy <= (log n 2) if res = absolute;
0 <= entropy <= 1.0 if res = relative.
-Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde,
+Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde,
Seuil, Paris, 1997."
(cond ((not (member 'nil (mapcar #'atom class)))
(if (equalp res :abs) (setf res 1) (setf res 0))
@@ -2117,7 +2120,7 @@
Shannon entropie value
0 <= entropy <= (log n 2) if res = absolute;
0 <= entropy <= 1.0 if res = relative.
-Cf. J. Wasemberg : L âme de la méduse, idées sur la complexité du monde,
+Cf. J. Wasemberg : L �me de la m�duse, id�es sur la complexit� du monde,
Seuil, Paris, 1997."
(setf class (str->symb class))
(entropy class res))
@@ -2148,8 +2151,8 @@
(defun normalize-class (classes)
"reordonne les classes de class-1.
-L'ordre de la classe étant le numéro de sa première occurence dans la liste des classes.
-Se connecte typiquement après class-1 ou meta-class1."
+L'ordre de la classe �tant le num�ro de sa premi�re occurence dans la liste des classes.
+Se connecte typiquement apr�s class-1 ou meta-class1."
(let ((set nil) (r nil) (marker -1) (tempset nil) n)
(when (stringp classes) (setf classes (str->symb classes)))
(setf n (length (remove-duplicates classes)))
@@ -2164,8 +2167,8 @@
(define-box norm-class ((classes nil))
"reordonne les classes de class-1.
-L'ordre de la classe étant le numéro de sa première occurence dans la liste des classes.
-Se connecte typiquement après class-1 ou meta-class1.
+L'ordre de la classe �tant le num�ro de sa premi�re occurence dans la liste des classes.
+Se connecte typiquement apr�s class-1 ou meta-class1.
IN : string or list (of symbols or lists or strings)."
:non-generic t
(if (or (stringp classes) (not (listp (car classes))))
@@ -2453,23 +2456,23 @@
6800 8300 5900))
(result 1) &optional (d-cte nil))
"analyse une sequence en detectant trois formes primitives:
-minima: element précédé et suivi par un élément
+minima: element pr�c�d� et suivi par un �l�ment
de valeur plus grande.
-maxima: element précédé et suivi par un élément
+maxima: element pr�c�d� et suivi par un �l�ment
de valeur plus petite
-flex: element précédé et suivi par un élément
-de valeur égale
+flex: element pr�c�d� et suivi par un �l�ment
+de valeur �gale
ex : (10 8 8 6 6 5 2 2 2 1)
OM->(pure-flex- (8 2) (6 2) (2 3))
-le premier chiffre indique la valeur répétée
- et le deuxième terme de la liste indique son nombre d'occurrences.
-la deuxième entrée est un menu WHICH qui permet de selectionner
+le premier chiffre indique la valeur r�p�t�e
+ et le deuxi�me terme de la liste indique son nombre d'occurrences.
+la deuxi�me entr�e est un menu WHICH qui permet de selectionner
les informations:
prim: succession des primitives
-prof: succession des primitives et profondeur en nombre d'éléments de
+prof: succession des primitives et profondeur en nombre d'�l�ments de
chaque primitive
-vals: idem que prof + valeur correspondant à chaque primitive
+vals: idem que prof + valeur correspondant � chaque primitive
every: idem que vals + position de chaque primitive"
:non-generic t
:menu (result (1 "prim") (2 "prof") (3 "vals") (4 "every"))
@@ -2495,7 +2498,7 @@
(define-box 1-0-1-reconst ((list nil))
"fonction dx->x d'OM :
renvoie une liste de points depuis une liste
- d'intervalles . commence à zero"
+ d'intervalles . commence � zero"
:non-generic t
(OM::dx->x 0 list))
@@ -2558,7 +2561,7 @@
(define-box reconst-prim+prof ((list nil))
"Ricostruisce la lista usando min, max, flex
- più eventualmente l'indice di profondità"
+ pi� eventualmente l'indice di profondit�"
:non-generic t
(let ((ris nil) (start 0))
(dolist (y list
@@ -2580,8 +2583,8 @@
ris))))
-(defun rec-st-2 (struct |N°| &optional seq)
- (let* ((rs (nth |N°| struct))
+(defun rec-st-2 (struct |N�| &optional seq)
+ (let* ((rs (nth |N�| struct))
(risultato
(mapcar #'(lambda (x) (OM::flat (nth x (cadr rs))))
(mapcar #'1- (cadar rs)))))
@@ -2590,27 +2593,27 @@
(OM::flat risultato))))
(define-box struct2-to-seq ((struct nil) (n nil) &optional ptrns)
- "Reconstruit une séquence correspondant à la structure donnée en struct.
- Optional : reconstruit une séquence de même structure avec les patterns
- donnés en ptrns."
+ "Reconstruit une s�quence correspondant � la structure donn�e en struct.
+ Optional : reconstruit une s�quence de m�me structure avec les patterns
+ donn�s en ptrns."
(declare (ignore struct n))
(error "default method. should not be called."))
(defmethod struct2-to-seq ((struct list) (n integer) &optional ptrns)
- "Reconstruit une séquence correspondant à la structure donnée en struct.
- Optional : reconstruit une séquence de même structure avec les patterns
- donnés en ptrns."
+ "Reconstruit une s�quence correspondant � la structure donn�e en struct.
+ Optional : reconstruit une s�quence de m�me structure avec les patterns
+ donn�s en ptrns."
(rec-st-2 struct n ptrns))
(defmethod struct2-to-seq ((struct list) (n list) &optional ptrns)
- "Reconstruit une séquence correspondant à la structure donnée en struct.
- Optional : reconstruit une séquence de même structure avec les patterns
- donnés en ptrns."
+ "Reconstruit une s�quence correspondant � la structure donn�e en struct.
+ Optional : reconstruit une s�quence de m�me structure avec les patterns
+ donn�s en ptrns."
(mapcar #'(lambda (i) (rec-st-2 struct i ptrns)) n))
(define-box reconst-prim+prof+val ((list nil) (start 6000))
"Ricostruisce la lista usando min, max, flex
- più eventualmente l'indice di profondità"
+ pi� eventualmente l'indice di profondit�"
:non-generic t
(let ((ris nil))
(dotimes (x (length list) (OM::flat (nreverse ris)))
@@ -2640,7 +2643,7 @@
(define-box pos+prim+prof+val ((list nil) (start 6000))
"Ricostruisce la lista usando min, max, flex
- più eventualmente l'indice di profondità"
+ pi� eventualmente l'indice di profondit�"
:non-generic t
(let ((ris nil) (valore nil))
(dotimes (x (length list)
@@ -2722,7 +2725,7 @@
(define-box controlla-ottave ((list1 nil) (list2 nil) (modul 12))
"studia i casi particolari della melodia in questione se questa
- è trasposta più o meno esattamente"
+ � trasposta pi� o meno esattamente"
:non-generic t
(let* ((ris nil)
(ros nil)
@@ -2993,9 +2996,9 @@
(define-box multi-distance ((seq1 nil) (seq2 nil) (change 1) (ins/sup 1)
(wgth (1 1 1 1)) &optional (inex nil))
- "Applique la distance d'édition à une liste
- de séquences avec une pondération (entre 0 et 1)
- pour chaque élément (ou position) des listes."
+ "Applique la distance d'�dition � une liste
+ de s�quences avec une pond�ration (entre 0 et 1)
+ pour chaque �l�ment (ou position) des listes."
:non-generic t
(if inex
(dist-2-ldl seq1 seq2 change ins/sup inex wgth)
@@ -3024,8 +3027,8 @@
(define-box resemblance ((a nil) (b nil) (wocc 1.0) (wref 1.0) &optional
(diff :res))
- "Calcule une valeur de ressemblance entre 0 et 100 entre deux séquences
-de symboles selon le critère de leur structure interne.
+ "Calcule une valeur de ressemblance entre 0 et 100 entre deux s�quences
+de symboles selon le crit�re de leur structure interne.
Wocc : poids de la structure d'occurence;
Wref : poids de la structure de repetition."
:menu (diff :res :diss)
@@ -3034,8 +3037,8 @@
(defmethod resemblance ((a list) (b list) (wocc float) (wref float) &optional
diff)
- "Calcule une valeur de ressemblance entre 0 et 100 entre deux séquences
-de symboles selon le critère de leur structure interne.
+ "Calcule une valeur de ressemblance entre 0 et 100 entre deux s�quences
+de symboles selon le crit�re de leur structure interne.
Wocc : poids de la structure d'occurence;
Wref : poids de la structure de repetition."
(let* ((ma (resemblance-match a a))
@@ -3076,13 +3079,13 @@
(dotimes (x (- (length lista) 1) (nreverse ris))
(push (/ (+ (nth x lista) (nth (1+ x) lista)) 2) ris))))
-(define-box mean-derivation ((list nil) (GR\° 0) &optional (note? nil))
+(define-box mean-derivation ((list nil) (GR\� 0) &optional (note? nil))
""
:non-generic t
(let* ((calcolo
- (if (= 1 GR\°)
+ (if (= 1 GR\�)
(med-fix list)
- (mean-derivation (med-fix list) (- GR\° 1) note?)))
+ (mean-derivation (med-fix list) (- GR\� 1) note?)))
(con-note (when note? (notes-change calcolo note? 48))))
(if note? con-note calcolo)))
@@ -3103,13 +3106,13 @@
(push (/ (apply '+ (nth x calcolo)) (length (nth x calcolo))) ris))))
-(define-box variable-derivation ((lista nil) (windw 2) (GR\° 1))
+(define-box variable-derivation ((lista nil) (windw 2) (GR\� 1))
"Restituisce le dirivate variabili successive secondo il valore
scelto in GRADO. N rappresenta il valore con cui effettuare la media."
:non-generic t
- (if (= 1 GR\°)
+ (if (= 1 GR\�)
(med-var lista windw)
- (variable-derivation (med-var lista windw) (- GR\° 1) windw)))
+ (variable-derivation (med-var lista windw) (- GR\� 1) windw)))
(define-box notes-change ((pits 6000) (scale 6000) &optional (mod 12))
@@ -3140,7 +3143,7 @@
(define-box octave ((midic 6000))
- "retourne l'octave à partir de c3=octave 3"
+ "retourne l'octave � partir de c3=octave 3"
:non-generic t
(let ((midic (list! midic)))
(mapcar #'(lambda (x) (OM::om- (OM::om// x 1200) 2))
@@ -3148,14 +3151,14 @@
(define-box makenote ((index 60) (octave 3) &optional (mod 12))
- " construction d'une note à partir des données
+ " construction d'une note � partir des donn�es
de index, octave e modulo du index"
:non-generic t
(+ (/ (* index 100 12) mod) (* (+ 2 octave) 1200)))
(defun lettura-modulare (lista1 lista2)
- "Se la prima lista è più grande della seconda lista, allora legge
+ "Se la prima lista � pi� grande della seconda lista, allora legge
modularmente la seconda lista restituendo un length uguale al length
di lista1."
(let ((ros nil))
@@ -3184,10 +3187,10 @@
(define-box prof-inter ((list1 nil) (list2 nil) (total 1))
- "Restituisce l'interposizione di list1 con list2. Se list1 è più piccola
+ "Restituisce l'interposizione di list1 con list2. Se list1 � pi� piccola
di list2 allora la funzione crea un'interposizione di n elementi di list2
dove (= n (- (length list1) 1)). In questo caso si puo' decidere con il
- menù se avere la prima ricorsione per completare list2."
+ men� se avere la prima ricorsione per completare list2."
:non-generic t
:menu (total (1 "ltd") (2 "copl"))
(case total
@@ -3198,14 +3201,14 @@
(otherwise (error "Got ~s, was expecting one of 1, 2." total))))
-(define-box interlock ((list1 nil) (list2 nil) (GR\° 1))
+(define-box interlock ((list1 nil) (list2 nil) (GR\� 1))
"Interpone una lista2 alla lista1 e prende
aleatoriamente le note della lista2"
:non-generic t
- (if (= GR\° 1)
+ (if (= GR\� 1)
(inter-profile list1 (OM::permut-random list2))
(interlock (inter-profile list1 (OM::permut-random list2))
- (permut-circ list2 (1- (length list1))) (- GR\° 1))))
+ (permut-circ list2 (1- (length list1))) (- GR\� 1))))
(define-box new-inter-profile ((list1 nil) (list2 nil))
@@ -3229,14 +3232,14 @@
(last list1)))))
-(define-box new-interlock ((list1 nil) (list2 nil) (GR\° 1))
+(define-box new-interlock ((list1 nil) (list2 nil) (GR\� 1))
"Interpone una lista2 alla lista1 e prende
aleatoriamente le note della lista2"
:non-generic t
- (if (= GR\° 1)
+ (if (= GR\� 1)
(new-inter-profile list1 (OM::permut-random list2))
(new-interlock (new-inter-profile list1 (OM::permut-random list2))
- (permut-circ list2 (1- (length list1))) (- GR\° 1))))
+ (permut-circ list2 (1- (length list1))) (- GR\� 1))))
(defun int-com-ottava (lista)
@@ -3279,9 +3282,9 @@
(define-box correttore ((elmt 1) (range nil))
"Restituisce un elemento se questo compare all'interno del range.
- Se l'elemento è escluso allora lo traspone in modo tale che sia
- il più vicino possibile o al limite superiore o a quello inferiore.
- Se il limite è DO-SOL allora Mi viene incluso, SI viene trasposto
+ Se l'elemento � escluso allora lo traspone in modo tale che sia
+ il pi� vicino possibile o al limite superiore o a quello inferiore.
+ Se il limite � DO-SOL allora Mi viene incluso, SI viene trasposto
sotto il DO e il SOL# viene trasposto sopra il SOL."
:non-generic t
(let ((max (g-max range)) (min (g-min range)))
@@ -3297,26 +3300,26 @@
(defun cor-ott-list (elmt range)
"Restituisce un elemento se questo compare all'interno del range.
- Se l'elemento è escluso allora lo traspone in modo tale che sia
- il più vicino possibile o al limite superiore o a quello inferiore.
- Se il limite è DO-SOL allora Mi viene incluso, SI viene trasposto
+ Se l'elemento � escluso allora lo traspone in modo tale che sia
+ il pi� vicino possibile o al limite superiore o a quello inferiore.
+ Se il limite � DO-SOL allora Mi viene incluso, SI viene trasposto
sotto il DO e il SOL# viene trasposto sopra il SOL.La differenza
- con 'CORRETTORE' è che questo modulo agisce su una lista intera."
+ con 'CORRETTORE' � che questo modulo agisce su una lista intera."
(let ((ris nil))
(dolist (y elmt) (push (correttore y range) ris))
(nreverse ris)))
(define-box trans-approx ((list nil) (range nil))
"E' meglio di transpoct di Esquisse. Infatti attua lo stesso
- procedimento ma traspone una nota non inclusa nel range il più
+ procedimento ma traspone una nota non inclusa nel range il pi�
vicino o al limite superiore o a quello inferiore."
:non-generic t
(cor-ott-list (mio-transpoct list range) range))
(define-box direct-analysis ((list (6000 4000 6900 7300 6100 5900)))
- "donne le signe de la dérivée locale (-1. 0 +1) pour chaque point de la liste
-des valeurs données en entrée."
+ "donne le signe de la d�riv�e locale (-1. 0 +1) pour chaque point de la liste
+des valeurs donn�es en entr�e."
:non-generic t
(let ((ris nil))
(dotimes (x (length (OM::x->dx list)) (nreverse ris))
@@ -3364,8 +3367,8 @@
(defun interno (elmt range)
- "Restituisce l'elemento se è incluso nel 'range' e nil
- se non è incluso."
+ "Restituisce l'elemento se � incluso nel 'range' e nil
+ se non � incluso."
(if (<= (g-min range) elmt (g-max range)) elmt nil))
(define-box malt-mod- ((list nil) (limit 6000))
@@ -3378,7 +3381,7 @@
(define-box reflex-int ((ls nil) (value 0) (up/down 1))
"Restituisce la rifleesione delle note che sono superiori o inferiori
- al valore indicato con 'value'. Il menù permette di selezionare se si
+ al valore indicato con 'value'. Il men� permette di selezionare se si
vuole una riflessione superiore o inferiore"
:non-generic t
:menu (up/down (1 "up") (2 "down"))
@@ -3499,7 +3502,7 @@
(define-box comp-octave ((list nil) (range nil))
"Restituisce una trasposizione della lista mantenendo le altezze
- assolute all'interno del 'range. Se un elemento non è incluso
+ assolute all'interno del 'range. Se un elemento non � incluso
nel 'range', allora viene tolto dal risultato."
:non-generic t
(let ((ris nil))
@@ -3509,8 +3512,8 @@
(define-box rtm-change ((rhyt nil) (modulo nil) (mode? 1))
"E' la funzione che cambia un ritmo in funzione del menu MODE?
- Se MODE? è su mod, questa funzione restituisce i multipli
- dei valori in MODULI; se è su ptrn allora retituisce una
+ Se MODE? � su mod, questa funzione restituisce i multipli
+ dei valori in MODULI; se � su ptrn allora retituisce una
struttura ritmica che utlilizza solamente i valori in MODULO"
:non-generic t
:menu (mode? (1 "mod") (2 "ptrn"))
@@ -3522,9 +3525,9 @@
(define-box rtm-change-1 ((rhytm nil) (vals nil))
- "Se in vals c'è un solo valore allora calcola una
+ "Se in vals c'� un solo valore allora calcola una
approssimazione ritmica in modo tale che tutti i valori
- risultino un multiplo di vals. Se invece in vals c'è una
+ risultino un multiplo di vals. Se invece in vals c'� una
lista di valori allora approssima tutti i valori in rtm
con i valori di vals."
:non-generic t
@@ -3554,8 +3557,8 @@
(define-box rtm-change-1val ((rht nil) (val 1))
"Questa funzione prende ogni elemento di rht e restituisce
- lo stesso elemento se il (mod rht val) è uguale a 0
- altrimenti lo approssima al poù vicino"
+ lo stesso elemento se il (mod rht val) � uguale a 0
+ altrimenti lo approssima al po� vicino"
:non-generic t
(let ((ris nil))
(dolist (y rht (nreverse ris))
@@ -3576,13 +3579,13 @@
(define-box segno+picc ((list nil))
"Trasforma tutta la lista in valori tutti positivi e prende il valore
- più piccolo."
+ pi� piccolo."
:non-generic t
(g-min (mapcar #'(lambda (x) (abs x)) list)))
(define-box nota-vicina ((list nil) (ref 1))
- "Prende l'intervallo più piccolo di una lista."
+ "Prende l'intervallo pi� piccolo di una lista."
:non-generic t
(let* ((intervalli (tutti-int list ref)) (piccolo (segno+picc intervalli)))
(if (equalp (abs (first intervalli)) piccolo)
@@ -3591,13 +3594,13 @@
(define-box tieni-nota ((list nil) (ref 1))
- "tiene la nota più vicina."
+ "tiene la nota pi� vicina."
:non-generic t
(OM::om+ ref (nota-vicina list ref)))
(define-box vicini-valori ((list1 nil) (refs nil))
- "Prende le note più vicine di list per ogni nota di refs."
+ "Prende le note pi� vicine di list per ogni nota di refs."
:non-generic t
(mapcar #'(lambda (x) (tieni-nota list1 x)) refs))
@@ -3798,8 +3801,8 @@
(define-box prim-tree ((dist nil))
"Builds up the shorter tree of the points given in the matrix of distances (list of list),
distances must be expressed as ((xi yi di) etc.).
-prend en entrée la sortie de ldl-distance en mode extend.
-See: E. Diday & all, 1982 : Elements d'analyse de données, Dunod, Paris. pp. 110-111."
+prend en entr�e la sortie de ldl-distance en mode extend.
+See: E. Diday & all, 1982 : Elements d'analyse de donn�es, Dunod, Paris. pp. 110-111."
:non-generic t
(assert (not (member 0 dist :test #'equalp :key #'third))
nil
@@ -3906,7 +3909,7 @@
(define-box delta ((list nil) (round 1000))
- " calcule les différences entre les valeurs consécutives avec un arrondi "
+ " calcule les diff�rences entre les valeurs cons�cutives avec un arrondi "
:non-generic t
(let ((l nil) (delta nil))
(dotimes (n (- (length list) 1))
Modified: trunk/src/utils.lisp
==============================================================================
--- trunk/src/utils.lisp (original)
+++ trunk/src/utils.lisp Sun Jul 15 10:27:06 2007
@@ -31,42 +31,3 @@
(if (consp (car list))
(apply 'append list) list))
-#-(or lispworks digitool)
-(defun choose-new-file-dialog (&key (prompt "Enter the path for a new file:")
- button-string)
- (declare (ignore button-string))
- (format *query-io* "~&~a~%[please enter a path like /tmp/test.txt]~%" prompt)
- (force-output *query-io*)
- (parse-namestring (read-line *query-io*)))
-
-#+digitool
-(defun choose-new-file-dialog (&key (prompt "Enter the path for a new file:")
- button-string)
- (ccl::choose-new-file-dialog :prompt prompt :button-string button-string))
-
-#+lispworks
-(defun choose-new-file-dialog (&key (prompt "Enter the path for a new file:")
- button-string)
- (capi:prompt-for-file prompt :operation :save))
-
-#-(or lispworks digitool)
-(defun choose-file-dialog (&key (prompt "Enter the path for an existing file:")
- button-string)
- (format *query-io* "~&~a~%[please enter a path like /tmp/test.txt]~%" prompt)
- (force-output *query-io*)
- (let ((path (parse-namestring (read-line *query-io*))))
- (if (probe-file path)
- path
- (progn
- (format *query-io* "~&ERROR: ~A does not exist.~%" path)
- (choose-file-dialog :prompt prompt :button-string button-string)))))
-
-#+digitool
-(defun choose-file-dialog (&key (prompt "Enter the path for an existing file:")
- button-string)
- (ccl::choose-file-dialog :prompt prompt :button-string button-string))
-
-#+lispworks
-(defun choose-file-dialog (&key (prompt "Enter the path for a new file:")
- button-string)
- (capi:prompt-for-file prompt))
