Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv10374

Modified Files: README TODO backend_ly.lisp backends.lisp data.lisp main.lisp marks.lisp package.lisp postproc.lisp quantize.lisp split.lisp voices.lisp Log Message: Testing/bug fixes Date: Mon Jul 25 09:56:03 2005 Author: dpsenicka

Index: fomus/README diff -u fomus/README:1.1 fomus/README:1.2 --- fomus/README:1.1 Thu Jul 21 17:38:42 2005 +++ fomus/README Mon Jul 25 09:56:03 2005 @@ -2,12 +2,15 @@ Lisp music notation formatter

Fomus is alpha software, and still has a lot of testing and bug fixing to go -before all of its features are useable. +before all of its features are useable. Not all features that appear in the +documentation are implemented yet. Also, some parts of the program are running +slowly due to some settings being currently set to conservative values.

See the file "fomus.html" in the doc directory for instructions on how to use the program. The following command loads FOMUS into lisp:

(load "path_to_fomus_directory/load.lisp") + (use-package fm)

The program is being developed in SBCL, but should also compile in CMUCL and OpenMCL. It will eventually be supported in Allegro Common Lisp and CLISP.

Index: fomus/TODO diff -u fomus/TODO:1.3 fomus/TODO:1.4 --- fomus/TODO:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/TODO Mon Jul 25 09:56:03 2005 @@ -3,12 +3,15 @@ IMMEDIATE

Testing and bug fixes -BUG: :startslur- and :slur- marks +Information on anonymous CVS downloading BUG: error in beams in CMUCL -DOC: dynamics marks can take order arguments (backend might not support it) -DOC: make sure user knows to use the package -DOC: make sure user knows about :default-beat setting +DOC: dynamic marks can take order arguments (backend might not support it) +DOC: other interface functions +DOC: part properties Adjust scores and penalties for decent results +Breath marks (resolve before/after) +Noteheads +Fix fingering mark (no finger number argument)

@@ -24,6 +27,9 @@ Reorganize settings MIDI input interface Support for polymeters in backends +Integrate user graceslur overrides +Levels for single text marks +Remove redundant dynamic marks

