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

Modified Files: CHANGELOG TODO backend_ly.lisp data.lisp postproc.lisp splitrules.lisp test.lisp util.lisp version.lisp Log Message: testing/bug fixes Date: Wed Aug 31 16:07:11 2005 Author: dpsenicka

Index: fomus/CHANGELOG diff -u fomus/CHANGELOG:1.9 fomus/CHANGELOG:1.10 --- fomus/CHANGELOG:1.9 Tue Aug 30 00:28:03 2005 +++ fomus/CHANGELOG Wed Aug 31 16:07:10 2005 @@ -1,11 +1,17 @@ +v0.1.12 + + Testing/bug fixes: + nested tuplets + v0.1.11

Testing/bug fixes: errors involving 0 durations parsing user input user rests and rest marks - switching functionality on/off w/ auto- settings - Support for user rests, pizz/arco markings + switching functionality on/off w/ AUTO- settings + user rests, pizz/arco markings + part ordering (parts with grand staves)

v0.1.10

@@ -17,16 +23,16 @@ v0.1.9

Testing/bug fixes + compiling/viewing LilyPond files Added QUALITY setting Eliminated complex score/penalty settings (will replace with simple presets) Other changes to settings - Adjustments to note splitting/tying - Fixed issues with compiling/viewing LilyPond files + Adjustments to note splitting/tying More speed improvements

v0.1.8 and earlier:

Testing/bug fixes + tremolos, text, glissandi/portamenti, arpeggios, harmonics, note heads Some speed improvements (more needed) - Support for tremolos, text, glissandi/portamenti, arpeggios, harmonics, note heads Improved quantize algorithm

Index: fomus/TODO diff -u fomus/TODO:1.16 fomus/TODO:1.17 --- fomus/TODO:1.16 Tue Aug 30 00:28:03 2005 +++ fomus/TODO Wed Aug 31 16:07:10 2005 @@ -12,9 +12,11 @@ Avoid staff changes when notes move in other direction Durations that fill to next/previous note Proofread/finish documentation, add easy examples + Tuplet bracket setting

Short Term:

+ Part properties: override settings for individual parts CMN backend MIDI to percussion Number of lines in staff

Index: fomus/backend_ly.lisp diff -u fomus/backend_ly.lisp:1.14 fomus/backend_ly.lisp:1.15 --- fomus/backend_ly.lisp:1.14 Sun Aug 28 23:31:27 2005 +++ fomus/backend_ly.lisp Wed Aug 31 16:07:10 2005 @@ -169,12 +169,7 @@ do (destructuring-bind (&key (lily-partname (lyname p)) 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)|#) -;; (flet ((lystaff (s) -;; (if (/= s sa) -;; (format nil "\change Staff = ~A " (code-char (+ 64 (setf sa s)))) -;; ""))) + (let ((ns (instr-staves (part-instr p)))) (push lily-partname nms) (format f "~A = {~%" lily-partname) (when (part-name p) (format f " \set Staff.instrument = ~S~%" (part-name p)))

Index: fomus/data.lisp diff -u fomus/data.lisp:1.17 fomus/data.lisp:1.18 --- fomus/data.lisp:1.17 Tue Aug 30 00:28:03 2005 +++ fomus/data.lisp Wed Aug 31 16:07:10 2005 @@ -212,8 +212,8 @@ "Found ~S, expected (INTEGERS 1) or SYMBOLS in the form I, (I (S S I) ...) in CLEFLEGLS slot" t)) (instr-8uplegls (check* (or* null (integer 1) (list* (integer 1) (integer 1))) "Found ~S, expected NIL, (INTEGER 1) or ((INTEGER 1) (INTEGER 1)) in 8UPLEGLS slot" t)) (instr-8dnlegls (check* (or* null (integer 1) (list* (integer 1) (integer 1))) "Found ~S, expected NIL, (INTEGER 1) or ((INTEGER 1) (INTEGER 1)) in 8DNLEGLS slot" t)) - (instr-percs (check* (or null (list-of* (type* *perc-type*))) "Found ~S, expected list of PERC objects in PERCS slot" t)) - (instr-midiprgch-im (check* (or null (integer 0 127) (list-of* (integer 0 127))) + (instr-percs (check* (or* null (list-of* (type* *perc-type*))) "Found ~S, expected list of PERC objects in PERCS slot" t)) + (instr-midiprgch-im (check* (or* null (integer 0 127) (list-of* (integer 0 127))) "Found ~S, expected NIL, (integer 0 127) or list of (integer 0 127) in MIDIPRGCH-IM slot" t)) (instr-midiprgch-ex (check* (or null (integer 0 127)) "Found ~S, expected NIL, (integer 0 127) in MIDIPRGCH-EX slot" t)))))

