[fomus-cvs] CVS update: fomus/CHANGELOG fomus/TODO fomus/backend_ly.lisp fomus/data.lisp fomus/postproc.lisp fomus/split.lisp
David Psenicka
dpsenicka at common-lisp.net
Sun Jul 31 07:35:11 UTC 2005
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
More information about the Fomus-cvs
mailing list