[Morphologie-cvs] r23 - in trunk: . src

ksprotte at common-lisp.net ksprotte at common-lisp.net
Sun Jul 15 14:27:07 UTC 2007


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))



More information about the Morphologie-cvs mailing list