Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv2615
Modified Files: marks.lisp Log Message: Testing/bug fixes Date: Tue Aug 16 00:41:55 2005 Author: dpsenicka
Index: fomus/marks.lisp diff -u fomus/marks.lisp:1.8 fomus/marks.lisp:1.9 --- fomus/marks.lisp:1.8 Mon Aug 15 21:46:10 2005 +++ fomus/marks.lisp Tue Aug 16 00:41:53 2005 @@ -17,16 +17,19 @@
(defun grace-slurs (pts) (loop - for p in pts do + for p of-type part in pts do (loop - for e in (delete-if (lambda (x) (notany #'event-grace x)) (split-into-groups (part-events p) #'event-off)) + for e of-type cons in (delete-if (lambda (x) (declare (type cons x)) (notany #'event-grace x)) (split-into-groups (part-events p) #'event-off)) for s = (sort e (complement #'sort-offdur)) - do (loop with sl and li - for x in s - when (or (getmark x :endgraceslur-) (getmark x :graceslur-)) - do (if sl (error "Missing :STARTGRACESLUR- mark in offset offset ~S, part ~S" (event-foff e) (part-name p)) (setf sl t)) (when li (addmark (first li) :startgraceslur-) (addmark (last-element li) :endgraceslur-) (setf li nil)) + do (loop with sl of-type boolean and li of-type list + for x of-type (or noteex restex) in s + when (or (getmark x :endgraceslur-) (getmark x :graceslur-)) do + (when sl (error "Missing :STARTGRACESLUR- mark in offset offset ~S, part ~S" (event-foff x) (part-name p))) + (setf sl t) + (when li (addmark (first li) :startgraceslur-) (addmark (last-element li) :endgraceslur-) (setf li nil)) unless sl do (push x li) - when (getmark x :startgraceslur-) do (if sl (setf sl nil) (error "Missing :GRACESLUR-/:ENDGRACESLUR- slur mark in offset ~S, part ~S" (event-foff e) (part-name p))) + when (getmark x :startgraceslur-) do + (if sl (setf sl nil) (error "Missing :GRACESLUR-/:ENDGRACESLUR- slur mark in offset ~S, part ~S" (event-foff x) (part-name p))) finally (when li (addmark (first li) :startgraceslur-) (addmark (last-element li) :endgraceslur-)))) (print-dot)))