Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv20725 Modified Files: CHANGELOG TODO backend_ly.lisp data.lisp fomus.asd interface.lisp main.lisp marks.lisp parts.lisp postproc.lisp split.lisp test.lisp util.lisp version.lisp voices.lisp Log Message: testing/bug fixes Date: Wed Aug 31 23:18:00 2005 Author: dpsenicka Index: fomus/CHANGELOG diff -u fomus/CHANGELOG:1.10 fomus/CHANGELOG:1.11 --- fomus/CHANGELOG:1.10 Wed Aug 31 16:07:10 2005 +++ fomus/CHANGELOG Wed Aug 31 23:17:59 2005 @@ -1,3 +1,10 @@ +v0.1.13 + + Testing/bug fixes: + BACKEND setting + combining notes from multiple voices into one + default part orderings/groupings + v0.1.12 Testing/bug fixes: Index: fomus/TODO diff -u fomus/TODO:1.18 fomus/TODO:1.19 --- fomus/TODO:1.18 Wed Aug 31 17:56:06 2005 +++ fomus/TODO Wed Aug 31 23:17:59 2005 @@ -3,19 +3,19 @@ Immediate: Testing and bug fixes - Nested tuplets not working yet - Automatic multivoice notes not working yet Splitting chords across staves (LilyPond) - :STAFF and other marks for overriding FOMUS's decisions + STAFF, CLEF and other marks for overriding FOMUS's decisions MusicXML backend MIDI output to CM Durations that fill to next/previous note - Proofread/finish documentation, add easy examples + Proofread/finish documentation: + most often used settings + easy, indexed examples of all features Tuplet bracket setting - DOC: :instruments setting update + Marks affecting all voices Aesthetic tweaks: - Avoid staff changes when notes move in other direction - Re-evaluate initial clef decision in measure 1 + avoid staff changes when notes move in other direction + re-evaluate initial clef decision in measure 1 Short Term: Index: fomus/backend_ly.lisp diff -u fomus/backend_ly.lisp:1.15 fomus/backend_ly.lisp:1.16 --- fomus/backend_ly.lisp:1.15 Wed Aug 31 16:07:10 2005 +++ fomus/backend_ly.lisp Wed Aug 31 23:17:59 2005 @@ -383,7 +383,10 @@ for (xxx nu ty) in (sort (getprops p :startgroup) #'< :key #'second) do (if ty (ecase ty - (:group (format f "~A\\new ~A <<~%" (make-string in :initial-element #\space) (if (<= nu 1) "StaffGroup" "InnerStaffGroup"))) + ((:group :choirgroup) (format f "~A\\new ~A <<~%" (make-string in :initial-element #\space) + (ecase ty + (:group (if (<= nu 1) "StaffGroup" "InnerStaffGroup")) + (:choirgroup (if (<= nu 1) "ChoirStaff" "InnerChoirStaff"))))) (:grandstaff (format f "~A\\new PianoStaff <<~%" (make-string in :initial-element #\space)))) (format f "~A<<~%" (make-string in :initial-element #\space))) (incf in 2)) Index: fomus/data.lisp diff -u fomus/data.lisp:1.20 fomus/data.lisp:1.21 --- fomus/data.lisp:1.20 Wed Aug 31 17:56:06 2005 +++ fomus/data.lisp Wed Aug 31 23:17:59 2005 @@ -353,7 +353,7 @@ (declaim (type cons +instr-group-tree-type-aux+ +instr-group-tree-type+)) (defparameter +instr-group-tree-type-aux+ - '(or* (satisfies is-instr) (list-of* (cons* (or null (member :group :grandstaff)) (list-of* +instr-group-tree-type-aux+))))) + '(or* (satisfies is-instr) (list-of* (cons* (member :group :choirgroup :grandstaff) (list-of* +instr-group-tree-type-aux+))))) (defparameter +instr-group-tree-type+ '(list-of* (cons* symbol (list-of* +instr-group-tree-type-aux+)))) @@ -385,15 +385,15 @@ (cons :small-ensemble (loop for e in +instruments+ for sy = (instr-sym e) - if (or (eq sy :percussion) (find sy '(:timpani :glockenspiel :xylophone :vibraphone :marimba :chimes :celesta))) collect sy into p + if (or (eq sy :percussion) (find sy '(:timpani :glockenspiel :xylophone :vibraphone :marimba :chimes :celesta))) collect (list :group sy) into p else if (eq sy :organ-manuals) collect '(:group (:grandstaff :organ-manuals) :organ-pedals) into k else if (eq sy :organ-pedals) do (progn nil) else if (= (instr-staves e) 2) collect (list :grandstaff sy) into k else if (find sy '(:soprano :mezzo-soprano :contralto :tenor :tenor-8dn :baritone :bass)) collect sy into v else if (find sy '(:soprano-choir :alto-choir :tenor-choir :bass-choir)) collect sy into c else collect (cons (list :group sy) (/ (+ (instr-minp e) (instr-maxp e)) 2)) into i - finally (return (nconc (list (cons nil (mapcar #'car (sort i #'> :key #'cdr)))) (list (cons nil p)) - v (list (cons :group c)) k)))))) + finally (return (nconc (mapcar #'car (sort i #'> :key #'cdr)) p + (list (cons :choirgroup v)) (list (cons :choirgroup c)) k)))))) (defun make-instrex* (instr) (declare (type instr instr)) @@ -639,11 +639,22 @@ (defun is-restmarksym (sym) (find sym +marks-rests+)) +(declaim (type cons +marks-unimportant+)) +(defparameter +marks-important+ + '(:longtrill :arco :pizz :startgraceslur- :graceslur- :endgraceslur- :startwedge> :startwedge< :wedge- :endwedge- + :rfz :sfz :spp :sp :sff :sf :fp :ffffff :fffff :ffff :fff :ff :f :mf :mp :p :pp :ppp :pppp :ppppp :pppppp + :fermata :arpeggio :glissando :breath :harmonic + :stopped :open :staccato :staccatissimo + :lineprall :prallup :pralldown :downmordent :upmordent :downprall :upprall :prallmordent + :prallprall :mordent :prall :trill :reverseturn :turn :righttoe :lefttoe :rightheel :leftheel + :thumb :flageolet :downbow :upbow :portato :tenuto :marcato :accent :notehead + :startslur- :slur- :endslur- :textnote :textdyn)) + (declaim (type boolean *auto-pizz/arco*)) (defparameter *auto-pizz/arco* t) ;; marks only at beginning or end of tied notes -(declaim (type cons +marks-first-tie+ +marks-last-tie+ +marks-all-ties+ +marks-on-off+ +marks-before-after+ +marks-indiv-voices+ +(declaim (type cons +marks-first-tie+ +marks-last-tie+ #|+marks-all-ties+|# +marks-on-off+ +marks-before-after+ +marks-indiv-voices+ +marks-spanner-voices+ +marks-spanner-staves+ +marks-expand+ +marks-defaultup+)) (defparameter +marks-first-tie+ '(:startslur- :startgraceslur- :start8up- :start8down- :starttext- #|:starttextdyn- :starttexttempo-|# :startwedge< :startwedge> :endgraceslur- @@ -652,14 +663,14 @@ :accent :marcato :tenuto :portato :upbow :downbow :flageolet :thumb :leftheel :rightheel :lefttoe :righttoe :turn :reverseturn :trill :prall :mordent :prallprall :prallmordent :upprall :downprall :upmordent :downmordent :pralldown :prallup :lineprall - :pizz :arco :open :stopped :breath + :pizz :arco :open :stopped :notehead :harmonic :arpeggio :glissando :portamento ; special ones :cautacc :8up :8down :clef)) (defparameter +marks-last-tie+ '(:endslur- :end8up- :end8down- :endtext- #|:endtextdyn- :endtexttempo-|# :endwedge- - :fermata :staccatissimo :staccato)) -(defparameter +marks-all-ties+ - '(:longtrill :tremolo :tremolofirst :tremolosecond)) + :fermata :staccatissimo :staccato :breath)) +;; (defparameter +marks-all-ties+ +;; '(:longtrill :tremolo :tremolofirst :tremolosecond)) (defparameter +marks-on-off+ '((*auto-pizz/arco* . (:pizz . :arco)))) Index: fomus/fomus.asd diff -u fomus/fomus.asd:1.8 fomus/fomus.asd:1.9 --- fomus/fomus.asd:1.8 Tue Aug 30 00:28:03 2005 +++ fomus/fomus.asd Wed Aug 31 23:17:59 2005 @@ -4,7 +4,7 @@ (asdf:defsystem "fomus" :description "Lisp music notation formatter" - :version "0.1.11" + :version "0.1.13" :author "David Psenicka" :licence "LLGPL" Index: fomus/interface.lisp diff -u fomus/interface.lisp:1.5 fomus/interface.lisp:1.6 --- fomus/interface.lisp:1.5 Sun Aug 21 21:17:41 2005 +++ fomus/interface.lisp Wed Aug 31 23:17:59 2005 @@ -40,8 +40,14 @@ `(destructuring-bind (&key ,@(mapcar (lambda (x y) (list x y)) n v) other-keys) args (declare (ignore other-keys)) (progv (quote ,v) (list ,@n) - (fomus-main)))))) - (if allow-other-keys (fma) (fm)))) + (fomus-main))))) + #+(or cmu sbcl) + (wa (&body forms) + `(handler-bind ((style-warning (lambda (x) (declare (ignore x)) (muffle-warning)))) + ,@forms))) + (if allow-other-keys + #+(or cmu sbcl) (wa (fma)) #-(or cmu sbcl) (fma) + #+(or cmu sbcl) (wa (fm)) #-(or cmu sbcl) (fm)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; INTERFACE MULTIPLE FUNCTION CALL Index: fomus/main.lisp diff -u fomus/main.lisp:1.14 fomus/main.lisp:1.15 --- fomus/main.lisp:1.14 Wed Aug 31 17:56:06 2005 +++ fomus/main.lisp Wed Aug 31 23:17:59 2005 @@ -156,6 +156,7 @@ (when (>= *verbose* 2) (out "~&; Cautionary accidentals...")) (cautaccs pts) #+debug (fomus-proc-check pts 'cautaccs)) (when (>= *verbose* 2) (out "~&; Chords...")) + (marks-beforeafter pts) (preproc pts) #+debug (fomus-proc-check pts 'preproc) ; ----- CHORDS, RESTS (clean-ties pts) #+debug (fomus-proc-check pts 'cleanties1) (when (>= *verbose* 2) (out "~&; Splits/ties/rests...")) Index: fomus/marks.lisp diff -u fomus/marks.lisp:1.10 fomus/marks.lisp:1.11 --- fomus/marks.lisp:1.10 Sun Aug 21 21:17:41 2005 +++ fomus/marks.lisp Wed Aug 31 23:17:59 2005 @@ -38,8 +38,8 @@ ;; this will translate the user input format to a more rigid format for the backends (defun clean-spanners (pts spanners) (loop for (startsym contsym endsym) of-type (symbol symbol symbol) in spanners - do (loop for p of-type partex in pts - do (loop + do (loop for p of-type partex in pts do + (loop with ss = (make-hash-table :test 'eql) and nu of-type (integer 0) = 0 for e of-type (or noteex restex) in (reverse (part-events p)) ; go backwards, find endsyms do @@ -74,7 +74,9 @@ (decf nu)) (error "Levels for marks ~S, ~S and ~S are out of order at offset ~S, part ~S" startsym contsym endsym (event-foff e) (part-name p))) (error "Missing ending mark ~S or ~S for starting mark ~S at offset ~S, part ~S" contsym endsym startsym (event-foff e) (part-name p)))))) - finally (or (= nu 0) (error "Missing starting mark ~S in part ~S" startsym (part-name p)))) (print-dot)))) + (loop for l being each hash-value in ss do (addmark e (list contsym l))) + finally (or (= nu 0) (error "Missing starting mark ~S in part ~S" startsym (part-name p)))) + (print-dot)))) (defun expand-marks (pts) (loop for (ma . (rs . re)) of-type (symbol . (symbol . symbol)) in +marks-expand+ do @@ -180,4 +182,29 @@ finally (loop for p of-type partex in pts do (rmprop p :quant) (loop for e of-type (or noteex restex) in (part-events p) do - (setf (event-marks e) (remove-duplicates (event-marks e) :test #'equal)))))) \ No newline at end of file + (setf (event-marks e) (remove-duplicates (event-marks e) :test #'equal)))))) + +(defun marks-beforeafter (pts) + (declare (type list pts)) + (loop with xx for p of-type partex in pts do + (loop for m of-type meas in (part-meas p) do + ;;(loop for g of-type list in (meas-voices m) do + (loop for (e0 e1 e2) of-type (noteex (or noteex null) (or noteex null)) + on (cons nil (remove-if-not #'notep (meas-events m))) while e1 do + (loop for (a . d) of-type (symbol . symbol) in +marks-before-after+ + for k = (force-list (popmark e1 a)) + when k do + (push (cons (ecase (or (second k) d) + (:before e0) + (:after e1)) + (list (first k) :after)) + xx) + (push (cons (ecase (or (second k) d) + (:before e1) + (:after e2)) + (list (first k) :before)) + xx)))) ;) + (print-dot) + finally + (loop for (e . m) of-type ((or noteex restex) . cons) in xx when e do (addmark e m)))) + Index: fomus/parts.lisp diff -u fomus/parts.lisp:1.6 fomus/parts.lisp:1.7 --- fomus/parts.lisp:1.6 Sun Aug 28 23:31:27 2005 +++ fomus/parts.lisp Wed Aug 31 23:17:59 2005 @@ -101,15 +101,15 @@ (loop for l on ll and g on gg and j from i do - (let ((x (cdr (the (cons * symbol) (first l))))) (when x (en lp j x))) - (let ((x (cdr (the (cons * symbol) (first g))))) (when x (ad p j x))) + (let ((x (cdr (the (cons * symbol) (first l))))) (en lp j x)) + (let ((x (cdr (the (cons * symbol) (first g))))) (ad p j x)) finally (loop for ll on l and k from j - do (let ((x (cdr (the (cons * symbol) (first ll))))) (when x (en lp k x)))) + do (let ((x (cdr (the (cons * symbol) (first ll))))) (en lp k x))) (loop for gg on g and k from j - do (let ((x (cdr (the (cons * symbol) (first gg))))) (when x (ad p k x)))))) + do (let ((x (cdr (the (cons * symbol) (first gg))))) (ad p k x))))) (print-dot)) (let ((f (first pts)) (l (last-element pts))) Index: fomus/postproc.lisp diff -u fomus/postproc.lisp:1.10 fomus/postproc.lisp:1.11 --- fomus/postproc.lisp:1.10 Wed Aug 31 16:07:10 2005 +++ fomus/postproc.lisp Wed Aug 31 23:17:59 2005 @@ -413,35 +413,11 @@ for p of-type partex in pts do (loop for m of-type meas in (part-meas p) do (loop for g of-type list in (meas-voices m) do - (loop for e of-type (or noteex restex) in g do (setf (event-marks e) (sort-props (event-marks e))))) + (loop for e of-type (or noteex restex) in g do (setf (event-marks e) (sort-marks (event-marks e))))) (setf (meas-props m) (sort-props (meas-props m)))) (setf (part-props p) (sort-props (part-props p))) (print-dot))) -(defun postproc-marks-beforeafter (pts) - (declare (type list pts)) - (loop with xx for p of-type partex in pts do - (loop for m of-type meas in (part-meas p) do - (loop for g of-type list in (meas-voices m) do - (loop for (e0 e1 e2) of-type ((or noteex restex null) (or noteex restex null) (or noteex restex null)) - on (cons nil g) while e1 do - (loop for (a . d) of-type (symbol . symbol) in +marks-before-after+ - for k = (force-list (popmark e1 a)) - when k do - (push (cons (ecase (or (second k) d) - (:before e0) - (:after e1)) - (list (first k) :after)) - xx) - (push (cons (ecase (or (second k) d) - (:before e1) - (:after e2)) - (list (first k) :before)) - xx))))) - (print-dot) - finally - (loop for (e . m) of-type ((or noteex restex) . cons) in xx when e do (addmark e m)))) - ;; do lots of nice things for the backend functions (defun postproc (pts) (postproc-tremolos pts) @@ -455,6 +431,6 @@ (postproc-graces pts) (postproc-marksonoff pts) (postproc-text pts) - (postproc-marks-beforeafter pts) + ;;(postproc-marks-beforeafter pts) (postproc-barlines pts)) Index: fomus/split.lisp diff -u fomus/split.lisp:1.15 fomus/split.lisp:1.16 --- fomus/split.lisp:1.15 Sun Aug 28 06:32:47 2005 +++ fomus/split.lisp Wed Aug 31 23:17:59 2005 @@ -335,8 +335,8 @@ (declare (type (or noteex restex null) e1 e2) (type cons es)) (if (and (restp e1) (restp e2) (not (find (event-off e2) (event-nomerge e1))) - (equal (list (event-dur* e1) (sort-marks (event-marks e1)) (event-tup e1)) - (list (event-dur* e2) (sort-marks (event-marks e2)) (event-tup e2)))) + (equal (list (event-dur* e1) (sort-marks (important-marks (event-marks e1))) (event-tup e1)) + (list (event-dur* e2) (sort-marks (important-marks (event-marks e2))) (event-tup e2)))) (cons (copy-event e1 :dur (* (event-dur* e1) 2) :tup (cons (when (car (event-tup e1)) Index: fomus/test.lisp diff -u fomus/test.lisp:1.10 fomus/test.lisp:1.11 --- fomus/test.lisp:1.10 Wed Aug 31 17:56:06 2005 +++ fomus/test.lisp Wed Aug 31 23:18:00 2005 @@ -80,7 +80,6 @@ (fomus :backend '(:data (:lilypond :view t)) :ensemble-type :orchestra - :verbose 2 :beat-division 8 :max-tuplet '(7 3) :parts (list @@ -130,36 +129,36 @@ (fomus :backend '((:data) (:lilypond :view t)) - :ensemble-type :orchestra + :ensemble-type :small-ensemble :parts (list (make-part :name "Piano 1" :instr :piano - :events (list (make-note :off 0 :dur 1 :note 60))) + :events (list (make-note :off 4 :dur 1 :note 60))) (make-part :name "Piano 2" :instr :piano - :events (list (make-note :off 0 :dur 1 :note 60))) + :events (list (make-note :off 4 :dur 1 :note 60))) (make-part :name "Flute 1" :instr :flute - :events (list (make-note :off 0 :dur 1 :note 60))) + :events (list (make-note :off 4 :dur 1 :note 60))) (make-part :name "Flute 2" :instr :flute - :events (list (make-note :off 0 :dur 1 :note 60))) + :events (list (make-note :off 4 :dur 1 :note 60))) (make-part :name "Clarinet 1" :instr :bf-clarinet - :events (list (make-note :off 0 :dur 1 :note 60))) + :events (list (make-note :off 4 :dur 1 :note 60))) (make-part :name "Clarinet 2" :instr :bf-clarinet - :events (list (make-note :off 0 :dur 1 :note 60))) + :events (list (make-note :off 4 :dur 1 :note 60))) (make-part :name "Tuba" :instr :tuba - :events (list (make-note :off 0 :dur 1 :note 36))))) + :events (list (make-note :off 4 :dur 1 :note 36))))) ;; Mark objects @@ -788,27 +787,25 @@ (0 :woodblock) (1 :snaredrum))))))) -(let ((*break-on-signals* t)) - (fomus ; :auto-multivoice-notes (not working yet) - :backend '(:lilypond :view t) - :ensemble-type :orchestra - :parts - (list - (make-part - :name "Violin" - :instr :violin - :events - (loop repeat 2 nconc - (loop - for off from 0 to 40 by 1/2 - collect (make-note :off off - :voice '(1 2) - :dur (if (< off 40) 1/2 1) - :note (+ 55 (random 19))))))))) - -(WARN KERNEL:SIMPLE-STYLE-WARNING :FORMAT-CONTROL "Variable ~S defined but never used." :FORMAT-ARGUMENTS ...) +(fomus ; :auto-multivoice-notes + :backend '(:lilypond :view t) + :ensemble-type :orchestra + :auto-multivoice-notes nil + :parts + (list + (make-part + :name "Violin" + :instr :violin + :events + (loop for b in '(55 67) nconc + (loop + for off from 0 to 10 by 1/2 + collect (make-note :off off + :voice '(1 2) + :dur (if (< off 10) 1/2 1) + :note (+ b (random 19)))))))) -(fomus ; :auto-percussion-durs +(fomus ; :auto-percussion-durs :backend '((:data) (:lilypond :view t)) :ensemble-type :orchestra :auto-percussion-durs nil @@ -823,7 +820,7 @@ (0 :woodblock) (1 :snaredrum))))))) -(fomus ; :auto-pizz/arco +(fomus ; :auto-pizz/arco :backend '((:data) (:lilypond :view t)) :ensemble-type :orchestra :beat-division 8 @@ -843,7 +840,7 @@ (0 '(:pizz)) (1 '(:arco)))))) -(fomus ; :auto-override-timesigs +(fomus ; :auto-override-timesigs :backend '((:data) (:lilypond :view t )) :ensemble-type :orchestra :verbose 2 Index: fomus/util.lisp diff -u fomus/util.lisp:1.15 fomus/util.lisp:1.16 --- fomus/util.lisp:1.15 Wed Aug 31 17:56:06 2005 +++ fomus/util.lisp Wed Aug 31 23:18:00 2005 @@ -337,6 +337,11 @@ (declaim (inline sort-marks)) (defun sort-marks (marks) (declare (type list marks)) (sort-props marks)) +(declaim (inline important-marks)) +(defun important-marks (marks) + (declare (type list marks)) + (remove-if-not (lambda (x) (find (first (force-list x)) +marks-important+)) marks)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; CHORDS/SPLITTING @@ -454,7 +459,12 @@ when (and (restp e) (popmark e :splitrt)) do (mapc (lambda (x) (declare (type symbol x)) (rmmark e x)) +marks-first-rest+) when (and (restp e) (popmark e :splitlt)) - do (mapc (lambda (x) (declare (type symbol x)) (rmmark e x)) +marks-last-rest+))) (print-dot))) + do (mapc (lambda (x) (declare (type symbol x)) (rmmark e x)) +marks-last-rest+) + do (loop for sp in (list +marks-spanner-voices+ +marks-spanner-staves+) do + (loop for (startsym contsym endsym) of-type (symbol symbol symbol) in sp + do (loop for (xxx n) in (getmarks e startsym) do (rmmark e (list contsym n))) + do (loop for (xxx n) in (getmarks e endsym) do (rmmark e (list contsym n))))))) + (print-dot))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; STAVES @@ -795,13 +805,13 @@ (if format (labels ((aux (li ta) (let ((br (first li))) - (format t "~A" (case br (:group "[ ") (:grandstaff "{ ") ((nil) "| ") (otherwise " "))) + (format t "~A" (case br (:group "[ ") (:grandstaff "{ ") (:choirgroup "| ") (otherwise " "))) (loop for (e en) on (rest li) if (consp e) do (aux e (+ ta 2)) (if en (format t "~%;~VT" ta) (format t "~A" (case br (:group " ]") (:grandstaff " }") ((nil) " |") (otherwise "")))) else do (if en (format t "~A~%;~VT" e ta) (format t "~A~A" - e (case br (:group " ]") (:grandstaff " }") ((nil) " |") (otherwise "")))))))) + e (case br (:group " ]") (:grandstaff " }") (:choirgroup " |") (otherwise "")))))))) (loop for (e en) on ss do (format t "; ~A~%~%;" (first e)) (aux e 3) when en do (format t "~%~%"))) Index: fomus/version.lisp diff -u fomus/version.lisp:1.7 fomus/version.lisp:1.8 --- fomus/version.lisp:1.7 Wed Aug 31 16:07:10 2005 +++ fomus/version.lisp Wed Aug 31 23:18:00 2005 @@ -12,7 +12,7 @@ (declaim (type string +title+) (type cons +version+ +banner+)) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 12)) +(defparameter +version+ '(0 1 13)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005 David Psenicka, All Rights Reserved" Index: fomus/voices.lisp diff -u fomus/voices.lisp:1.9 fomus/voices.lisp:1.10 --- fomus/voices.lisp:1.9 Tue Aug 30 00:28:04 2005 +++ fomus/voices.lisp Wed Aug 31 23:18:00 2005 @@ -230,7 +230,11 @@ (declare (type cons x)) (mapc (lambda (y) (declare (type restex y)) (setf (event-inv y) t)) ; leave top-most equivalent rest (rest (sort (delete-if #'event-inv x) #'< :key #'event-voice*)))) ; distr-rest function should have left at least one visible voice - (split-into-groups re (lambda (x) (declare (type restex x)) (list (event-staff x) (event-off x) (event-dur* x) (event-tupfrac x) (sort-props (event-marks x)))) :test 'equal))) + (split-into-groups re + (lambda (x) + (declare (type restex x)) + (list (event-staff x) (event-off x) (event-dur* x) (event-tupfrac x) (sort-marks (important-marks (event-marks x))))) + :test 'equal))) (if *auto-multivoice-notes* (setf (meas-events meas) (sort (nconc re @@ -239,8 +243,10 @@ (split-into-groups no (lambda (x) (declare (type noteex x)) (list (event-staff x) (event-off x) (event-dur* x) (event-grace x) (event-tupfrac x) - (delete-if (lambda (x) (declare (type (or symbol cons) x)) (find (if (listp x) (first x) x) +marks-indiv-voices+)) - (sort-props (event-marks x))) + (delete-if (lambda (x) + (declare (type (or symbol cons) x)) + (find (if (listp x) (first x) x) +marks-indiv-voices+)) + (sort-marks (important-marks (event-marks x)))) (event-beamlt x) (event-beamrt x))) :test 'equal))) (mapcan (lambda (x0) ; sequence of adjacent notes to assemble into chords