[fomus-cvs] CVS update: fomus/marks.lisp

[David Psenicka]

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