Index: fomus/backend_ly.lisp diff -u fomus/backend_ly.lisp:1.3 fomus/backend_ly.lisp:1.4 --- fomus/backend_ly.lisp:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/backend_ly.lisp Mon Jul 25 09:56:03 2005 @@ -43,7 +43,7 @@ (defparameter +lilypond-out-ext+ "ps") (defparameter +lilypond-view-opts+ #-darwin nil #+darwin '("/Applications/Preview.app"))

-(defun view-lilypond (filename options) +(defun view-lilypond (filename options view) (when (>= *verbose* 1) (out ";; Compiling/opening "~A" for viewing...~%" filename)) (destructuring-bind (xxx &key exe view-exe exe-opts view-exe-opts out-ext &allow-other-keys) options (declare (ignore xxx)) @@ -58,10 +58,11 @@ (append (or exe-opts +lilypond-opts+) (list filename)) :wait t #|:output *standard-output*|#) (progn (unless (probe-file (change-filename filename :ext (or out-ext +lilypond-out-ext+))) (er "compiling")) - (unless (#+cmu extensions:run-program #+sbcl sb-ext:run-program #+openmcl ccl:run-program (or view-exe +lilypond-view-exe+) - (append (or view-exe-opts +lilypond-view-opts+) (list (change-filename filename :ext (or out-ext +lilypond-out-ext+)))) - :wait nil #|:output *standard-output*|#) - (er "viewing"))) + (when view + (unless (#+cmu extensions:run-program #+sbcl sb-ext:run-program #+openmcl ccl:run-program (or view-exe +lilypond-view-exe+) + (append (or view-exe-opts +lilypond-view-opts+) (list (change-filename filename :ext (or out-ext +lilypond-out-ext+)))) + :wait nil #|:output *standard-output*|#) + (er "viewing")))) (er "compiling"))) #-(and (or cmu sbcl openmcl) (or linux darwin unix)) (format t ";; ERROR: Don't know how to compile/view lilypond file~%"))))

@@ -109,7 +110,7 @@

;; TODO: support texts, spanners and tremelos, remove dependency on ACCIDENTALYS

-(defun save-lilypond (parts filename options view) +(defun save-lilypond (parts filename options process view) (when (>= *verbose* 1) (out ";; Saving Lilypond file "~A"...~%" filename)) (with-open-file (f filename :direction :output :if-exists :supersede) (destructuring-bind (xxx &key filehead scorehead &allow-other-keys) options @@ -144,7 +145,7 @@ (loop for p in parts do (destructuring-bind (&key (lily-partname (lyname p)) - parthead ;; extra header information for part (list of strings) + lily-parthead ;; extra header information for part (list of strings) &allow-other-keys) (part-opts p) (let ((ns (instr-staves (part-instr p))) (sa 1)) @@ -170,7 +171,7 @@ (loop for (xxx cl s) in (sort (getprops p :clef) #'< :key #'third) do (format f " ~A\clef ~A~%" (lystaff s) (lyclef cl))) (format f " \clef ~A~%" (lyclef (second (getprop p :clef))))) - (loop for e in parthead do (format f " ~A~%" e)) + (loop for e in lily-parthead do (format f " ~A~%" e)) (format f "~%") (loop for m in (part-meas p) and mn from 1 @@ -336,5 +337,5 @@ for xxx in (getprops p :endgroup) do (decf in 2) (format f "~A>>~%" (make-string in :initial-element #\space)))) (format f "}~%"))))) - (when view (view-lilypond filename options))) + (when process (view-lilypond filename options view)))

Index: fomus/backends.lisp diff -u fomus/backends.lisp:1.1.1.1 fomus/backends.lisp:1.2 --- fomus/backends.lisp:1.1.1.1 Tue Jul 19 20:16:55 2005 +++ fomus/backends.lisp Mon Jul 25 09:56:03 2005 @@ -21,9 +21,9 @@ (prin1 parts f) (fresh-line f)))

-(defun backend (backend filename parts options view) +(defun backend (backend filename parts options process view) (case backend (:data (save-data filename parts)) - (:lilypond (save-lilypond parts filename options view)) + (:lilypond (save-lilypond parts filename options process view)) (otherwise (error "Unknown backend ~A" backend))))

Index: fomus/data.lisp diff -u fomus/data.lisp:1.3 fomus/data.lisp:1.4 --- fomus/data.lisp:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/data.lisp Mon Jul 25 09:56:03 2005 @@ -31,7 +31,7 @@ (defparameter *min-tuplet-dur* 1/2) ; fraction of beat smallest tuplets should span at minimum (1/2 = half a beat, etc.)--can be nil (defparameter *max-tuplet-dur* 4)

-(defparameter *default-beat* nil) +(defparameter *default-beat* 1/4)

;; pitch quantizing (declaim (special *note-precision*)) @@ -304,7 +304,7 @@ (:timesig-style (or* null (find* :fraction :common)) ":FRACTION or :COMMON") (:tuplet-style (or* null (find* :ratio :single)) ":RATIO or :SINGLE")

- (:quantize-adjust-grace-durs boolean) + ;;(:quantize-adjust-grace-durs boolean) (:default-grace-dur (rational (0))) (:default-grace-num integer) (:effective-grace-dur-mul (rational (0)))

(:min-auto-timesig-dur (rational (0))) (:default-timesig (type* +timesig-repl-type+) "TIMESIG object") @@ -314,6 +314,7 @@ (:auto-ottavas boolean) (:auto-grace-slurs boolean) (:auto-voicing boolean) (:auto-beams boolean) (:auto-quantize boolean) (:auto-multivoice-rests boolean) (:auto-multivoice-notes boolean) (:auto-override-timesigs boolean) + (:auto-pizz/arco boolean)

(:split-fun symbol) (:auto-accs-fun symbol) (:auto-voices-fun symbol) (:auto-distr-rests-fun symbol) (:auto-multivoice-comb-fun symbol) (:auto-ottavas-fun symbol) (:auto-beam-fun symbol) (:auto-quantize-fun symbol) @@ -331,7 +332,7 @@ (:tuplet-dotted-rests boolean) (:double-dotted-notes boolean) (:dotted-note-level (find* t :all :top :sig) "T, :ALL, :TOP or :SIG") (:shortlongshort-notes-level (find* t :all :top :sig) "T, :ALL, :TOP or :SIG") - (:syncopated-notes-level (find* t :all :top :sig) "T, :ALL, :TOP or :SIG") + (:syncopated-notes-level boolean)

(:acc-engine-heap (integer 100)) (:acc-importance-score (real (0) 1)) (:acc-importance-steps (integer 1)) (:voice-engine-heap (integer 100)) (:voice-importance-score (real (0) 1)) (:voice-importance-steps (integer 1)) @@ -391,7 +392,7 @@ (or* (unique* sy :glissbefore x) (list* (unique* sy :glissbefore x)) (list* (unique* sy :glissbefore x) (eql* :before)) (list* (unique* sy :glissafter x) (eql* :after)))) (let* ((x (find* :breath))) - (or* (unique* sy :breathbefore x) (list* (unique* sy :breathbefore x)) + (or* (unique* sy :breathafter x) (list* (unique* sy :breathafter x)) (list* (unique* sy :breathbefore x) (eql* :before)) (list* (unique* sy :breathafter x) (eql* :after)))) (let* ((x (find* :harmonic))) (or* (cons* (unique* sy :harmtouched x) @@ -494,8 +495,10 @@ (defparameter +marks-all-ties+ '(:longtrill :tremolo :lefthandtremolo :righthandtremolo))

+(defparameter *auto-pizz/arco* t) + (defparameter +marks-on-off+ - '((:pizz . :arco))) + '((*auto-pizz/arco* . (:pizz . :arco))))

;; marks that prevent notes from combining into chords if they differ (defparameter +marks-indiv-voices+

Index: fomus/main.lisp diff -u fomus/main.lisp:1.3 fomus/main.lisp:1.4 --- fomus/main.lisp:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/main.lisp Mon Jul 25 09:56:03 2005 @@ -58,7 +58,7 @@ (multiple-value-bind (*timesigs* *keysigs* rm) (split-list *global* #'timesigp #'keysigp) #-debug (declare (ignore rm)) #+debug (when rm (error "Error in FOMUS-PROC")) - (multiple-value-bind (mks *events*) (split-list *events* #'markp) + (multiple-value-bind (*events* mks) (split-list *events* (lambda (x) (or (notep x) (restp x)))) (let ((pts (progn (loop for p in *parts* and i from 0 do (multiple-value-bind (ti ke evs ma) (split-list (part-events p) #'timesigp #'keysigp @@ -124,23 +124,20 @@ (reset-tempslots pts 0) (distribute-marks pts mks) (setf pts (sep-staves pts)) ; ********** STAVES SEPARATED - (if *auto-quantize* (clean-quantize pts)) + ;;(if *auto-quantize* (clean-quantize pts)) (when *auto-ottavas* ; (before clean-spanners) (when (>= *verbose* 2) (out "~&; Ottavas...")) (ottavas pts) #+debug (fomus-proc-check pts 'ottavas)) (when (>= *verbose* 2) (out "~&; Staff spanners...")) (clean-spanners pts +marks-spanner-staves+) #+debug (fomus-proc-check pts 'spanners1) - ;; (setf pts (sep-voices pts)) #+debug (fomus-proc-check pts 'sepvoices) (setf pts (sep-voices (assemble-parts pts))) ; ********** STAVES TOGETHER, VOICES SEPARATED (when (>= *verbose* 2) (out "~&; Voice spanners...")) (expand-marks pts) #+debug (fomus-proc-check pts 'expandmarks) (clean-spanners pts +marks-spanner-voices+) #+debug (fomus-proc-check pts 'spanners2) - (when (and (>= *verbose* 2) (and *auto-grace-slurs* *auto-cautionary-accs*)) - (out "~&; Voice items...")) + (when (>= *verbose* 2) (out "~&; Miscellaneous items...")) (preproc-cautaccs pts) (when *auto-grace-slurs* (grace-slurs pts) #+debug (fomus-proc-check pts 'graceslurs)) - ;; (setf pts (sep-voices (assemble-parts pts))) (when (>= *verbose* 2) (out "~&; Measures...")) (init-parts *timesigs* pts) ; ----- MEASURES #+debug (fomus-proc-check pts 'measures) @@ -184,7 +181,7 @@ (defun fomus-main () (let ((r (fomus-proc))) (loop for x in (or (force-list2 *backend*) '((:data))) - do (destructuring-bind (ba &key filename view &allow-other-keys) x - (backend ba (or filename (change-filename *base-filename* :ext (lookup ba +backendexts+))) r x view)))) + do (destructuring-bind (ba &key filename process view &allow-other-keys) x + (backend ba (or filename (change-filename *base-filename* :ext (lookup ba +backendexts+))) r x (or process view) view)))) t)

Index: fomus/marks.lisp diff -u fomus/marks.lisp:1.3 fomus/marks.lisp:1.4 --- fomus/marks.lisp:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/marks.lisp Mon Jul 25 09:56:03 2005 @@ -17,13 +17,17 @@ (defun grace-slurs (pts) (loop for p in pts do - (loop for e in (part-events p) do (rmmark e :startgraceslur-) (rmmark e :graceslur-) (rmmark e :endgraceslur-)) (loop for e in (delete-if (lambda (x) (notany #'event-grace x)) (split-into-groups (part-events p) #'event-off)) - for s = (sort e #'sort-offdur) - do - (addmark (first s) :startgraceslur-) - (addmark (find-if-not #'event-grace s) :endgraceslur-)) + 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 part ~A, offset ~A" (part-name p) (event-foff e)) (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 part ~A, offset ~A" (part-name p) (event-foff e))) + finally + (when li (addmark (first li) :startgraceslur-) (addmark (last-element li) :endgraceslur-)))) (print-dot)))

;; must be in separate voices @@ -134,7 +138,11 @@ (if (null vo) l (remove-if-not (lambda (e) (find (event-voice* e) vo)) l))))) (if re r (remove-if #'restp r))))) (let ((o (let ((q (getprop p :quant))) ; fix quantize error - (if q (let ((x (find-if (lambda (x) (and (<= (car x) o0) (>= (cdr x) o0))) (rest q)))) + (if q (let ((x (find-if (lambda (x) (and (funcall (caar x) o0) + (if (< (cdar x) (cdr x)) + (< o0 (cdr x)) ; --> + (> o0 (cdr x))))) ; <-- + (rest q)))) (if x (cdr x) o0)) o0)))) (if di

Index: fomus/package.lisp diff -u fomus/package.lisp:1.3 fomus/package.lisp:1.4 --- fomus/package.lisp:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/package.lisp Mon Jul 25 09:56:03 2005 @@ -53,7 +53,7 @@ (use-package "DBG" "FM")))

(defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 2)) +(defparameter +version+ '(0 1 3)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005 David Psenicka, All Rights Reserved"

Index: fomus/postproc.lisp diff -u fomus/postproc.lisp:1.1.1.1 fomus/postproc.lisp:1.2 --- fomus/postproc.lisp:1.1.1.1 Tue Jul 19 20:16:59 2005 +++ fomus/postproc.lisp Mon Jul 25 09:56:03 2005 @@ -241,7 +241,7 @@ (addprop m (list :barline :final)))) (print-dot)))

(defun postproc-marksonoff (pts) - (loop for (a . b) in +marks-on-off+ do + (loop for (v . (a . b)) in +marks-on-off+ when (symbol-value v) do (loop with o for p in pts do (loop for m in (part-meas p) do (loop for g in (meas-voices m) do

Index: fomus/quantize.lisp diff -u fomus/quantize.lisp:1.2 fomus/quantize.lisp:1.3 --- fomus/quantize.lisp:1.2 Thu Jul 21 17:38:43 2005 +++ fomus/quantize.lisp Mon Jul 25 09:56:03 2005 @@ -80,7 +80,7 @@ collect (adj (dv o (loop for i in ep when (<= i os) collect i) e1 ts) (dv os (loop for i in ep when (>= i os) collect i) e2 ts)))))))) (loop for p in parts - for ph = (gethash p h) + for ph = (gethash p h) ; ph = timesigs for part do (let* ((ee (sort (delete-duplicates (loop for e in (part-events p) collect (event-off e) collect (event-endoff e))) #'<)) (qs (sort (delete-duplicates @@ -102,38 +102,56 @@ (let ((o (event-off e))) (loop while (and (list>1p qs) (< (second qs) o)) do (pop qs)) (let ((e1 (loop-return-firstmin (diff x o) for x in qs))) - (if (event-grace e) + (flet ((aa (oo ee) + (cond ((< oo ee) (push (cons (cons #'>= oo) ee) ad)) ; --> + ((> oo ee) (push (cons (cons #'< oo) ; <-- + (loop for (x1 x2) on qs until (or (null x2) (>= x2 ee)) + finally (return x1))) + ad))))) + (if (event-grace e) (progn - (push (cons (event-off e) e1) ad) + (cond ((< (event-off e) e1) (push (cons (cons #'>= (event-off e)) e1) ad)) ; --> + ((> (event-off e) e1) (push (cons (cons #'<= (event-off e)) e1) ad))) ; <-- (setf (event-off e) e1 (event-dur* e) (let ((bd (/ (beat-division (loop for s in ph until (<= (timesig-off s) e1) finally (return s)))))) (let ((x (roundto (event-gracedur e) bd))) (when (<= x 0) bd x))))) (let ((e2 (let ((o (event-endoff e))) (loop-return-lastmin (diff x o) for x in qs)))) - (push (cons (event-off e) e1) ad) + (aa (event-off e) e1) (setf (event-off e) e1) (let ((x (- e2 e1))) (if (<= x 0) (progn - (addmark e :grace) + (debugn "gr: ~A" e) + (aa (event-endoff e) e1) + ;; (addmark e :grace) (setf (event-dur e) - (cons (- (loop for i in qs until (> i e1) finally (return i)) e1) + (cons *default-grace-dur* #|(- (loop for i in qs until (> i e1) finally (return i)) e1)|# (incf mg)))) (progn - (push (cons (event-endoff e) e2) ad) - (setf (event-dur* e) x)))))))) + (aa (event-endoff e) e2) + (setf (event-dur* e) x))))))))) finally - (addprop p (cons :quant - (merge-all ad (lambda (x y) (let ((x1 (car x)) (x2 (cdr x)) - (y1 (car y)) (y2 (cdr y))) - (when (= x2 y2) - (cons (if (< x1 x2) - #+debug (if (<= y1 y2) (min x1 y1) (error "Error in QUANTIZE-BYFIT 3")) - #-debug (min x1 y1) - #+debug (if (>= y1 y2) (max x1 y1) (error "Error in QUANTIZE-BYFIT 4")) - #-debug (max x1 y1)) - x2)))) - :call-rev nil)))))) + (addprop p (cons :quant ; temporary prop: collection of all point movements + (merge-all ad (lambda (x y) (let ((x1 (cdar x)) (x2 (cdr x)) + (y1 (cdar y)) (y2 (cdr y))) + (cond ((and (< x1 x2) (< y1 y2)) ; --> + (when (and (>= x2 y1) (>= y2 x1)) ; always #'>= + (cons (if (< x1 y1) (car x) (car y)) + (max x2 y2)))) + ((and (> x1 x2) (> y1 y2)) ; <-- + (cond ((or (and (> x1 y2) (> y1 x2)) ; overlap + (and (= x1 y2) (eq (caar x) #'<=)) ; touching + (and (= y1 x2) (eq (caar y) #'<=))) + (cons (cond ((= x1 y1) (cons (if (or (eq (caar x) #'<=) + (eq (caar y) #'<=)) + #'<= #'<) + x1)) + ((> x1 y1) (car x)) + (t (car y))) + (min x2 y2)))))))) + :call-rev nil))) + (setf (part-events p) (sort (part-events p) #'sort-offdur))))) (print-dot)))))

(defun quantize (timesigs parts) @@ -141,24 +159,27 @@ (:quantize1 (quantize-byfit timesigs parts)) (otherwise (error "Unknown quantize function ~A" *auto-quantize-fun*))))

-(defparameter *quantize-adjust-grace-durs* t) +;; (defparameter *quantize-adjust-grace-durs* t)

-(defun clean-quantize (parts) - (loop for p in parts do - (loop for v in (split-into-groups (part-events p) #'event-voice*) do - (when *quantize-adjust-grace-durs* - (loop with d - for e in (sort (copy-list v) (complement #'sort-offdur)) - if (getmark e :grace) - do (setf (event-dur* e) (if d (min d *default-grace-dur*) *default-grace-dur*)) - else if (event-grace e) do (setf d nil) else do (setf d (event-dur* e)))) - (loop with g and di = (>= *default-grace-num* 0) ; di = t if forward and default grace >= 0 - for e in (sort v (if di #'sort-offdur (complement #'sort-offdur))) - if (popmark e :grace) - do (setf (event-grace* e) (setf g (if g - (if di (max (1+ g) *default-grace-num*) (min (1- g) *default-grace-num*)) - *default-grace-num*))) - else if (event-grace e) do (setf g (event-grace e)))))) +;; (defun clean-quantize (parts) +;; (when *quantize-adjust-grace-durs* +;; (loop for p in parts do +;; (loop for v in (split-into-groups (part-events p) #'event-voice*) do +;; (loop with d and do +;; for e in (sort (copy-list v) (complement #'sort-offdur)) +;; if (and d (getmark e :grace) (eql (event-off e) do)) +;; do (setf (event-dur* e) (let for x = *default-grace-dur* then (/ x 2) until (<= x d) finally (return x))) +;; else if (notep e) do (setf d (event-dur* e)) +;; else do (setf d nil) +;; do (setf do (event-off e)))) +;; ;; (loop with g and di = (>= *default-grace-num* 0) ; di = t if forward and default grace >= 0 +;; ;; for e in (sort v (if di #'sort-offdur (complement #'sort-offdur))) +;; ;; if (popmark e :grace) +;; ;; do (setf (event-grace* e) (setf g (if g +;; ;; (if di (max (1+ g) *default-grace-num*) (min (1- g) *default-grace-num*)) +;; ;; *default-grace-num*))) +;; ;; else if (event-grace e) do (setf g (event-grace e))) +;; )))

(defun quantize-generic (parts) (loop for p in parts do

Index: fomus/split.lisp diff -u fomus/split.lisp:1.2 fomus/split.lisp:1.3 --- fomus/split.lisp:1.2 Sat Jul 23 11:23:14 2005 +++ fomus/split.lisp Mon Jul 25 09:56:03 2005 @@ -144,6 +144,14 @@ (setf gs (loop for e in (split-into-groups gs (lambda (x) (cons (event-off x) (event-grace x))) :test 'equal) ; put vertical notes into chords (note = list of notes, combine all attributes) if (list>1p e) collect (make-chord e) else collect (first e))) + (loop ; split places at grace note offsets + for g in gs + for i = (event-off g) + do (setf ns (loop + for e in ns + for (j . k) = (split-event e i) + when j collect j + when k collect k))) (loop for e in (nconc gs ns) ; separate notes belonging to next measure--notes after endoff already split if (< (event-off e) endoff) collect e into v1 @@ -505,7 +513,7 @@ (let ((x (sort (copy-list li) (complement #'sort-offdur)))) (setf li (ex (second x) (first x) x)))))) li)) - (let ((lm (/ (* (beat-division timesig) 4)))) + (let ((lm (/ (* (beat-division timesig) 65536)))) (flet ((scorefun (nd) ; score relative to ea. level (if (splitnode-pts nd) (loop @@ -588,10 +596,10 @@ (mn (drst (loop for e in nds append (splitnode-evs e)) rl))))))) (solutfun (nd) ; complete/valid? (if (splitnode-pts nd) - (let ((x (splitnode-rl nd))) - (every (lambda (n) (or (truep n) (split-valid n off endoff x))) (splitnode-evs nd))) - (or (truep (splitnode-evs nd)) - (split-valid (splitnode-evs nd) off endoff (splitnode-rl nd)))))) + (let ((x (splitnode-rl nd))) + (every (lambda (n) (or (truep n) (split-valid n off endoff x))) (splitnode-evs nd))) + (or (truep (splitnode-evs nd)) + (split-valid (splitnode-evs nd) off endoff (splitnode-rl nd)))))) (multiple-value-bind (evs grs) (loop for p in events

Index: fomus/voices.lisp diff -u fomus/voices.lisp:1.1.1.1 fomus/voices.lisp:1.2 --- fomus/voices.lisp:1.1.1.1 Tue Jul 19 20:16:55 2005 +++ fomus/voices.lisp Mon Jul 25 09:56:03 2005 @@ -148,7 +148,7 @@ :heaplim *voice-engine-heap* :scoregreaterfun #'scoregreaterfun :remscoregreaterfun #'remscoregreaterfun))) - (error "Cannot find voice distribution for part ~A" name)))))) + (error "Cannot distribute voices for part ~A" name))))))

(defun voices-setvoice (events) (loop for e in events when (listp (event-voice e)) do