Index: fomus/postproc.lisp diff -u fomus/postproc.lisp:1.9 fomus/postproc.lisp:1.10 --- fomus/postproc.lisp:1.9 Tue Aug 30 00:28:03 2005 +++ fomus/postproc.lisp Wed Aug 31 16:07:10 2005 @@ -50,7 +50,7 @@ ;; returns ratio to display: (cons num1 num2) (defun tupratio (rat writunit events ts) (declare (type (rational (0)) rat writunit) (type cons events) (type timesig-repl ts)) - (let ((m (loop with x of-type (rational 1) = (max (/ writunit (loop for e of-type (or noteex restex) in events maximize (event-writtendur e ts))) 1) + (let ((m (loop with x of-type rational = (/ writunit (loop for e of-type (or noteex restex) in events maximize (event-writtendur e ts))) for i = 1 then (* i 2) when (>= i x) do (return i)))) (cons (* (numerator rat) m) (* (denominator rat) m))))

@@ -67,17 +67,17 @@ (loop with l = (length *max-tuplet*) with lvl = -1 - and tp = (make-array l :element-type '(integer 0) :initial-element 0) + and tp = (make-array l :element-type '(rational 0 1) :initial-element 0) and uu = (make-array l :element-type '(or (rational (0)) null) :initial-element nil) and ll = (make-array l :element-type 'list :initial-element nil) for e of-type (or noteex restex) in ee - do (loop + do (loop with td = (reverse (event-tupdurmult e)) and i = -1 - for f of-type (rational (0)) in (nreverse (event-tupfrac e)) - and u of-type (rational (0)) in td + for f of-type (rational (0)) in (reverse (event-tupfrac e)) ; larger to smaller + and u of-type (rational (0)) in td ; durmults do (incf i) - when (> i lvl) do (setf (svref uu i) u (svref ll i) nil) ; start + when (> i lvl) do (setf (svref uu i) u (svref ll i) nil) ; start new count when (>= i lvl) do (incf (svref tp i) f) do (push e (svref ll i)) finally @@ -86,17 +86,17 @@ while (and (>= j 0) (>= (svref tp j) 1)) do (setf (svref tp j) 0) - (let* ((el (nreverse (svref ll j))) ; events in order + (let* ((el (reverse (svref ll j))) ; events in order (ef (first el))) (declare (type (or noteex restex) ef)) (addmark ef - (let ((w (unitwritdur (- (event-endoff e) (event-off ef)) (event-tupdurmult e) (meas-timesig m)))) + (let* ((w (unitwritdur (- (event-endoff e) (event-off ef)) (nthcdr (- i j) (event-tupdurmult e)) #|(- i j)|# (meas-timesig m)))) (multiple-value-bind (wr wd) (writtendur* w) - (list :starttup (1+ i) - (tupratio (svref uu j) w el (meas-timesig m)) - (or #|(list1p el)|# ; bracket? - (< j i) ; not innermost - (loop + (list :starttup (1+ j) + (tupratio (svref uu j) w el (meas-timesig m)) ; tupratio as cons + (or ; bracket? + (< j i) ; not innermost--use bracket (make this a setting later) + (loop ; innermost for (x1 x2 x3) of-type ((or (or noteex restex) null) (or (or noteex restex) null) (or (or noteex restex) null)) on (cons nil el) while x2 when (or (if x1 @@ -106,12 +106,12 @@ (or (restp x2) (= (event-beamrt x2) 0)) (and (notep x2) (> (event-beamrt x2) 0)))) do (return t))) - (cons wr wd))))) ; i is tup index, next value is bracket t/nil, next two are written tuplet unit value + (cons wr wd))))) ; i is tup index, next value is bracket t/nil, next cons is written value of tuplet-unit-dur (addmark e (list :endtup (1+ j)))) ; end finally (setf lvl j)))) (loop for e of-type (or noteex restex) in gg do (setf (event-tup e) nil)) - (loop for e of-type (or noteex restex) in ee do (setf (event-tup e) (nreverse (event-tupdurmult e))))) (print-dot)))) + (loop for e of-type (or noteex restex) in ee do (setf (event-tup e) (reverse (event-tupdurmult e))))) (print-dot))))

(defun postproc-graces (pts) (declare (type list pts))

Index: fomus/splitrules.lisp diff -u fomus/splitrules.lisp:1.3 fomus/splitrules.lisp:1.4 --- fomus/splitrules.lisp:1.3 Tue Aug 30 00:28:03 2005 +++ fomus/splitrules.lisp Wed Aug 31 16:07:10 2005 @@ -91,8 +91,7 @@ (declare (type baserule rule) (type (member nil t :s) tups)) (let ((mt (first (if (baseunitp rule) (loop for e on *max-tuplet* for xxx in (rule-tup rule) finally (return e)) - *max-tuplet*))) ; max tuplet for next nesting level - #|(mn (length mt))|#) ; max nesting depth + *max-tuplet*)))) ; max tuplet for next nesting level (flet ((dv2 (n) (declare (type (integer 1) n)) (loop for n2 = (/ n 2) while (integerp n2) do (setf n n2)) @@ -109,7 +108,7 @@ (cons (if (list>1p x) x (first x)) (loop for (e1 e2) of-type ((rational 0 1) (or (rational 0 1) null)) on (cons 0 (append x '(1))) while e2 for ii in (if (listp i) i (list i (- tup i))) and tt = (- e2 e1) and a1 = t then a2 - for a2 = (and (expof2 e2) (expof2 (- tup e2))) collect + for a2 = (or (= e2 1) (and (expof2 e2) (expof2 (- tup e2)))) collect (if (and (<= ii 1) (if (unitp rule) (rule-sim rule) t)) (make-unit-nodiv :tup (cons tt tu) :comp (rule-comp rule) :dmu dmu :tlt t :trt t) (make-unit :div (dv2 ii) :tup (cons tt tu) :dmu dmu :alt a1 :art a2 :irr ir :comp (rule-comp rule) :sim (when (eq tups :s) ii)))))))))) @@ -196,7 +195,7 @@ (list (nconc (list (loop for i from 1/2 below num collect (/ i num)) ; regular off beat syncopation (snd (/ 1/2 num) t nil)) (make-list (- num 1/2) :initial-element (snd (/ num) nil nil)))))))) - (when (and tups mt (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule))) + (when (and tups mt (or (initdivp rule) (and (sigp rule) (rule-top rule)) (and (rule-alt rule) (rule-art rule)))) (loop with nu = (if (rule-comp rule) (* num 3/2) num) for j of-type (integer 2) in (primes2 mt) ; only primes--number isn't actual tuplet, just division @@ -235,10 +234,10 @@ (list (list 1/8 (un 1/8 :l t t) (und 7/8 nil t)))))) (when (and (al *shortlongshort-notes-level*) (rule-alt rule) (rule-art rule) ex) (list (list '(1/4 3/4) (un 1/4 :l t t) (und 1/2 t t) (un 1/4 :r t t)))) ; longer note in middle - (when #|(debugn-if (>= (length (rule-tup rule)) 1) "~A ~A ~A ~A" - tups mt (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule)) - (and tups mt (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule))))|# - (and tups mt (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule))) + (when (and tups mt (or (initdivp rule) (and (sigp rule) (rule-top rule)) + (if (and (baseunitp rule) (rule-tup rule)) + (or (rule-alt rule) (rule-art rule)) + (and (rule-alt rule) (rule-art rule))))) (loop for j of-type (integer 2) in (primes2 mt) ; only primes--number isn't actual tuplet, just division unless (expof2 (/ (rule-div rule) j))

Index: fomus/test.lisp diff -u fomus/test.lisp:1.8 fomus/test.lisp:1.9 --- fomus/test.lisp:1.8 Tue Aug 30 00:28:03 2005 +++ fomus/test.lisp Wed Aug 31 16:07:10 2005 @@ -75,10 +75,10 @@ (0 '(:accent)) (1 '(:staccato))))))

-;; Nested Tuplets (not working yet) +;; Nested Tuplets

(fomus - :backend '((:data) (:lilypond :view t)) + :backend '(:data (:lilypond :view t)) :ensemble-type :orchestra :verbose 2 :beat-division 8 @@ -102,8 +102,6 @@ (0 '(:accent)) (1 '(:staccato))))))

-;; TESTS - ;; Parts with no events

(fomus @@ -128,6 +126,8 @@ :instr :tuba :events nil)))

+;; Part ordering/grouping + (fomus :backend '((:data) (:lilypond :view t)) :ensemble-type :orchestra @@ -788,22 +788,25 @@ (0 :woodblock) (1 :snaredrum)))))))

-(fomus ; :auto-multivoice-notes (not working yet) - :backend '((:data) (:lilypond :view t)) - :ensemble-type :orchestra - :parts - (list - (make-part - :name "Violin" - :instr :violin - :events - (loop repeat 2 nconc - (loop - for off from 0 to 40 by 1/2 - collect (make-note :off off - :voice '(1 2) - :dur (if (< off 40) 1/2 1) - :note (+ 55 (random 19)))))))) +(let ((*break-on-signals* t)) + (fomus ; :auto-multivoice-notes (not working yet) + :backend '(:lilypond :view t) + :ensemble-type :orchestra + :parts + (list + (make-part + :name "Violin" + :instr :violin + :events + (loop repeat 2 nconc + (loop + for off from 0 to 40 by 1/2 + collect (make-note :off off + :voice '(1 2) + :dur (if (< off 40) 1/2 1) + :note (+ 55 (random 19))))))))) + +(WARN KERNEL:SIMPLE-STYLE-WARNING :FORMAT-CONTROL "Variable ~S defined but never used." :FORMAT-ARGUMENTS ...)

(fomus ; :auto-percussion-durs :backend '((:data) (:lilypond :view t))

Index: fomus/util.lisp diff -u fomus/util.lisp:1.13 fomus/util.lisp:1.14 --- fomus/util.lisp:1.13 Tue Aug 30 00:28:04 2005 +++ fomus/util.lisp Wed Aug 31 16:07:10 2005 @@ -269,10 +269,14 @@ (if (notep ev) (max (- (roundint (log (event-writtendur* ev ts) 1/2)) 2) 0) 0))

;; given duration of entire tuplet & dmu list, return unit of tuplet (1/8 = eighth note, etc.) -(defun unitwritdur (dur dmu ts) +(defun unitwritdur (dur dmu ts) ; ndmu = the level that applies (declare (type (rational (0)) dur) (type list dmu) (type timesig-repl ts)) - (/ (* (effectdur dur dmu) (timesig-beat* ts)) + (/ (* (effectdur dur dmu) (timesig-beat* ts)) ; written dur w/o dots info of entire tuplet (numerator (first dmu)))) +;; (loop with re = (* (effectdur dur dmu) (timesig-beat* ts)) ; written dur w/o dots info of entire tuplet +;; repeat (1+ ndmu) for x in dmu +;; do (setf re (/ re (numerator x))) +;; finally (return re)))

(declaim (inline chordp)) (defun chordp (ev)

Index: fomus/version.lisp diff -u fomus/version.lisp:1.6 fomus/version.lisp:1.7 --- fomus/version.lisp:1.6 Tue Aug 30 00:28:04 2005 +++ fomus/version.lisp Wed Aug 31 16:07:10 2005 @@ -12,7 +12,7 @@ (declaim (type string +title+) (type cons +version+ +banner+)) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 11)) +(defparameter +version+ '(0 1 12)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005 David Psenicka, All Rights Reserved"