Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv20655 Modified Files: CHANGELOG TODO backend_ly.lisp data.lisp postproc.lisp split.lisp Log Message: Testing/bug fixes Date: Sun Jul 31 09:35:07 2005 Author: dpsenicka Index: fomus/CHANGELOG diff -u fomus/CHANGELOG:1.3 fomus/CHANGELOG:1.4 --- fomus/CHANGELOG:1.3 Sun Jul 31 01:48:54 2005 +++ fomus/CHANGELOG Sun Jul 31 09:35:07 2005 @@ -1,8 +1,11 @@ - Testing/bug fixes - Improved quantize algorithm +CHANGELOG -v0.1.6, 7/29/05 + Testing/bug fixes + Support for text, glissandi/portamenti, arpeggios (not all tested yet) + Improved quantize algorithm - Testing/bug fixes - Support for tremolos - Changed INSTR-VOICELIM slot in INSTR class to INSTR-SIMULTLIM +v0.1.6, 7/29/05: + + Testing/bug fixes + Support for tremolos + Changed INSTR-VOICELIM slot in INSTR class to INSTR-SIMULTLIM Index: fomus/TODO diff -u fomus/TODO:1.10 fomus/TODO:1.11 --- fomus/TODO:1.10 Sun Jul 31 01:48:54 2005 +++ fomus/TODO Sun Jul 31 09:35:07 2005 @@ -1,39 +1,38 @@ -TODO LIST: +TODO LIST -IMMEDIATE +Immediate: -Testing and bug fixes -DOC: dynamic marks can take order arguments (backend might not support it) -DOC: LilyPond options: text-markup textdyn-markup texttempo-markup textnote-markup -DOC: remove :texttempo- and :endtexttempo- and related spanner marks -Adjust scores and penalties for decent results -Note heads -Finish fingering mark (no finger number argument) - - - -SHORT TERM - -Number of lines in staff -Global timesig-repl list -MINP and MAXP instrument ranges -MusicXML backend -CMN backend -MIDI backend -Profile and optimize code for speed -Update comments -Reorganize settings -MIDI input interface -Support for polymeters in backends -Integrate user graceslur overrides -Levels for single text marks -Remove redundant dynamic marks -Easier grace note numbering - - - -LONG TERM - -Features for proportional notation (generate hidden rests of constant duration?) -Key signatures (key detection algorithm) -Combine separately notated sections with different settings into one score (concatenate multiple .fms files?) + Testing and bug fixes + DOC: dynamic marks can take order arguments (backend might not support it) + DOC: LilyPond options: text-markup textdyn-markup texttempo-markup textnote-markup + DOC: remove :texttempo- and :endtexttempo- and related spanner marks + DOC: update text markings + Adjust scores and penalties for better/faster results + Note heads + Harmonics + Finish fingering mark (no finger number argument) + +Short Term: + + Number of lines in staff + Global timesig-repl list + MINP and MAXP instrument ranges + MusicXML backend + CMN backend + MIDI backend + Profile and optimize code for speed + Update comments + Reorganize settings + MIDI input interface + Support for polymeters in backends + Integrate user graceslur overrides + Levels for single text marks + Remove redundant dynamic marks + Easier grace note numbering + When deleting unisons, merge marks + +Long Term: + + Features for proportional notation (generate hidden rests?) + Key signatures (key detection algorithm) + Combine separately notated sections with different settings into one score (concatenate multiple .fms files?) Index: fomus/backend_ly.lisp diff -u fomus/backend_ly.lisp:1.8 fomus/backend_ly.lisp:1.9 --- fomus/backend_ly.lisp:1.8 Sun Jul 31 01:48:54 2005 +++ fomus/backend_ly.lisp Sun Jul 31 09:35:07 2005 @@ -78,7 +78,7 @@ "beamL = #(def-music-function (location num) (number?) #{\\set stemLeftBeamCount = #$num #})" "beamR = #(def-music-function (location num) (number?) #{\\set stemRightBeamCount = #$num #})" "beamLR = #(def-music-function (location numl numr) (number? number?) #{\\set stemLeftBeamCount = #$numl \\set stemRightBeamCount = #$numr #})" "" - "textSpan = #(def-music-function (location dir str) (number? string?) #{\\override TextSpanner #'direction = #$dir \\override TextSpanner #'edge-text = #'($str . \"\") #})" + "textSpan = #(def-music-function (location dir str) (number? string?) #{\\override TextSpanner #'direction = #$dir \\override TextSpanner #'edge-text = #(cons $str \"\") #})" )) (defparameter +lilypond-num-note+ (vector "c" nil "d" nil "e" "f" nil "g" nil "a" nil "b")) @@ -113,7 +113,7 @@ (:fp . "\\fp") (:sf . "\\sf") (:sff . "\\sff") (:sp . "\\sp") (:spp . "\\spp") (:sfz . "\\sfz") (:rfz . "\\rfz"))) (defparameter +lilypond-text+ "\\markup{\\italic{~A}}") -(defparameter +lilypond-textdyn+ "\\markup{\\italic{\\bold{\\huge{~A}}}}") +(defparameter +lilypond-textdyn+ "\\markup{\\dynamic{\\italic{\\bold{~A}}}}") (defparameter +lilypond-texttempo+ "\\markup{\\bold{\\huge{~A}}}") (defparameter +lilypond-textnote+ "\\markup{\\italic{~A}}") @@ -295,15 +295,15 @@ (or textdyn-markup +lilypond-textdyn+) (or texttempo-markup +lilypond-texttempo+) (or textnote-markup +lilypond-textnote+)) - nconc (loop for (xxx str di) in (getmarks e x) + nconc (loop for (xxx di str) in (getmarks e x) collect (conc-strings (ecase di (:up "^") (:down "_")) (format nil m str)))))) - (xs1 (let ((m (getmark e :starttext-))) ; can't have more than one at once - (if m (format nil "\\textSpan #~A #\"~A \" " (ecase (fourth m) (:up 1) (:down -1)) (third e)) ""))) - (xs2 (let ((m (getmark e :starttext-))) + (xs1 (let ((m (getmark e '(:starttext- 1)))) ; can't have more than one at once + (if m (format nil "\\textSpan #~A #\"~A \" " (ecase (third m) (:up 1) (:down -1)) (fourth m)) ""))) + (xs2 (let ((m (getmark e '(:starttext- 1)))) (if m "\\startTextSpan" ""))) - (xs3 (let ((m (or (getmark e :endtext-)))) + (xs3 (let ((m (getmark e '(:endtext- 1)))) (if m "\\stopTextSpan" ""))) (s1 (conc-stringlist (loop Index: fomus/data.lisp diff -u fomus/data.lisp:1.9 fomus/data.lisp:1.10 --- fomus/data.lisp:1.9 Sun Jul 31 01:48:54 2005 +++ fomus/data.lisp Sun Jul 31 09:35:07 2005 @@ -419,13 +419,13 @@ (let* ((x (find* :slur- :endslur-))) (or* (unique* si 1 x) (unique* si 1 (list* x)) (list* x (unique* si integer)))) (let* ((x (find* :textnote :texttempo :textdyn :text))) - (or* (list* x string) (list* x string (find* :up :down)))) ; text + (or* (list* x string) (list* x string (find* :up :down)) (list* x (find* :up :down) string))) ; text (let* ((x (find* :text- :endtext-))) - (or* x (list* x) (list* x (unique* #|tdn|# tx integer)))) + (or* (unique* tx 1 x) (unique* tx 1 (list* x)) (list* x (unique* tx integer)))) (let* ((x (find* :starttext-))) - (cons* x (or* (unique* tx 1 string) - (unique* tx 1 string (find* :up :down)) - (unique* tx 1 (find* :up :down) string) + (cons* x (or* (unique* tx 1 (list* string)) + (unique* tx 1 (list* string (find* :up :down))) + (unique* tx 1 (list* (find* :up :down) string)) (list* string (unique* tx integer)) (list* (unique* tx integer) string) (list* (find* :up :down) string (unique* tx integer)) Index: fomus/postproc.lisp diff -u fomus/postproc.lisp:1.4 fomus/postproc.lisp:1.5 --- fomus/postproc.lisp:1.4 Sun Jul 31 01:48:55 2005 +++ fomus/postproc.lisp Sun Jul 31 09:35:07 2005 @@ -322,18 +322,18 @@ (addmark e2 (list :endtremolo (/ d 2) w)))) (progn (push re ee) (addmark re (list :tremolo d w))))))))))) (push e ee))) - finally - (loop for g in (split-into-groups (setf (meas-events m) (sort ee #'sort-offdur)) #'event-voice*) do - (loop for (a b) on (sort g #'sort-offdur) - when (and b - (or (getmark a :tremolo) (getmark a :starttremolo) (getmark a :endtremolo)) - (or (getmark b :tremolo) (getmark b :starttremolo) (getmark b :endtremolo))) - do - (setf (event-tiert a) (when (consp (event-tiert a)) (make-list (length (event-tiert a)))) - (event-tielt b) (when (consp (event-tielt b)) (make-list (length (event-tielt b))))) - (when (or (getmark a :starttremolo) (getmark a :endtremolo) - (getmark b :starttremolo) (getmark b :endtremolo)) - (setf (event-beamrt a) 0 (event-beamlt b) 0)))))) + finally (setf (meas-events m) (sort ee #'sort-offdur)))) + (loop for g in (split-into-groups (loop for x in (part-meas p) append (meas-events x)) #'event-voice*) do + (loop for (a b) on (sort g #'sort-offdur) + when (and b + (or (getmark a :tremolo) (getmark a :starttremolo) (getmark a :endtremolo)) + (or (getmark b :tremolo) (getmark b :starttremolo) (getmark b :endtremolo))) + do + (setf (event-tiert a) (when (consp (event-tiert a)) (make-list (length (event-tiert a)))) + (event-tielt b) (when (consp (event-tielt b)) (make-list (length (event-tielt b))))) + (when (or (getmark a :starttremolo) (getmark a :endtremolo) + (getmark b :starttremolo) (getmark b :endtremolo)) + (setf (event-beamrt a) 0 (event-beamlt b) 0)))) (print-dot) finally (when fx (clean-ties pts)))) @@ -355,15 +355,23 @@ (> (event-endoff x) (event-off a)) (< (event-off x) (event-endoff a))) collect (event-voice* x))) - count (< y o) into u - count (> y o) into d + count (< y o) into u ; number of voices above text note + count (> y o) into d ; number of voices below text note finally (cond ((= d u) - (addmark e (cons (first tx) (cons - (if (find (first tx) +marks-defaultup+) :up :down) - (rest tx))))) - ((< d u) (addmark e (cons (first tx) (cons :down (rest tx))))) - ((> d u) (addmark e (cons (first tx) (cons :up (rest tx)))))))))) (print-dot))) + (addmark e (cons (first tx) + (nconc + (let ((x (find-if #'numberp tx))) (when x (list x))) + (list (or (find :up tx) (find :down tx) (if (find (first tx) +marks-defaultup+) :up :down)) + (find-if #'stringp tx)))))) + ((< d u) (addmark e (cons (first tx) + (nconc + (let ((x (find-if #'numberp tx))) (when x (list x))) + (list :down (find-if #'stringp tx)))))) + ((> d u) (addmark e (cons (first tx) + (nconc + (let ((x (find-if #'numberp tx))) (when x (list x))) + (list :up (find-if #'stringp tx))))))))))) (print-dot))) ;; not included with other postprocs here--in fomus-proc function (defun postpostproc-sortprops (pts) Index: fomus/split.lisp diff -u fomus/split.lisp:1.9 fomus/split.lisp:1.10 --- fomus/split.lisp:1.9 Sun Jul 31 07:39:32 2005 +++ fomus/split.lisp Sun Jul 31 09:35:07 2005 @@ -148,7 +148,10 @@ (multiple-value-bind (e n) (split-preproc (nconc r (meas-events m)) (meas-off m) (meas-endoff m) (let ((i (find-if #'meas-events (part-meas p)))) (if i (event-voice* (first (meas-events i))) 1))) - (setf (meas-events m) e r n))))) + (setf (meas-events m) e + r (loop for x in n if (chordp x) + nconc (mapcar (lambda (y t1 t2) (copy-event x :note y :tielt t1 :tiert t2)) + (event-note x) (event-tielt x) (event-tiert x)) else collect x)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SPLITTER