[fomus-cvs] CVS update: fomus/accidentals.lisp fomus/version.lisp

[David Psenicka]

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"