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)))
