[fomus-cvs] CVS update: fomus/CHANGELOG fomus/TODO fomus/accidentals.lisp fomus/classes.lisp fomus/data.lisp fomus/fomus.asd fomus/postproc.lisp fomus/quantize.lisp fomus/splitrules.lisp fomus/staves.lisp fomus/test.lisp fomus/util.lisp fomus/version.lisp fomus/voices.lisp
David Psenicka
dpsenicka at common-lisp.net
Mon Aug 29 22:28:12 UTC 2005
Update of /project/fomus/cvsroot/fomus
In directory common-lisp.net:/tmp/cvs-serv14351
Modified Files:
CHANGELOG TODO accidentals.lisp classes.lisp data.lisp
fomus.asd postproc.lisp quantize.lisp splitrules.lisp
staves.lisp test.lisp util.lisp version.lisp voices.lisp
Log Message:
testing/bug fixes
Date: Tue Aug 30 00:28:04 2005
Author: dpsenicka
Index: fomus/CHANGELOG
diff -u fomus/CHANGELOG:1.8 fomus/CHANGELOG:1.9
--- fomus/CHANGELOG:1.8 Sat Aug 27 20:13:21 2005
+++ fomus/CHANGELOG Tue Aug 30 00:28:03 2005
@@ -1,6 +1,17 @@
+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
+
v0.1.10
- Testing/bug fixes: quantizing (integrated with splitting/tying now)
+ Testing/bug fixes:
+ quantizing (integrated with splitting/tying now)
+ many other bugs
Automatic durations for percussion instruments
v0.1.9
Index: fomus/TODO
diff -u fomus/TODO:1.15 fomus/TODO:1.16
--- fomus/TODO:1.15 Sat Aug 27 20:13:21 2005
+++ fomus/TODO Tue Aug 30 00:28:03 2005
@@ -3,13 +3,15 @@
Immediate:
Testing and bug fixes
- Nested tuplets
- Splitting chords across staves
+ 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
MusicXML backend
MIDI output to CM
Avoid staff changes when notes move in other direction
- Proofread/finish documentation, add many easy examples
+ Durations that fill to next/previous note
+ Proofread/finish documentation, add easy examples
Short Term:
Index: fomus/accidentals.lisp
diff -u fomus/accidentals.lisp:1.9 fomus/accidentals.lisp:1.10
--- fomus/accidentals.lisp:1.9 Sun Aug 21 21:17:40 2005
+++ fomus/accidentals.lisp Tue Aug 30 00:28:03 2005
@@ -18,7 +18,7 @@
(declaim (type boolean *auto-accidentals* *auto-cautionary-accs*))
(defparameter *auto-accidentals* t)
-(defparameter *auto-cautionary-accs* t)
+(defparameter *auto-cautionary-accs* nil)
;; NOKEY!
@@ -191,7 +191,7 @@
(let ((x (event-useracc f)))
(if (and (listp x) (listp (rest x))) x
(list x))))
- cho :key #'equal) ; e = lists of accs.
+ cho :test #'equal) ; e = lists of accs.
when (funcall spellfun o a) collect a)
(loop for a in cho if (funcall spellfun o a) collect a) ; ignore user's suggestion
(error "No accidentals possible for note ~S at offset ~S, part ~S" (event-note f) (event-foff f) name))
@@ -305,13 +305,20 @@
(mapcar #'nokey-convert-qtone +acc-qtones-double+)
+acc-double+)
for e of-type (or noteex restex) in (part-events p)
- for n of-type rational = (event-note* e) and a of-type (integer -2 2) = (event-acc e) and q of-type (rational -1/2 1/2) = (event-addacc e)
+ for n = (event-note* e) ;;and a of-type (integer -2 2) = (event-acc e) and q of-type (rational -1/2 1/2) = (event-addacc e)
+ for ua = (let ((u (event-useracc e)))
+ (if (list1p u) (if (consp (first u)) (first u) (cons (first u) 0))
+ (if u (error "Only one accidental allowed when :AUTO-ACCIDENTALS is NIL in note at offset ~S, part ~S" (event-foff e) (part-name p))
+ (cons 0 0))))
unless (and (if *quartertones*
- (find (cons a q) cho :test #'equal)
- (find a cho))
- (nokeyq-spell n (list a q)))
- do (error "Invalid note spelling ~S at offset ~S, part ~S" (cond ((/= q 0) (list n a q)) ((/= a 0) (list n a)) (t (list n)))
- (event-foff e) (part-name p)))))
+ (find ua cho :test #'equal)
+ (find (car ua) cho))
+ (nokeyq-spell n ua))
+ do (error "Invalid note spelling ~S at offset ~S, part ~S" (cond ((/= (cdr ua) 0) (list n (car ua) (cdr ua)))
+ ((/= (car ua) 0) (list n (car ua)))
+ (t (list n)))
+ (event-foff e) (part-name p))
+ do (setf (event-note e) (cons n ua)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CAUTIONARY ACCIDENTALS
@@ -325,8 +332,8 @@
(defparameter *caut-acc-ottavas* t)
(defparameter *caut-acc-octaves* 1) ; can be a number (for number of octaves above/below) or t for all
-(defparameter *caut-acc-next-meas* nil)
-(defparameter *caut-acc-after-one-meas* nil) ; no cautionary accidental after one measure
+(defparameter *caut-acc-next-meas* t)
+(defparameter *caut-acc-after-one-meas* t) ; no cautionary accidental after one measure
;; rests are removed already, before chords or ties
(defun acc-nokey-cautaccs (meas)
Index: fomus/classes.lisp
diff -u fomus/classes.lisp:1.10 fomus/classes.lisp:1.11
--- fomus/classes.lisp:1.10 Sun Aug 28 06:32:47 2005
+++ fomus/classes.lisp Tue Aug 30 00:28:03 2005
@@ -143,7 +143,8 @@
(if (consp (event-note ev))
(let ((x (cdr (event-note ev))))
(declare (type (or cons rational) x))
- (if (consp x) (the rational (cdr x)) 0)) 0))
+ (if (consp x) (the rational (cdr x)) 0))
+ 0))
(defun event-addaccs (ev)
(declare (type note ev))
(mapcar (lambda (e)
Index: fomus/data.lisp
diff -u fomus/data.lisp:1.16 fomus/data.lisp:1.17
--- fomus/data.lisp:1.16 Sun Aug 28 23:31:27 2005
+++ fomus/data.lisp Tue Aug 30 00:28:03 2005
@@ -82,19 +82,19 @@
(no (note-to-num (if (consp no) (first no) no))))
(if a
(cons no (mapcar (lambda (x) (if (and (listp x) (list>1p x))
- (cons (acc-to-num (first x)) (acc-to-num (second x)))
- (acc-to-num x)))
+ (cons (acc-to-num (first x) 1) (acc-to-num (second x) 1/2))
+ (acc-to-num x 1)))
a))
no)))
(declaim (type cons +accnum+))
(defparameter +accnum+ '(("S" . 1) ("+" . 1) ("F" . -1) ("-" . -1) ("SS" . 2) ("++" . 2) ("FF" . -2) ("--" . -2) ("N" . 0)))
;;(declaim (inline acc-to-num))
-(defun acc-to-num (acc)
+(defun acc-to-num (acc prec)
(if (symbolp acc) (lookup (symbol-name acc) +accnum+ :test #'string=)
- (roundto acc *note-precision*)))
+ (roundto acc prec)))
(defun is-acc (acc)
- (or (realp acc) (find (symbol-name acc) +accnum+ :key #'car :test #'string=)))
+ (typecase acc (real acc) (symbol (find (symbol-name acc) +accnum+ :key #'car :test #'string=))))
(defun dur-to-num (dur bt)
(if (and *cm-rhythmfun* *use-cm* (symbolp dur))
@@ -627,8 +627,13 @@
;; include :staff but not :clef
(defparameter +marks-rests+
- '(:fermata :breath :notehead :textnote :texttempo :textdyn :text ;;:texttempo- :endtexttempo- :textdyn- :endtextdyn-
+ '(:fermata :notehead :textnote :texttempo :textdyn :text ;;:texttempo- :endtexttempo- :textdyn- :endtextdyn-
:text- :endtext- #|:starttexttempo- :starttextdyn-|# :starttext-))
+
+(defparameter +marks-first-rest+
+ '(:textnote :texttempo :textdyn :text :text- :starttext-))
+(defparameter +marks-last-rest+
+ '(:fermata :endtext-))
(declaim (inline is-restmarksym))
(defun is-restmarksym (sym)
Index: fomus/fomus.asd
diff -u fomus/fomus.asd:1.7 fomus/fomus.asd:1.8
--- fomus/fomus.asd:1.7 Sun Aug 28 23:31:27 2005
+++ fomus/fomus.asd Tue Aug 30 00:28:03 2005
@@ -4,7 +4,7 @@
(asdf:defsystem "fomus"
:description "Lisp music notation formatter"
- :version "0.1.10"
+ :version "0.1.11"
:author "David Psenicka"
:licence "LLGPL"
Index: fomus/postproc.lisp
diff -u fomus/postproc.lisp:1.8 fomus/postproc.lisp:1.9
--- fomus/postproc.lisp:1.8 Sat Aug 27 20:13:21 2005
+++ fomus/postproc.lisp Tue Aug 30 00:28:03 2005
@@ -264,8 +264,9 @@
(loop for g of-type list in (meas-voices m) do
(loop
for e of-type (or noteex restex) in g
+ do (rmmark e b)
if (getmark e a) do (if o (rmmark e a) (setf o t))
- else when o do (addmark e b) (setf o nil))))
+ else when (and o (notep e) (not (or-list (force-list (event-tielt e))))) do (addmark e b) (setf o nil))))
(print-dot))))
;; preproc-tremolos already
@@ -359,38 +360,51 @@
(declare (type list pts))
(loop for p of-type partex in pts
do (loop for m of-type meas in (part-meas p)
- do (loop with a = (loop for v of-type list in (meas-voices m) append (remove-if (lambda (x) (declare (type (or noteex restex) x)) (and (restp x) (event-inv x))) v))
+ do (loop with a = (loop for v of-type list in (meas-voices m)
+ append (remove-if (lambda (x) (declare (type (or noteex restex) x)) (and (restp x) (event-inv x))) v))
for v of-type list in (meas-voices m)
- do (loop for e of-type (or noteex restex) in v
- for tx = (or (popmark e :starttext-)
- (popmark e :startwedge<) (popmark e :startwedge>) (popmark e :startlongtrill-)
- (popmark e :text) (popmark e :texttempo) (popmark e :textdyn) (popmark e :textnote))
- while tx do
- (loop with o = (event-voice* e)
- for y of-type (integer 1 4) in (delete-duplicates
- (loop for x of-type (or noteex restex) in a
- when (and (= (event-staff x) (event-staff e))
- (/= (event-voice* x) o)
- (> (event-endoff x) (event-off a))
- (< (event-off x) (event-endoff a)))
- collect (event-voice* x)))
- 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)
- (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)))
+ do (loop for e of-type (or noteex restex) in v do
+ (loop
+ with mks
+ for tx = (or (popmark e :starttext-)
+ (popmark e :startwedge<) (popmark e :startwedge>) (popmark e :startlongtrill-)
+ (popmark e :text) (popmark e :texttempo) (popmark e :textdyn) (popmark e :textnote))
+ while tx do
+ (loop with o = (event-voice* e)
+ for y of-type (integer 1 4)
+ in (delete-duplicates
+ (loop for x of-type (or noteex restex) in a
+ when (and (= (event-staff x) (event-staff e))
+ (/= (event-voice* x) o)
+ (> (event-endoff x) (event-off a))
+ (< (event-off x) (event-endoff a)))
+ collect (event-voice* x)))
+ 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)
+ (push (cons (first tx)
+ (nconc
+ (let ((x (find-if #'numberp tx))) (when x (list x)))
+ (list (or (find :up tx) (find :down tx) (if (or (find (first tx) +marks-defaultup+)
+ (>= (event-staff e) (instr-staves (part-instr p))))
+ :up :down))
+ (find-if #'stringp tx))))
+ mks))
+ ((< d u)
+ (push (cons (first tx)
+ (nconc
+ (let ((x (find-if #'numberp tx))) (when x (list x)))
+ (list :down (find-if #'stringp tx))))
+ mks))
+ ((> d u)
+ (push (cons (first tx)
+ (nconc
+ (let ((x (find-if #'numberp tx))) (when x (list x)))
+ (list :up (find-if #'stringp tx))))
+ mks))))
+ finally (mapc (lambda (m) (declare (type cons m)) (addmark e m)) mks)))))
+ (print-dot)))
;; not included with other postprocs here--in fomus-proc function
(defun postpostproc-sortprops (pts)
Index: fomus/quantize.lisp
diff -u fomus/quantize.lisp:1.10 fomus/quantize.lisp:1.11
--- fomus/quantize.lisp:1.10 Sat Aug 27 20:13:21 2005
+++ fomus/quantize.lisp Tue Aug 30 00:28:03 2005
@@ -162,7 +162,7 @@
(defun quantize-generic (parts)
(loop for p in parts do
(loop for e in (part-events p) do
- (setf (event-dur* e) (rationalize (event-dur* e)) (event-off e) (rationalize (event-off e))))))
+ (setf (event-dur* e) (rationalize (or (event-gracedur e) (event-dur* e))) (event-off e) (rationalize (event-off e))))))
#|(cons pts (list o1 o2))|# #|(cons nil nil)|#
;; (uu00 (i)
Index: fomus/splitrules.lisp
diff -u fomus/splitrules.lisp:1.2 fomus/splitrules.lisp:1.3
--- fomus/splitrules.lisp:1.2 Sun Aug 28 23:31:27 2005
+++ fomus/splitrules.lisp Tue Aug 30 00:28:03 2005
@@ -182,7 +182,7 @@
(when (and (al *shortlongshort-notes-level*) (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule))
ex (or (not (rule-comp rule)) (>= num 4)))
(list (list '(1/4 3/4) (si 1/4 :l t t) (snd 1/2 t t) (si 1/4 :r t t)))) ; longer note in middle
- (when (and *syncopated-notes-level* (al :top) (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule) (>= num 3))
+ (when (and *syncopated-notes-level* (al :top) (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule)) (>= num 3)
(not (rule-comp rule)))
(cond ((integerp num)
(list (nconc (list (loop for i from 1/2 below num collect (/ i num)) ; regular off beat syncopation
Index: fomus/staves.lisp
diff -u fomus/staves.lisp:1.8 fomus/staves.lisp:1.9
--- fomus/staves.lisp:1.8 Sun Aug 28 06:32:47 2005
+++ fomus/staves.lisp Tue Aug 30 00:28:03 2005
@@ -315,7 +315,7 @@
(defun distr-rests-byconfl (parts)
(declare (type list parts))
(loop
- with rl of-type (cons (cons (rational 0) (rational 0)) list)
+ with rl of-type list ; (cons (cons (rational 0) (rational 0)) list)
and lo = (meas-endoff (last-element (part-meas (first parts)))) ; list of lists of rests to turn invisible
for p of-type partex in (remove-if #'is-percussion parts)
for sv = (> (instr-staves (part-instr p)) 1) do
Index: fomus/test.lisp
diff -u fomus/test.lisp:1.7 fomus/test.lisp:1.8
--- fomus/test.lisp:1.7 Sun Aug 28 23:31:27 2005
+++ fomus/test.lisp Tue Aug 30 00:28:03 2005
@@ -523,8 +523,7 @@
:marks (when (<= (random 3) 0)
'(:staccato)))))))
-;; MusicXML
-;; (not working yet)
+;; MusicXML (not working yet)
(fomus
:backend '((:data) (:musicxml))
@@ -571,7 +570,7 @@
:name "Piano"
:instr :piano
:events
- (cons (make-rest :off 19/2 :dur 2 :marks '(:fermata))
+ (cons (make-rest :off 19/2 :dur 2 :marks '(:fermata (:text "Here!")))
(loop
for off from 0 below 19/2 by 1/2
collect (make-note :off off
@@ -580,7 +579,291 @@
:marks (when (<= (random 3) 0)
'(:staccato))))))))
+;; Auto Pizz/Arco
+
+(fomus
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :beat-division 8
+ :quartertones t
+ :parts (list
+ (make-part
+ :name "Violin"
+ :instr :violin))
+ :events (loop repeat 5
+ for off = (random 1.0) then (+ off (1+ (random 1.0)))
+ and dur = (random 1.0)
+ collect (make-note :off off
+ :dur dur
+ :note (+ 55 (/ (random 25) 2))
+ :marks (case (random 2)
+ (0 '(:pizz))))))
+
;; Auto On/Offs
+
+(fomus ; :auto-accidentals
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :auto-accidentals nil
+ :parts
+ (list
+ (make-part
+ :name "Piano"
+ :instr :piano
+ :events
+ (loop
+ for off from 0 to 10 by 1/2
+ and note = (+ 48 (random 25))
+ collect (make-note :off off
+ :dur (if (< off 10) 1/2 1)
+ :note (list note (svref #(0 -1 0 -1 0 0 1 0 -1 0 -1 0) (mod note 12))))))))
+
+(fomus
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :auto-accidentals nil
+ :quartertones t
+ :parts
+ (list
+ (make-part
+ :name "Piano"
+ :instr :piano
+ :events
+ (loop
+ for off from 0 to 10 by 1/2
+ collect (make-note :off off
+ :dur (if (< off 10) 1/2 1)
+ :note '(60.5 (-1 -0.5)))))))
+
+(fomus ; :auto-cautionary-accs
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :auto-accidentals nil
+ :auto-cautionary-accs t
+ :parts
+ (list
+ (make-part
+ :name "Piano"
+ :instr :piano
+ :events
+ (loop
+ for off from 0 to 10 by 1/2
+ and note = (+ 48 (random 25))
+ collect (make-note :off off
+ :dur (if (< off 10) 1/2 1)
+ :note (list note (svref #(0 -1 0 -1 0 0 1 0 -1 0 -1 0) (mod note 12))))))))
+
+(fomus ; :auto-ottavas
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :auto-ottavas nil
+ :parts
+ (list
+ (make-part
+ :name "Piano"
+ :instr :piano
+ :events
+ (loop
+ for off from 0 to 20 by 1/2
+ and note = (+ 72 (random 37))
+ collect (make-note :off off
+ :dur (if (< off 20) 1/2 1)
+ :note note)))))
+
+(fomus ; :auto-voicing
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :auto-voicing nil
+ :parts
+ (list
+ (make-part
+ :name "Piano"
+ :instr :piano
+ :events
+ (loop
+ for off from 0 to 10 by 1/2
+ collect (make-note :off off
+ :voice '(1) ; (1+ (random 2))
+ :dur (if (< off 10) 1/2 1)
+ :note (+ 48 (random 25)))))))
+
+(fomus ; :auto-grace-slurs
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :auto-grace-slurs nil
+ :parts
+ (list
+ (make-part
+ :name "Piano"
+ :instr :piano
+ :events
+ (loop
+ for off from 0 to 4 by 1/2
+ for note = (+ 48 (random 25))
+ nconc (loop repeat (random 4) for grace from -100
+ collect (make-note :off off
+ :dur (list 1/4 grace)
+ :note (if (= (random 2) 0) (- note (random 6)) (+ note (random 6)))))
+ collect (make-note :off off
+ :dur (if (< off 10) 1/2 1)
+ :note note
+ :marks (when (<= (random 3) 0)
+ '(:staccato)))))))
+
+(fomus ; :auto-beams
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :auto-beams nil
+ :parts
+ (list
+ (make-part
+ :name "Piano"
+ :instr :piano
+ :events
+ (loop
+ for off from 0 to 4 by 1/2
+ for note = (+ 48 (random 25))
+ nconc (loop repeat (random 4) for grace from -100
+ collect (make-note :off off
+ :dur (list 1/4 grace)
+ :note (if (= (random 2) 0) (- note (random 6)) (+ note (random 6)))))
+ collect (make-note :off off
+ :dur (if (< off 10) 1/2 1)
+ :note note
+ :marks (when (<= (random 3) 0)
+ '(:staccato)))))))
+
+(fomus ; :auto-quantize
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :auto-quantize nil
+ :parts
+ (list
+ (make-part
+ :name "Piano"
+ :instr :piano
+ :events
+ (loop
+ for off from 0 to 4 by 1/2
+ for note = (+ 48 (random 25))
+ nconc (loop repeat (random 4) for grace from -100
+ collect (make-note :off off
+ :dur (list 1/4 grace)
+ :note (if (= (random 2) 0) (- note (random 6)) (+ note (random 6)))))
+ collect (make-note :off off
+ :dur (if (< off 10) 1/2 1)
+ :note note
+ :marks (when (<= (random 3) 0)
+ '(:staccato)))))))
+
+(fomus ; :auto-staff/clef-changes
+ :backend '((:data) (:lilypond :view t ))
+ :ensemble-type :orchestra
+ :quality 1/2
+ :auto-staff/clef-changes nil
+ :parts
+ (list
+ (make-part
+ :name "Piano"
+ :instr :piano
+ :events
+ (loop
+ for off from 0 to 100 by 1/2
+ collect (make-note :off off
+ :dur (if (< off 100) 1/2 1)
+ :note (+ 48 (random 25)))))))
+
+(fomus ; :auto-multivoice-rests
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :auto-multivoice-rests nil
+ :parts (list
+ (make-part
+ :name "Percussion"
+ :instr (list :percussion :percs (list (make-perc :woodblock :voice 1 :note 'e4)
+ (make-perc :snaredrum :voice 2 :note 'a3)))
+ :events (loop for o from 0 to 50 by 1/2 when (= (random 4) 0) collect
+ (make-note :off o :dur 1/2
+ :note (case (random 2)
+ (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))))))))
+
+(fomus ; :auto-percussion-durs
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :auto-percussion-durs nil
+ :parts (list
+ (make-part
+ :name "Percussion"
+ :instr (list :percussion :percs (list (make-perc :woodblock :note 'e4 :autodur t)
+ (make-perc :snaredrum :note 'a3 :autodur t)))
+ :events (loop for o from 0 to 40 by 1/2 when (= (random 2) 0) collect
+ (make-note :off o
+ :note (case (random 2)
+ (0 :woodblock)
+ (1 :snaredrum)))))))
+
+(fomus ; :auto-pizz/arco
+ :backend '((:data) (:lilypond :view t))
+ :ensemble-type :orchestra
+ :beat-division 8
+ :quartertones t
+ :auto-pizz/arco nil
+ :parts (list
+ (make-part
+ :name "Violin"
+ :instr :violin))
+ :events (loop repeat 5
+ for off = (random 1.0) then (+ off (1+ (random 1.0)))
+ and dur = (random 1.0)
+ collect (make-note :off off
+ :dur dur
+ :note (+ 55 (/ (random 25) 2))
+ :marks (case (random 2)
+ (0 '(:pizz))
+ (1 '(:arco))))))
+
+(fomus ; :auto-override-timesigs
+ :backend '((:data) (:lilypond :view t ))
+ :ensemble-type :orchestra
+ :verbose 2
+ :quality 1/2
+ :auto-override-timesigs nil
+ :global
+ (list (make-timesig :off 0 :time '(4 4)) (make-timesig :off 10 :time '(4 4)) (make-timesig :off 11 :time '(4 4)))
+ :parts
+ (list
+ (make-part
+ :name "Piano"
+ :instr :piano
+ :events
+ (loop
+ for off from 0 to 20 by 1/2
+ collect (make-note :off off
+ :dur (if (< off 20) 1/2 1)
+ :note (+ 48 (random 25))
+ :marks (when (<= (random 3) 0)
+ '(:staccato)))))))
+
;; User Overrides
-;; Auto Pizz/Arco
+;; Grace note rests
;; Mark Spanners
+;; Compound meter
+;; Auto Time Signatures
\ No newline at end of file
Index: fomus/util.lisp
diff -u fomus/util.lisp:1.12 fomus/util.lisp:1.13
--- fomus/util.lisp:1.12 Sun Aug 28 23:31:27 2005
+++ fomus/util.lisp Tue Aug 30 00:28:04 2005
@@ -390,10 +390,13 @@
:off off
:dur (- (event-endoff event) off)
:tielt (if (chordp event) (make-list (length (event-tielt event)) :initial-element t) t))))))
- (rest (cons (copy-event event :dur (- off (event-off event)) :tup (cons tup dmu))
+ (rest (cons (copy-event event :dur (- off (event-off event)) :tup (cons tup dmu)
+ :marks (if (event-marks event) (cons :splitlt (event-marks event))))
(if tup2
- (copy-event event :off off :dur (- (event-endoff event) off) :tup (cons tup2 dmu))
- (copy-event event :off off :dur (- (event-endoff event) off)))))))))
+ (copy-event event :off off :dur (- (event-endoff event) off) :tup (cons tup2 dmu)
+ :marks (if (event-marks event) (cons :splitrt (event-marks event))))
+ (copy-event event :off off :dur (- (event-endoff event) off)
+ :marks (if (event-marks event) (cons :splitrt (event-marks event)))))))))))
;; (declaim (inline split-event*))
(defun split-event* (event off)
@@ -439,11 +442,15 @@
(loop for p of-type partex in pts
do (loop for m of-type meas in (part-meas p)
do (loop
- for e of-type noteex in (remove-if-not #'notep (meas-events m))
- when (or (and (event-tielt e) (and-list (force-list (event-tielt e)))) (getmark e :endtremolo))
+ for e of-type (or noteex restex) in (meas-events m)
+ when (and (notep e) (or (and (event-tielt e) (and-list (force-list (event-tielt e)))) (getmark e :endtremolo)))
do (mapc (lambda (x) (declare (type symbol x)) (rmmark e x)) +marks-first-tie+)
- when (or (and (event-tiert e) (and-list (force-list (event-tiert e)))) (getmark e :starttremolo))
- do (mapc (lambda (x) (declare (type symbol x)) (rmmark e x)) +marks-last-tie+))) (print-dot)))
+ when (and (notep e) (or (and (event-tiert e) (and-list (force-list (event-tiert e)))) (getmark e :starttremolo)))
+ do (mapc (lambda (x) (declare (type symbol x)) (rmmark e x)) +marks-last-tie+)
+ 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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; STAVES
@@ -556,22 +563,25 @@
collect (loop
with at
for (ts nx) of-type (timesig (or timesig null))
- on (let ((x (merge-linear
- (sort (delete-if-not (lambda (x) (or (null (timesig-partids x)) (find (part-partid p) (timesig-partids x))))
- (copy-list timesigs)) ; ts = current time sig, n = next group
- #'< :key #'timesig-off)
- (lambda (x y) (if (= (timesig-off x) (timesig-off y))
- (cond ((and (null (timesig-partids x)) (timesig-partids y)) y)
- ((and (timesig-partids x) (null (timesig-partids y))) x)
- (t (error "Conflicting time signature/part IDs assignment at offset ~S, part ~S"
- (timesig-foff x) (part-name p)))))))))
- (if (or (null x) (> (timesig-off (first x)) 0))
- (cons (copy-timesig dts :off 0) x)
- x))
- when (or (null *auto-override-timesigs*)
- (= (timesig-off ts) 0)
- (null nx)
- (>= (- (timesig-off nx) (timesig-off ts)) (or *min-auto-timesig-dur* 0)))
+ on (let ((z (let ((x (merge-linear
+ (sort (delete-if-not (lambda (x) (or (null (timesig-partids x)) (find (part-partid p) (timesig-partids x))))
+ (copy-list timesigs)) ; ts = current time sig, n = next group
+ #'< :key #'timesig-off)
+ (lambda (x y) (if (= (timesig-off x) (timesig-off y))
+ (cond ((and (null (timesig-partids x)) (timesig-partids y)) y)
+ ((and (timesig-partids x) (null (timesig-partids y))) x)
+ (t (error "Conflicting time signature/part IDs assignment at offset ~S, part ~S"
+ (timesig-foff x) (part-name p)))))))))
+ (if (or (null x) (> (timesig-off (first x)) 0))
+ (cons (copy-timesig dts :off 0) x)
+ x))))
+ (if *auto-override-timesigs*
+ (loop for (e1 e2) of-type (timesig (or timesig null)) on z
+ when (or (<= (timesig-off e1) 0)
+ (null e2)
+ (>= (- (timesig-off e2) (timesig-off e1)) (or *min-auto-timesig-dur* 0)))
+ collect e1)
+ z))
do (setf at (ut ts p (when nx (timesig-off nx)) (car at))) ; (print-dot)
finally (return at)))
do (ut at p mx lo) #|(print-dot)|#))))
Index: fomus/version.lisp
diff -u fomus/version.lisp:1.5 fomus/version.lisp:1.6
--- fomus/version.lisp:1.5 Sat Aug 27 20:13:21 2005
+++ fomus/version.lisp Tue Aug 30 00:28:04 2005
@@ -12,7 +12,7 @@
(declaim (type string +title+)
(type cons +version+ +banner+))
(defparameter +title+ "FOMUS")
-(defparameter +version+ '(0 1 10))
+(defparameter +version+ '(0 1 11))
(defparameter +banner+
`("Lisp music notation formatter"
"Copyright (c) 2005 David Psenicka, All Rights Reserved"
Index: fomus/voices.lisp
diff -u fomus/voices.lisp:1.8 fomus/voices.lisp:1.9
--- fomus/voices.lisp:1.8 Sun Aug 21 21:17:41 2005
+++ fomus/voices.lisp Tue Aug 30 00:28:04 2005
@@ -176,17 +176,19 @@
:remscoregreaterfun #'remscoregreaterfun)))
(error "Cannot distribute voices within limits of specified instrument in part ~S" name))))))
-(defun voices-setvoice (events)
+(defun voices-setvoice (events name)
(declare (type list events))
(loop for e of-type (or noteex restex) in events when (listp (event-voice e)) do
- (setf (event-voice e) (if (event-voice e) (first (event-voice e)) 1))))
+ (setf (event-voice e) (if (event-voice e) (if (list>1p (event-voice e))
+ (error "Only one voice allowed when :AUTO-VOICING is NIL in note at offset ~S, part ~S" (event-foff e) name)
+ (first (event-voice e))) 1))))
;; distribute ambiguous voice assignments (lists)
(defun voices (parts)
(declare (type list parts))
(loop
for e of-type partex in parts
- if (is-percussion e) do (voices-setvoice (part-events e))
+ if (is-percussion e) do (voices-setvoice (part-events e) (part-name e))
else do (multiple-value-bind (evs rs) (split-list (part-events e) #'notep)
(setf (part-events e)
(sort (nconc (loop ; copy rests to all voices if voice slot is a list
@@ -200,7 +202,7 @@
(defun voices-generic (parts)
(declare (type list parts))
- (loop for p of-type partex in parts do (voices-setvoice (part-events p))))
+ (loop for p of-type partex in parts do (voices-setvoice (part-events p) (part-name p))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMBINE VOICES
More information about the Fomus-cvs
mailing list