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"