[fomus-cvs] CVS update: fomus/TODO fomus/backend_mid.lisp fomus/misc.lisp fomus/other.lisp fomus/package.lisp fomus/version.lisp

[David Psenicka]

Update of /project/fomus/cvsroot/fomus
In directory common-lisp.net:/tmp/cvs-serv3808

Modified Files:
	TODO backend_mid.lisp misc.lisp other.lisp package.lisp 
	version.lisp 
Log Message:
fixes...
Date: Thu Dec  1 00:51:37 2005
Author: dpsenicka

Index: fomus/TODO
diff -u fomus/TODO:1.25 fomus/TODO:1.26
--- fomus/TODO:1.25	Sat Oct 22 22:43:06 2005
+++ fomus/TODO	Thu Dec  1 00:51:37 2005
@@ -6,8 +6,8 @@
       Quantizing nested tuplets--occasional hangups
       Many more...
     Doc: list-instr-syms, list-perc-syms
-    Doc: CM MIDI backend
-    Importing MIDI percussion
+    Specifying percussion from MIDI info
+    Automatic percussion instrument changes
     Splitting chords across staves (LilyPond)
     STAFF, CLEF and other marks for overriding FOMUS's decisions
     MusicXML backend


Index: fomus/backend_mid.lisp
diff -u fomus/backend_mid.lisp:1.8 fomus/backend_mid.lisp:1.9
--- fomus/backend_mid.lisp:1.8	Sat Nov 12 19:57:23 2005
+++ fomus/backend_mid.lisp	Thu Dec  1 00:51:37 2005
@@ -120,7 +120,7 @@
 
 (defparameter *grace-dur-secs* 1/12)
 (declaim (special *gracedur*))
-(defparameter *min-amp* 1/5)
+(defparameter *min-amp* 1/10)
 (defparameter *trdur-secs* 1/12) ; trill notes per sec. (and unmeasured tremolos)
 (declaim (special *trdur*))
 (defparameter *tramp* 3/4)
@@ -331,7 +331,7 @@
 				  (setf is (delete x is))
 				  (mapc (lambda (e) (nsubstitute t ex e)) ps)))))
 			  (cons (car c) (+ (* (car c) 16) (cdr c))))
-			and pmn = (when (is-percussion p) (mapcar (lambda (x) (cons (perc-note x) (perc-midinote-ex x))) (instr-percs in)))
+			and pmn = (when (is-percussion p) (mapcar (lambda (x) (cons (perc-sym x) (perc-midinote-ex x))) (instr-percs in)))
 			do
 			(prenconc (unless (is-percussion p) (loop for i in (chs ch) collect (make-instance *cm-progch* :time 0 :channel i :program ex))) xta)
 			(let ((ap (rassoc p aps))) (when ap (setf aps (delete-if (lambda (x) (and (= (car x) ex) (numberp (cdr x)))) aps) (cdr ap) ch)))
@@ -398,7 +398,13 @@
 										     (setf ts (delete-if (lambda (x) (< (midi-endoff (cdr x)) of)) ts))
 										     (if (notep ev)
 											 (loop with n0 = (let ((z (force-list (if (chordp ev) (event-notes* ev) (event-note* ev)))))
-													   (if pmn (mapcar (lambda (x) (lookup x pmn)) z) z))
+													   (if pmn (mapcar (lambda (x)
+															     (let ((m (getmark ev (list :percsym x))))
+															       (if m
+																   (lookup (third m) pmn)
+																   (lookup x pmn))))
+															   z)
+													       z))
 											       with ln = (length n0)
 											       and cch = (or (when pizz (lookup pizzch aps))
 													     (loop for v in '(:stopped :open :harmonic)


Index: fomus/misc.lisp
diff -u fomus/misc.lisp:1.11 fomus/misc.lisp:1.12
--- fomus/misc.lisp:1.11	Sat Oct  1 19:28:29 2005
+++ fomus/misc.lisp	Thu Dec  1 00:51:37 2005
@@ -256,7 +256,7 @@
       do (push ,var ,rt)
       finally (return ,rt))))
 
-(declaim (inline lookup))
+#-cmu (declaim (inline lookup))
 (defun lookup (item list &rest keys)
   (declare (type list list))
   (cdr (apply #'assoc item list keys)))


Index: fomus/other.lisp
diff -u fomus/other.lisp:1.11 fomus/other.lisp:1.12
--- fomus/other.lisp:1.11	Fri Nov 11 23:03:16 2005
+++ fomus/other.lisp	Thu Dec  1 00:51:37 2005
@@ -87,14 +87,15 @@
 		(if (numberp n) (unless (svref +note-to-white+ (mod n 12))
 				  (error "Invalid percussion note ~S in NOTE slot of note at offset ~S, part ~S" n (event-foff ev) (part-name p)))
 		  (let ((c (etypecase n ; c = percussion struct
-			     (symbol (find n *percussion* :key #'perc-sym) (find n pm :key #'perc-sym))
+			     (symbol #|(find n *percussion* :key #'perc-sym)|# (find n pm :key #'perc-sym))
 			     (perc n))))
 		    (if c
-			(progn
+			(progn 
 			  (when (and (perc-staff c) (> (instr-staves (part-instr p)) 1))
 			    (setf (event-staff* ev) (perc-staff c)))
 			  (when (perc-voice c) (setf (event-voice* ev) (perc-voice c)))
 			  (setf (event-note ev) (note-to-num (perc-note c)))
+			  (addmark ev (list :percsym (note-to-num (perc-note c)) n))
 			  (when (and *auto-percussion-durs* (perc-autodur c) (not (event-grace ev))
 				     (notany (lambda (x)
 					       (declare (type symbol x))


Index: fomus/package.lisp
diff -u fomus/package.lisp:1.12 fomus/package.lisp:1.13
--- fomus/package.lisp:1.12	Sat Oct 22 22:43:06 2005
+++ fomus/package.lisp	Thu Dec  1 00:51:37 2005
@@ -10,7 +10,7 @@
 
 (defpackage "FOMUS"
   (:nicknames "FM" "FMS")
-  (:use "COMMON-LISP" #|"MISCFUNS"|#)
+  (:use "COMMON-LISP")
   (:export "FOMUS" "LOAD-INITFILE"			; interface functions
 	   "FOMUS-INIT" "FOMUS-NEWTIMESIG" "FOMUS-NEWPART" "FOMUS-NEWMARK" "FOMUS-NEWNOTE" "FOMUS-NEWREST" "FOMUS-EXEC" "FOMUS-PART"
 	   "LIST-FOMUS-SETTINGS" "LIST-FOMUS-INSTRUMENTS" "LIST-FOMUS-INSTRGROUPS" "LIST-FOMUS-PERCUSSION" "LIST-FOMUS-CLEFS"


Index: fomus/version.lisp
diff -u fomus/version.lisp:1.21 fomus/version.lisp:1.22
--- fomus/version.lisp:1.21	Wed Nov 16 02:26:30 2005
+++ fomus/version.lisp	Thu Dec  1 00:51:37 2005
@@ -12,7 +12,7 @@
 (declaim (type string +title+)
 	 (type cons +version+ +banner+))
 (defparameter +title+ "FOMUS")
-(defparameter +version+ '(0 1 26))
+(defparameter +version+ '(0 1 27))
 (defparameter +banner+
   `("Lisp music notation formatter"
     "Copyright (c) 2005 David Psenicka, All Rights Reserved"