[fomus-cvs] CVS update: fomus/CHANGELOG fomus/TODO fomus/backend_ly.lisp fomus/data.lisp fomus/postproc.lisp fomus/splitrules.lisp fomus/test.lisp fomus/util.lisp fomus/version.lisp
David Psenicka
dpsenicka at common-lisp.net
Wed Aug 31 14:07:14 UTC 2005
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"
More information about the Fomus-cvs
mailing list