Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv16091 Modified Files: accidentals.lisp version.lisp Log Message: Date: Wed Nov 16 02:26:30 2005 Author: dpsenicka Index: fomus/accidentals.lisp diff -u fomus/accidentals.lisp:1.12 fomus/accidentals.lisp:1.13 --- fomus/accidentals.lisp:1.12 Sat Nov 12 21:42:46 2005 +++ fomus/accidentals.lisp Wed Nov 16 02:26:30 2005 @@ -93,17 +93,22 @@ (declaim (type #-openmcl (float 0 1) #+openmcl float *acc-diatonic-int-score* *acc-aug-dim-int-score* *acc-spelling-penalty* *acc-good-unison-score* *acc-bad-unison-score* *acc-similar-qtone-score*)) (defparameter *acc-diatonic-int-score* (float 7/8)) -(defparameter *acc-aug-dim-int-score* (float 1/3)) +(defparameter *acc-aug-dim-int-score* (float 1/2)) (defparameter *acc-spelling-penalty* (float 1/4)) (defparameter *acc-good-unison-score* (float 1)) (defparameter *acc-bad-unison-score* (float 3/8)) (defparameter *acc-similar-qtone-score* (float 1/3)) (defun nokey-notepen (n a) - (declare (type rational n) (type (integer -2 2) a)) - (* (loop - for e of-type (integer -1 1) in (cons 0 (svref +nokey-penalty+ (nokey-spell n a))) - minimize (diff a e)) *acc-spelling-penalty*)) + (declare (type rational n) (type (or (integer -2 2) (integer -2 2)) a)) + (* (loop + for e of-type (integer -1 1) in (cons 0 (svref +nokey-penalty+ (nokey-spell n a))) + minimize (diff a e)) *acc-spelling-penalty*)) +(defun nokeyq-notepen (n a) + (declare (type rational n) (type (or (integer -2 2) (cons (integer -2 2) (rational -1/2 1/2))) a)) + (* (loop + for e of-type (integer -1 1) in (cons 0 (svref +nokey-penalty+ (nokeyq-spell n a))) + minimize (diff (car a) e)) *acc-spelling-penalty*)) ;; scores of 1 are perfect ;; tie is if accidentals must be in same direction @@ -160,7 +165,7 @@ (evd nil :type list) (o 0 :type (rational 0)) (co 0 :type (integer 0))) ; sc = score-so-far (evt - evd), ret = return events, re = num. remaining, events from, evc = events to consider when redoing, evd = events to redo -(defun acc-nokey (events choices spellfun intscorefun name conv) ; events in one part +(defun acc-nokey (events choices spellfun penfun intscorefun name conv) ; events in one part (declare (type list events choices) (type (function (rational (or (integer -2 2) (cons (integer -2 2) (rational -1/2 1/2)))) (values (or (integer 0 6) null) (or integer null))) spellfun) (type (function (boolean rational (or (integer -2 2) (cons (integer -2 2) (rational -1/2 1/2))) (rational 0) (rational 0) @@ -223,7 +228,7 @@ collect (cons (let* ((eua (event-useracc e)) (ne (event-note* e)) - (su (- 1.0 (nokey-notepen ne eua))) (di 1.0)) + (su (- 1.0 (funcall penfun ne eua))) (di 1.0)) (declare (type #-openmcl (float 0) #+openmcl float su di)) (loop ; plus optimistic 1 scores for rest in range for e0 of-type noteex in lf @@ -292,9 +297,9 @@ (case (auto-accs-fun) (:nokey1 (if *quartertones* (acc-nokey evs (if *use-double-accs* +acc-qtones-double+ +acc-qtones-single+) - #'nokeyq-spell #'nokeyq-intscore (part-name e) #'nokey-convert-qtone) + #'nokeyq-spell #'nokeyq-notepen #'nokeyq-intscore (part-name e) #'nokey-convert-qtone) (acc-nokey evs (if *use-double-accs* +acc-double+ +acc-single+) - #'nokey-spell #'nokey-intscore (part-name e) #'identity))) + #'nokey-spell #'nokey-notepen #'nokey-intscore (part-name e) #'identity))) (otherwise (error "Unknown accidental assignment function ~S" *auto-accs-mod*)))) #'sort-offdur))))) Index: fomus/version.lisp diff -u fomus/version.lisp:1.20 fomus/version.lisp:1.21 --- fomus/version.lisp:1.20 Sat Nov 12 21:42:46 2005 +++ fomus/version.lisp Wed Nov 16 02:26:30 2005 @@ -12,7 +12,7 @@ (declaim (type string +title+) (type cons +version+ +banner+)) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 25)) +(defparameter +version+ '(0 1 26)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005 David Psenicka, All Rights Reserved"