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