[fomus-cvs] CVS update: fomus/CHANGELOG fomus/TODO fomus/backend_ly.lisp fomus/data.lisp fomus/fomus.asd fomus/interface.lisp fomus/main.lisp fomus/marks.lisp fomus/parts.lisp fomus/postproc.lisp fomus/split.lisp fomus/test.lisp fomus/util.lisp fomus/version.lisp fomus/voices.lisp
David Psenicka
dpsenicka at common-lisp.net
Wed Aug 31 21:18:06 UTC 2005
Update of /project/fomus/cvsroot/fomus
In directory common-lisp.net:/tmp/cvs-serv20725
Modified Files:
CHANGELOG TODO backend_ly.lisp data.lisp fomus.asd
interface.lisp main.lisp marks.lisp parts.lisp postproc.lisp
split.lisp test.lisp util.lisp version.lisp voices.lisp
Log Message:
testing/bug fixes
Date: Wed Aug 31 23:18:00 2005
Author: dpsenicka
Index: fomus/CHANGELOG
diff -u fomus/CHANGELOG:1.10 fomus/CHANGELOG:1.11
--- fomus/CHANGELOG:1.10 Wed Aug 31 16:07:10 2005
+++ fomus/CHANGELOG Wed Aug 31 23:17:59 2005
@@ -1,3 +1,10 @@
+v0.1.13
+
+ Testing/bug fixes:
+ BACKEND setting
+ combining notes from multiple voices into one
+ default part orderings/groupings
+
v0.1.12
Testing/bug fixes:
Index: fomus/TODO
diff -u fomus/TODO:1.18 fomus/TODO:1.19
--- fomus/TODO:1.18 Wed Aug 31 17:56:06 2005
+++ fomus/TODO Wed Aug 31 23:17:59 2005
@@ -3,19 +3,19 @@
Immediate:
Testing and bug fixes
- Nested tuplets not working yet
- Automatic multivoice notes not working yet
Splitting chords across staves (LilyPond)
- :STAFF and other marks for overriding FOMUS's decisions
+ STAFF, CLEF and other marks for overriding FOMUS's decisions
MusicXML backend
MIDI output to CM
Durations that fill to next/previous note
- Proofread/finish documentation, add easy examples
+ Proofread/finish documentation:
+ most often used settings
+ easy, indexed examples of all features
Tuplet bracket setting
- DOC: :instruments setting update
+ Marks affecting all voices
Aesthetic tweaks:
- Avoid staff changes when notes move in other direction
- Re-evaluate initial clef decision in measure 1
+ avoid staff changes when notes move in other direction
+ re-evaluate initial clef decision in measure 1
Short Term:
Index: fomus/backend_ly.lisp
diff -u fomus/backend_ly.lisp:1.15 fomus/backend_ly.lisp:1.16
--- fomus/backend_ly.lisp:1.15 Wed Aug 31 16:07:10 2005
+++ fomus/backend_ly.lisp Wed Aug 31 23:17:59 2005
@@ -383,7 +383,10 @@
for (xxx nu ty) in (sort (getprops p :startgroup) #'< :key #'second) do
(if ty
(ecase ty
- (:group (format f "~A\\new ~A <<~%" (make-string in :initial-element #\space) (if (<= nu 1) "StaffGroup" "InnerStaffGroup")))
+ ((:group :choirgroup) (format f "~A\\new ~A <<~%" (make-string in :initial-element #\space)
+ (ecase ty
+ (:group (if (<= nu 1) "StaffGroup" "InnerStaffGroup"))
+ (:choirgroup (if (<= nu 1) "ChoirStaff" "InnerChoirStaff")))))
(:grandstaff (format f "~A\\new PianoStaff <<~%" (make-string in :initial-element #\space))))
(format f "~A<<~%" (make-string in :initial-element #\space)))
(incf in 2))
Index: fomus/data.lisp
diff -u fomus/data.lisp:1.20 fomus/data.lisp:1.21
--- fomus/data.lisp:1.20 Wed Aug 31 17:56:06 2005
+++ fomus/data.lisp Wed Aug 31 23:17:59 2005
@@ -353,7 +353,7 @@
(declaim (type cons +instr-group-tree-type-aux+ +instr-group-tree-type+))
(defparameter +instr-group-tree-type-aux+
- '(or* (satisfies is-instr) (list-of* (cons* (or null (member :group :grandstaff)) (list-of* +instr-group-tree-type-aux+)))))
+ '(or* (satisfies is-instr) (list-of* (cons* (member :group :choirgroup :grandstaff) (list-of* +instr-group-tree-type-aux+)))))
(defparameter +instr-group-tree-type+
'(list-of* (cons* symbol (list-of* +instr-group-tree-type-aux+))))
@@ -385,15 +385,15 @@
(cons :small-ensemble
(loop for e in +instruments+
for sy = (instr-sym e)
- if (or (eq sy :percussion) (find sy '(:timpani :glockenspiel :xylophone :vibraphone :marimba :chimes :celesta))) collect sy into p
+ if (or (eq sy :percussion) (find sy '(:timpani :glockenspiel :xylophone :vibraphone :marimba :chimes :celesta))) collect (list :group sy) into p
else if (eq sy :organ-manuals) collect '(:group (:grandstaff :organ-manuals) :organ-pedals) into k
else if (eq sy :organ-pedals) do (progn nil)
else if (= (instr-staves e) 2) collect (list :grandstaff sy) into k
else if (find sy '(:soprano :mezzo-soprano :contralto :tenor :tenor-8dn :baritone :bass)) collect sy into v
else if (find sy '(:soprano-choir :alto-choir :tenor-choir :bass-choir)) collect sy into c
else collect (cons (list :group sy) (/ (+ (instr-minp e) (instr-maxp e)) 2)) into i
- finally (return (nconc (list (cons nil (mapcar #'car (sort i #'> :key #'cdr)))) (list (cons nil p))
- v (list (cons :group c)) k))))))
+ finally (return (nconc (mapcar #'car (sort i #'> :key #'cdr)) p
+ (list (cons :choirgroup v)) (list (cons :choirgroup c)) k))))))
(defun make-instrex* (instr)
(declare (type instr instr))
@@ -639,11 +639,22 @@
(defun is-restmarksym (sym)
(find sym +marks-rests+))
+(declaim (type cons +marks-unimportant+))
+(defparameter +marks-important+
+ '(:longtrill :arco :pizz :startgraceslur- :graceslur- :endgraceslur- :startwedge> :startwedge< :wedge- :endwedge-
+ :rfz :sfz :spp :sp :sff :sf :fp :ffffff :fffff :ffff :fff :ff :f :mf :mp :p :pp :ppp :pppp :ppppp :pppppp
+ :fermata :arpeggio :glissando :breath :harmonic
+ :stopped :open :staccato :staccatissimo
+ :lineprall :prallup :pralldown :downmordent :upmordent :downprall :upprall :prallmordent
+ :prallprall :mordent :prall :trill :reverseturn :turn :righttoe :lefttoe :rightheel :leftheel
+ :thumb :flageolet :downbow :upbow :portato :tenuto :marcato :accent :notehead
+ :startslur- :slur- :endslur- :textnote :textdyn))
+
(declaim (type boolean *auto-pizz/arco*))
(defparameter *auto-pizz/arco* t)
;; marks only at beginning or end of tied notes
-(declaim (type cons +marks-first-tie+ +marks-last-tie+ +marks-all-ties+ +marks-on-off+ +marks-before-after+ +marks-indiv-voices+
+(declaim (type cons +marks-first-tie+ +marks-last-tie+ #|+marks-all-ties+|# +marks-on-off+ +marks-before-after+ +marks-indiv-voices+
+marks-spanner-voices+ +marks-spanner-staves+ +marks-expand+ +marks-defaultup+))
(defparameter +marks-first-tie+
'(:startslur- :startgraceslur- :start8up- :start8down- :starttext- #|:starttextdyn- :starttexttempo-|# :startwedge< :startwedge> :endgraceslur-
@@ -652,14 +663,14 @@
:accent :marcato :tenuto :portato
:upbow :downbow :flageolet :thumb :leftheel :rightheel :lefttoe :righttoe
:turn :reverseturn :trill :prall :mordent :prallprall :prallmordent :upprall :downprall :upmordent :downmordent :pralldown :prallup :lineprall
- :pizz :arco :open :stopped :breath
+ :pizz :arco :open :stopped
:notehead :harmonic :arpeggio :glissando :portamento ; special ones
:cautacc :8up :8down :clef))
(defparameter +marks-last-tie+
'(:endslur- :end8up- :end8down- :endtext- #|:endtextdyn- :endtexttempo-|# :endwedge-
- :fermata :staccatissimo :staccato))
-(defparameter +marks-all-ties+
- '(:longtrill :tremolo :tremolofirst :tremolosecond))
+ :fermata :staccatissimo :staccato :breath))
+;; (defparameter +marks-all-ties+
+;; '(:longtrill :tremolo :tremolofirst :tremolosecond))
(defparameter +marks-on-off+
'((*auto-pizz/arco* . (:pizz . :arco))))
Index: fomus/fomus.asd
diff -u fomus/fomus.asd:1.8 fomus/fomus.asd:1.9
--- fomus/fomus.asd:1.8 Tue Aug 30 00:28:03 2005
+++ fomus/fomus.asd Wed Aug 31 23:17:59 2005
@@ -4,7 +4,7 @@
(asdf:defsystem "fomus"
:description "Lisp music notation formatter"
- :version "0.1.11"
+ :version "0.1.13"
:author "David Psenicka"
:licence "LLGPL"
Index: fomus/interface.lisp
diff -u fomus/interface.lisp:1.5 fomus/interface.lisp:1.6
--- fomus/interface.lisp:1.5 Sun Aug 21 21:17:41 2005
+++ fomus/interface.lisp Wed Aug 31 23:17:59 2005
@@ -40,8 +40,14 @@
`(destructuring-bind (&key ,@(mapcar (lambda (x y) (list x y)) n v) other-keys) args
(declare (ignore other-keys))
(progv (quote ,v) (list , at n)
- (fomus-main))))))
- (if allow-other-keys (fma) (fm))))
+ (fomus-main)))))
+ #+(or cmu sbcl)
+ (wa (&body forms)
+ `(handler-bind ((style-warning (lambda (x) (declare (ignore x)) (muffle-warning))))
+ , at forms)))
+ (if allow-other-keys
+ #+(or cmu sbcl) (wa (fma)) #-(or cmu sbcl) (fma)
+ #+(or cmu sbcl) (wa (fm)) #-(or cmu sbcl) (fm))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; INTERFACE MULTIPLE FUNCTION CALL
Index: fomus/main.lisp
diff -u fomus/main.lisp:1.14 fomus/main.lisp:1.15
--- fomus/main.lisp:1.14 Wed Aug 31 17:56:06 2005
+++ fomus/main.lisp Wed Aug 31 23:17:59 2005
@@ -156,6 +156,7 @@
(when (>= *verbose* 2) (out "~&; Cautionary accidentals..."))
(cautaccs pts) #+debug (fomus-proc-check pts 'cautaccs))
(when (>= *verbose* 2) (out "~&; Chords..."))
+ (marks-beforeafter pts)
(preproc pts) #+debug (fomus-proc-check pts 'preproc) ; ----- CHORDS, RESTS
(clean-ties pts) #+debug (fomus-proc-check pts 'cleanties1)
(when (>= *verbose* 2) (out "~&; Splits/ties/rests..."))
Index: fomus/marks.lisp
diff -u fomus/marks.lisp:1.10 fomus/marks.lisp:1.11
--- fomus/marks.lisp:1.10 Sun Aug 21 21:17:41 2005
+++ fomus/marks.lisp Wed Aug 31 23:17:59 2005
@@ -38,8 +38,8 @@
;; this will translate the user input format to a more rigid format for the backends
(defun clean-spanners (pts spanners)
(loop for (startsym contsym endsym) of-type (symbol symbol symbol) in spanners
- do (loop for p of-type partex in pts
- do (loop
+ do (loop for p of-type partex in pts do
+ (loop
with ss = (make-hash-table :test 'eql) and nu of-type (integer 0) = 0
for e of-type (or noteex restex) in (reverse (part-events p)) ; go backwards, find endsyms
do
@@ -74,7 +74,9 @@
(decf nu))
(error "Levels for marks ~S, ~S and ~S are out of order at offset ~S, part ~S" startsym contsym endsym (event-foff e) (part-name p)))
(error "Missing ending mark ~S or ~S for starting mark ~S at offset ~S, part ~S" contsym endsym startsym (event-foff e) (part-name p))))))
- finally (or (= nu 0) (error "Missing starting mark ~S in part ~S" startsym (part-name p)))) (print-dot))))
+ (loop for l being each hash-value in ss do (addmark e (list contsym l)))
+ finally (or (= nu 0) (error "Missing starting mark ~S in part ~S" startsym (part-name p))))
+ (print-dot))))
(defun expand-marks (pts)
(loop for (ma . (rs . re)) of-type (symbol . (symbol . symbol)) in +marks-expand+ do
@@ -180,4 +182,29 @@
finally (loop for p of-type partex in pts do
(rmprop p :quant)
(loop for e of-type (or noteex restex) in (part-events p) do
- (setf (event-marks e) (remove-duplicates (event-marks e) :test #'equal))))))
\ No newline at end of file
+ (setf (event-marks e) (remove-duplicates (event-marks e) :test #'equal))))))
+
+(defun marks-beforeafter (pts)
+ (declare (type list pts))
+ (loop with xx for p of-type partex in pts do
+ (loop for m of-type meas in (part-meas p) do
+ ;;(loop for g of-type list in (meas-voices m) do
+ (loop for (e0 e1 e2) of-type (noteex (or noteex null) (or noteex null))
+ on (cons nil (remove-if-not #'notep (meas-events m))) while e1 do
+ (loop for (a . d) of-type (symbol . symbol) in +marks-before-after+
+ for k = (force-list (popmark e1 a))
+ when k do
+ (push (cons (ecase (or (second k) d)
+ (:before e0)
+ (:after e1))
+ (list (first k) :after))
+ xx)
+ (push (cons (ecase (or (second k) d)
+ (:before e1)
+ (:after e2))
+ (list (first k) :before))
+ xx)))) ;)
+ (print-dot)
+ finally
+ (loop for (e . m) of-type ((or noteex restex) . cons) in xx when e do (addmark e m))))
+
Index: fomus/parts.lisp
diff -u fomus/parts.lisp:1.6 fomus/parts.lisp:1.7
--- fomus/parts.lisp:1.6 Sun Aug 28 23:31:27 2005
+++ fomus/parts.lisp Wed Aug 31 23:17:59 2005
@@ -101,15 +101,15 @@
(loop
for l on ll and g on gg and j from i
do
- (let ((x (cdr (the (cons * symbol) (first l))))) (when x (en lp j x)))
- (let ((x (cdr (the (cons * symbol) (first g))))) (when x (ad p j x)))
+ (let ((x (cdr (the (cons * symbol) (first l))))) (en lp j x))
+ (let ((x (cdr (the (cons * symbol) (first g))))) (ad p j x))
finally
(loop
for ll on l and k from j
- do (let ((x (cdr (the (cons * symbol) (first ll))))) (when x (en lp k x))))
+ do (let ((x (cdr (the (cons * symbol) (first ll))))) (en lp k x)))
(loop
for gg on g and k from j
- do (let ((x (cdr (the (cons * symbol) (first gg))))) (when x (ad p k x))))))
+ do (let ((x (cdr (the (cons * symbol) (first gg))))) (ad p k x)))))
(print-dot))
(let ((f (first pts))
(l (last-element pts)))
Index: fomus/postproc.lisp
diff -u fomus/postproc.lisp:1.10 fomus/postproc.lisp:1.11
--- fomus/postproc.lisp:1.10 Wed Aug 31 16:07:10 2005
+++ fomus/postproc.lisp Wed Aug 31 23:17:59 2005
@@ -413,35 +413,11 @@
for p of-type partex in pts do
(loop for m of-type meas in (part-meas p) do
(loop for g of-type list in (meas-voices m) do
- (loop for e of-type (or noteex restex) in g do (setf (event-marks e) (sort-props (event-marks e)))))
+ (loop for e of-type (or noteex restex) in g do (setf (event-marks e) (sort-marks (event-marks e)))))
(setf (meas-props m) (sort-props (meas-props m))))
(setf (part-props p) (sort-props (part-props p)))
(print-dot)))
-(defun postproc-marks-beforeafter (pts)
- (declare (type list pts))
- (loop with xx for p of-type partex in pts do
- (loop for m of-type meas in (part-meas p) do
- (loop for g of-type list in (meas-voices m) do
- (loop for (e0 e1 e2) of-type ((or noteex restex null) (or noteex restex null) (or noteex restex null))
- on (cons nil g) while e1 do
- (loop for (a . d) of-type (symbol . symbol) in +marks-before-after+
- for k = (force-list (popmark e1 a))
- when k do
- (push (cons (ecase (or (second k) d)
- (:before e0)
- (:after e1))
- (list (first k) :after))
- xx)
- (push (cons (ecase (or (second k) d)
- (:before e1)
- (:after e2))
- (list (first k) :before))
- xx)))))
- (print-dot)
- finally
- (loop for (e . m) of-type ((or noteex restex) . cons) in xx when e do (addmark e m))))
-
;; do lots of nice things for the backend functions
(defun postproc (pts)
(postproc-tremolos pts)
@@ -455,6 +431,6 @@
(postproc-graces pts)
(postproc-marksonoff pts)
(postproc-text pts)
- (postproc-marks-beforeafter pts)
+ ;;(postproc-marks-beforeafter pts)
(postproc-barlines pts))
Index: fomus/split.lisp
diff -u fomus/split.lisp:1.15 fomus/split.lisp:1.16
--- fomus/split.lisp:1.15 Sun Aug 28 06:32:47 2005
+++ fomus/split.lisp Wed Aug 31 23:17:59 2005
@@ -335,8 +335,8 @@
(declare (type (or noteex restex null) e1 e2) (type cons es))
(if (and (restp e1) (restp e2)
(not (find (event-off e2) (event-nomerge e1)))
- (equal (list (event-dur* e1) (sort-marks (event-marks e1)) (event-tup e1))
- (list (event-dur* e2) (sort-marks (event-marks e2)) (event-tup e2))))
+ (equal (list (event-dur* e1) (sort-marks (important-marks (event-marks e1))) (event-tup e1))
+ (list (event-dur* e2) (sort-marks (important-marks (event-marks e2))) (event-tup e2))))
(cons (copy-event e1
:dur (* (event-dur* e1) 2)
:tup (cons (when (car (event-tup e1))
Index: fomus/test.lisp
diff -u fomus/test.lisp:1.10 fomus/test.lisp:1.11
--- fomus/test.lisp:1.10 Wed Aug 31 17:56:06 2005
+++ fomus/test.lisp Wed Aug 31 23:18:00 2005
@@ -80,7 +80,6 @@
(fomus
:backend '(:data (:lilypond :view t))
:ensemble-type :orchestra
- :verbose 2
:beat-division 8
:max-tuplet '(7 3)
:parts (list
@@ -130,36 +129,36 @@
(fomus
:backend '((:data) (:lilypond :view t))
- :ensemble-type :orchestra
+ :ensemble-type :small-ensemble
:parts (list
(make-part
:name "Piano 1"
:instr :piano
- :events (list (make-note :off 0 :dur 1 :note 60)))
+ :events (list (make-note :off 4 :dur 1 :note 60)))
(make-part
:name "Piano 2"
:instr :piano
- :events (list (make-note :off 0 :dur 1 :note 60)))
+ :events (list (make-note :off 4 :dur 1 :note 60)))
(make-part
:name "Flute 1"
:instr :flute
- :events (list (make-note :off 0 :dur 1 :note 60)))
+ :events (list (make-note :off 4 :dur 1 :note 60)))
(make-part
:name "Flute 2"
:instr :flute
- :events (list (make-note :off 0 :dur 1 :note 60)))
+ :events (list (make-note :off 4 :dur 1 :note 60)))
(make-part
:name "Clarinet 1"
:instr :bf-clarinet
- :events (list (make-note :off 0 :dur 1 :note 60)))
+ :events (list (make-note :off 4 :dur 1 :note 60)))
(make-part
:name "Clarinet 2"
:instr :bf-clarinet
- :events (list (make-note :off 0 :dur 1 :note 60)))
+ :events (list (make-note :off 4 :dur 1 :note 60)))
(make-part
:name "Tuba"
:instr :tuba
- :events (list (make-note :off 0 :dur 1 :note 36)))))
+ :events (list (make-note :off 4 :dur 1 :note 36)))))
;; Mark objects
@@ -788,27 +787,25 @@
(0 :woodblock)
(1 :snaredrum)))))))
-(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-multivoice-notes
+ :backend '(:lilypond :view t)
+ :ensemble-type :orchestra
+ :auto-multivoice-notes nil
+ :parts
+ (list
+ (make-part
+ :name "Violin"
+ :instr :violin
+ :events
+ (loop for b in '(55 67) nconc
+ (loop
+ for off from 0 to 10 by 1/2
+ collect (make-note :off off
+ :voice '(1 2)
+ :dur (if (< off 10) 1/2 1)
+ :note (+ b (random 19))))))))
-(fomus ; :auto-percussion-durs
+(fomus ; :auto-percussion-durs
:backend '((:data) (:lilypond :view t))
:ensemble-type :orchestra
:auto-percussion-durs nil
@@ -823,7 +820,7 @@
(0 :woodblock)
(1 :snaredrum)))))))
-(fomus ; :auto-pizz/arco
+(fomus ; :auto-pizz/arco
:backend '((:data) (:lilypond :view t))
:ensemble-type :orchestra
:beat-division 8
@@ -843,7 +840,7 @@
(0 '(:pizz))
(1 '(:arco))))))
-(fomus ; :auto-override-timesigs
+(fomus ; :auto-override-timesigs
:backend '((:data) (:lilypond :view t ))
:ensemble-type :orchestra
:verbose 2
Index: fomus/util.lisp
diff -u fomus/util.lisp:1.15 fomus/util.lisp:1.16
--- fomus/util.lisp:1.15 Wed Aug 31 17:56:06 2005
+++ fomus/util.lisp Wed Aug 31 23:18:00 2005
@@ -337,6 +337,11 @@
(declaim (inline sort-marks))
(defun sort-marks (marks) (declare (type list marks)) (sort-props marks))
+(declaim (inline important-marks))
+(defun important-marks (marks)
+ (declare (type list marks))
+ (remove-if-not (lambda (x) (find (first (force-list x)) +marks-important+)) marks))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CHORDS/SPLITTING
@@ -454,7 +459,12 @@
when (and (restp e) (popmark e :splitrt))
do (mapc (lambda (x) (declare (type symbol x)) (rmmark e x)) +marks-first-rest+)
when (and (restp e) (popmark e :splitlt))
- do (mapc (lambda (x) (declare (type symbol x)) (rmmark e x)) +marks-last-rest+))) (print-dot)))
+ do (mapc (lambda (x) (declare (type symbol x)) (rmmark e x)) +marks-last-rest+)
+ do (loop for sp in (list +marks-spanner-voices+ +marks-spanner-staves+) do
+ (loop for (startsym contsym endsym) of-type (symbol symbol symbol) in sp
+ do (loop for (xxx n) in (getmarks e startsym) do (rmmark e (list contsym n)))
+ do (loop for (xxx n) in (getmarks e endsym) do (rmmark e (list contsym n)))))))
+ (print-dot)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; STAVES
@@ -795,13 +805,13 @@
(if format
(labels ((aux (li ta)
(let ((br (first li)))
- (format t "~A" (case br (:group "[ ") (:grandstaff "{ ") ((nil) "| ") (otherwise " ")))
+ (format t "~A" (case br (:group "[ ") (:grandstaff "{ ") (:choirgroup "| ") (otherwise " ")))
(loop for (e en) on (rest li)
if (consp e) do (aux e (+ ta 2)) (if en (format t "~%;~VT" ta) (format t "~A" (case br (:group " ]") (:grandstaff " }") ((nil) " |") (otherwise ""))))
else do (if en
(format t "~A~%;~VT" e ta)
(format t "~A~A"
- e (case br (:group " ]") (:grandstaff " }") ((nil) " |") (otherwise ""))))))))
+ e (case br (:group " ]") (:grandstaff " }") (:choirgroup " |") (otherwise ""))))))))
(loop for (e en) on ss
do (format t "; ~A~%~%;" (first e)) (aux e 3)
when en do (format t "~%~%")))
Index: fomus/version.lisp
diff -u fomus/version.lisp:1.7 fomus/version.lisp:1.8
--- fomus/version.lisp:1.7 Wed Aug 31 16:07:10 2005
+++ fomus/version.lisp Wed Aug 31 23:18:00 2005
@@ -12,7 +12,7 @@
(declaim (type string +title+)
(type cons +version+ +banner+))
(defparameter +title+ "FOMUS")
-(defparameter +version+ '(0 1 12))
+(defparameter +version+ '(0 1 13))
(defparameter +banner+
`("Lisp music notation formatter"
"Copyright (c) 2005 David Psenicka, All Rights Reserved"
Index: fomus/voices.lisp
diff -u fomus/voices.lisp:1.9 fomus/voices.lisp:1.10
--- fomus/voices.lisp:1.9 Tue Aug 30 00:28:04 2005
+++ fomus/voices.lisp Wed Aug 31 23:18:00 2005
@@ -230,7 +230,11 @@
(declare (type cons x))
(mapc (lambda (y) (declare (type restex y)) (setf (event-inv y) t)) ; leave top-most equivalent rest
(rest (sort (delete-if #'event-inv x) #'< :key #'event-voice*)))) ; distr-rest function should have left at least one visible voice
- (split-into-groups re (lambda (x) (declare (type restex x)) (list (event-staff x) (event-off x) (event-dur* x) (event-tupfrac x) (sort-props (event-marks x)))) :test 'equal)))
+ (split-into-groups re
+ (lambda (x)
+ (declare (type restex x))
+ (list (event-staff x) (event-off x) (event-dur* x) (event-tupfrac x) (sort-marks (important-marks (event-marks x)))))
+ :test 'equal)))
(if *auto-multivoice-notes*
(setf (meas-events meas)
(sort (nconc re
@@ -239,8 +243,10 @@
(split-into-groups no (lambda (x)
(declare (type noteex x))
(list (event-staff x) (event-off x) (event-dur* x) (event-grace x) (event-tupfrac x)
- (delete-if (lambda (x) (declare (type (or symbol cons) x)) (find (if (listp x) (first x) x) +marks-indiv-voices+))
- (sort-props (event-marks x)))
+ (delete-if (lambda (x)
+ (declare (type (or symbol cons) x))
+ (find (if (listp x) (first x) x) +marks-indiv-voices+))
+ (sort-marks (important-marks (event-marks x))))
(event-beamlt x) (event-beamrt x)))
:test 'equal)))
(mapcan (lambda (x0) ; sequence of adjacent notes to assemble into chords
More information about the Fomus-cvs
mailing list