fomus-cvs

fomus-cvs@common-lisp.net

56 discussions

[fomus-cvs] CVS update: fomus/README fomus/TODO fomus/backend_ly.lisp fomus/backends.lisp fomus/data.lisp fomus/main.lisp fomus/marks.lisp fomus/package.lisp fomus/postproc.lisp fomus/quantize.lisp fomus/split.lisp fomus/voices.lisp
by dpsenicka＠common-lisp.net 25 Jul '05

25 Jul '05

Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv10374 Modified Files: README TODO backend_ly.lisp backends.lisp data.lisp main.lisp marks.lisp package.lisp postproc.lisp quantize.lisp split.lisp voices.lisp Log Message: Testing/bug fixes Date: Mon Jul 25 09:56:03 2005 Author: dpsenicka Index: fomus/README diff -u fomus/README:1.1 fomus/README:1.2 --- fomus/README:1.1 Thu Jul 21 17:38:42 2005 +++ fomus/README Mon Jul 25 09:56:03 2005 @@ -2,12 +2,15 @@ Lisp music notation formatter Fomus is alpha software, and still has a lot of testing and bug fixing to go -before all of its features are useable. +before all of its features are useable. Not all features that appear in the +documentation are implemented yet. Also, some parts of the program are running +slowly due to some settings being currently set to conservative values. See the file "fomus.html" in the doc directory for instructions on how to use the program. The following command loads FOMUS into lisp: (load "path_to_fomus_directory/load.lisp") + (use-package fm) The program is being developed in SBCL, but should also compile in CMUCL and OpenMCL. It will eventually be supported in Allegro Common Lisp and CLISP. Index: fomus/TODO diff -u fomus/TODO:1.3 fomus/TODO:1.4 --- fomus/TODO:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/TODO Mon Jul 25 09:56:03 2005 @@ -3,12 +3,15 @@ IMMEDIATE Testing and bug fixes -BUG: :startslur- and :slur- marks +Information on anonymous CVS downloading BUG: error in beams in CMUCL -DOC: dynamics marks can take order arguments (backend might not support it) -DOC: make sure user knows to use the package -DOC: make sure user knows about :default-beat setting +DOC: dynamic marks can take order arguments (backend might not support it) +DOC: other interface functions +DOC: part properties Adjust scores and penalties for decent results +Breath marks (resolve before/after) +Noteheads +Fix fingering mark (no finger number argument) @@ -24,6 +27,9 @@ Reorganize settings MIDI input interface Support for polymeters in backends +Integrate user graceslur overrides +Levels for single text marks +Remove redundant dynamic marks Index: fomus/backend_ly.lisp diff -u fomus/backend_ly.lisp:1.3 fomus/backend_ly.lisp:1.4 --- fomus/backend_ly.lisp:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/backend_ly.lisp Mon Jul 25 09:56:03 2005 @@ -43,7 +43,7 @@ (defparameter +lilypond-out-ext+ "ps") (defparameter +lilypond-view-opts+ #-darwin nil #+darwin '("/Applications/Preview.app")) -(defun view-lilypond (filename options) +(defun view-lilypond (filename options view) (when (>= *verbose* 1) (out ";; Compiling/opening \"~A\" for viewing...~%" filename)) (destructuring-bind (xxx &key exe view-exe exe-opts view-exe-opts out-ext &allow-other-keys) options (declare (ignore xxx)) @@ -58,10 +58,11 @@ (append (or exe-opts +lilypond-opts+) (list filename)) :wait t #|:output *standard-output*|#) (progn (unless (probe-file (change-filename filename :ext (or out-ext +lilypond-out-ext+))) (er "compiling")) - (unless (#+cmu extensions:run-program #+sbcl sb-ext:run-program #+openmcl ccl:run-program (or view-exe +lilypond-view-exe+) - (append (or view-exe-opts +lilypond-view-opts+) (list (change-filename filename :ext (or out-ext +lilypond-out-ext+)))) - :wait nil #|:output *standard-output*|#) - (er "viewing"))) + (when view + (unless (#+cmu extensions:run-program #+sbcl sb-ext:run-program #+openmcl ccl:run-program (or view-exe +lilypond-view-exe+) + (append (or view-exe-opts +lilypond-view-opts+) (list (change-filename filename :ext (or out-ext +lilypond-out-ext+)))) + :wait nil #|:output *standard-output*|#) + (er "viewing")))) (er "compiling"))) #-(and (or cmu sbcl openmcl) (or linux darwin unix)) (format t ";; ERROR: Don't know how to compile/view lilypond file~%")))) @@ -109,7 +110,7 @@ ;; TODO: support texts, spanners and tremelos, remove dependency on ACCIDENTALYS -(defun save-lilypond (parts filename options view) +(defun save-lilypond (parts filename options process view) (when (>= *verbose* 1) (out ";; Saving Lilypond file \"~A\"...~%" filename)) (with-open-file (f filename :direction :output :if-exists :supersede) (destructuring-bind (xxx &key filehead scorehead &allow-other-keys) options @@ -144,7 +145,7 @@ (loop for p in parts do (destructuring-bind (&key (lily-partname (lyname p)) - parthead ;; extra header information for part (list of strings) + 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)) @@ -170,7 +171,7 @@ (loop for (xxx cl s) in (sort (getprops p :clef) #'< :key #'third) do (format f " ~A\\clef ~A~%" (lystaff s) (lyclef cl))) (format f " \\clef ~A~%" (lyclef (second (getprop p :clef))))) - (loop for e in parthead do (format f " ~A~%" e)) + (loop for e in lily-parthead do (format f " ~A~%" e)) (format f "~%") (loop for m in (part-meas p) and mn from 1 @@ -336,5 +337,5 @@ for xxx in (getprops p :endgroup) do (decf in 2) (format f "~A>>~%" (make-string in :initial-element #\space)))) (format f "}~%"))))) - (when view (view-lilypond filename options))) + (when process (view-lilypond filename options view))) Index: fomus/backends.lisp diff -u fomus/backends.lisp:1.1.1.1 fomus/backends.lisp:1.2 --- fomus/backends.lisp:1.1.1.1 Tue Jul 19 20:16:55 2005 +++ fomus/backends.lisp Mon Jul 25 09:56:03 2005 @@ -21,9 +21,9 @@ (prin1 parts f) (fresh-line f))) -(defun backend (backend filename parts options view) +(defun backend (backend filename parts options process view) (case backend (:data (save-data filename parts)) - (:lilypond (save-lilypond parts filename options view)) + (:lilypond (save-lilypond parts filename options process view)) (otherwise (error "Unknown backend ~A" backend)))) Index: fomus/data.lisp diff -u fomus/data.lisp:1.3 fomus/data.lisp:1.4 --- fomus/data.lisp:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/data.lisp Mon Jul 25 09:56:03 2005 @@ -31,7 +31,7 @@ (defparameter *min-tuplet-dur* 1/2) ; fraction of beat smallest tuplets should span at minimum (1/2 = half a beat, etc.)--can be nil (defparameter *max-tuplet-dur* 4) -(defparameter *default-beat* nil) +(defparameter *default-beat* 1/4) ;; pitch quantizing (declaim (special *note-precision*)) @@ -304,7 +304,7 @@ (:timesig-style (or* null (find* :fraction :common)) ":FRACTION or :COMMON") (:tuplet-style (or* null (find* :ratio :single)) ":RATIO or :SINGLE") - (:quantize-adjust-grace-durs boolean) + ;;(:quantize-adjust-grace-durs boolean) (:default-grace-dur (rational (0))) (:default-grace-num integer) (:effective-grace-dur-mul (rational (0))) (:min-auto-timesig-dur (rational (0))) (:default-timesig (type* +timesig-repl-type+) "TIMESIG object") @@ -314,6 +314,7 @@ (:auto-ottavas boolean) (:auto-grace-slurs boolean) (:auto-voicing boolean) (:auto-beams boolean) (:auto-quantize boolean) (:auto-multivoice-rests boolean) (:auto-multivoice-notes boolean) (:auto-override-timesigs boolean) + (:auto-pizz/arco boolean) (:split-fun symbol) (:auto-accs-fun symbol) (:auto-voices-fun symbol) (:auto-distr-rests-fun symbol) (:auto-multivoice-comb-fun symbol) (:auto-ottavas-fun symbol) (:auto-beam-fun symbol) (:auto-quantize-fun symbol) @@ -331,7 +332,7 @@ (:tuplet-dotted-rests boolean) (:double-dotted-notes boolean) (:dotted-note-level (find* t :all :top :sig) "T, :ALL, :TOP or :SIG") (:shortlongshort-notes-level (find* t :all :top :sig) "T, :ALL, :TOP or :SIG") - (:syncopated-notes-level (find* t :all :top :sig) "T, :ALL, :TOP or :SIG") + (:syncopated-notes-level boolean) (:acc-engine-heap (integer 100)) (:acc-importance-score (real (0) 1)) (:acc-importance-steps (integer 1)) (:voice-engine-heap (integer 100)) (:voice-importance-score (real (0) 1)) (:voice-importance-steps (integer 1)) @@ -391,7 +392,7 @@ (or* (unique* sy :glissbefore x) (list* (unique* sy :glissbefore x)) (list* (unique* sy :glissbefore x) (eql* :before)) (list* (unique* sy :glissafter x) (eql* :after)))) (let* ((x (find* :breath))) - (or* (unique* sy :breathbefore x) (list* (unique* sy :breathbefore x)) + (or* (unique* sy :breathafter x) (list* (unique* sy :breathafter x)) (list* (unique* sy :breathbefore x) (eql* :before)) (list* (unique* sy :breathafter x) (eql* :after)))) (let* ((x (find* :harmonic))) (or* (cons* (unique* sy :harmtouched x) @@ -494,8 +495,10 @@ (defparameter +marks-all-ties+ '(:longtrill :tremolo :lefthandtremolo :righthandtremolo)) +(defparameter *auto-pizz/arco* t) + (defparameter +marks-on-off+ - '((:pizz . :arco))) + '((*auto-pizz/arco* . (:pizz . :arco)))) ;; marks that prevent notes from combining into chords if they differ (defparameter +marks-indiv-voices+ Index: fomus/main.lisp diff -u fomus/main.lisp:1.3 fomus/main.lisp:1.4 --- fomus/main.lisp:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/main.lisp Mon Jul 25 09:56:03 2005 @@ -58,7 +58,7 @@ (multiple-value-bind (*timesigs* *keysigs* rm) (split-list *global* #'timesigp #'keysigp) #-debug (declare (ignore rm)) #+debug (when rm (error "Error in FOMUS-PROC")) - (multiple-value-bind (mks *events*) (split-list *events* #'markp) + (multiple-value-bind (*events* mks) (split-list *events* (lambda (x) (or (notep x) (restp x)))) (let ((pts (progn (loop for p in *parts* and i from 0 do (multiple-value-bind (ti ke evs ma) (split-list (part-events p) #'timesigp #'keysigp @@ -124,23 +124,20 @@ (reset-tempslots pts 0) (distribute-marks pts mks) (setf pts (sep-staves pts)) ; ********** STAVES SEPARATED - (if *auto-quantize* (clean-quantize pts)) + ;;(if *auto-quantize* (clean-quantize pts)) (when *auto-ottavas* ; (before clean-spanners) (when (>= *verbose* 2) (out "~&; Ottavas...")) (ottavas pts) #+debug (fomus-proc-check pts 'ottavas)) (when (>= *verbose* 2) (out "~&; Staff spanners...")) (clean-spanners pts +marks-spanner-staves+) #+debug (fomus-proc-check pts 'spanners1) - ;; (setf pts (sep-voices pts)) #+debug (fomus-proc-check pts 'sepvoices) (setf pts (sep-voices (assemble-parts pts))) ; ********** STAVES TOGETHER, VOICES SEPARATED (when (>= *verbose* 2) (out "~&; Voice spanners...")) (expand-marks pts) #+debug (fomus-proc-check pts 'expandmarks) (clean-spanners pts +marks-spanner-voices+) #+debug (fomus-proc-check pts 'spanners2) - (when (and (>= *verbose* 2) (and *auto-grace-slurs* *auto-cautionary-accs*)) - (out "~&; Voice items...")) + (when (>= *verbose* 2) (out "~&; Miscellaneous items...")) (preproc-cautaccs pts) (when *auto-grace-slurs* (grace-slurs pts) #+debug (fomus-proc-check pts 'graceslurs)) - ;; (setf pts (sep-voices (assemble-parts pts))) (when (>= *verbose* 2) (out "~&; Measures...")) (init-parts *timesigs* pts) ; ----- MEASURES #+debug (fomus-proc-check pts 'measures) @@ -184,7 +181,7 @@ (defun fomus-main () (let ((r (fomus-proc))) (loop for x in (or (force-list2 *backend*) '((:data))) - do (destructuring-bind (ba &key filename view &allow-other-keys) x - (backend ba (or filename (change-filename *base-filename* :ext (lookup ba +backendexts+))) r x view)))) + do (destructuring-bind (ba &key filename process view &allow-other-keys) x + (backend ba (or filename (change-filename *base-filename* :ext (lookup ba +backendexts+))) r x (or process view) view)))) t) Index: fomus/marks.lisp diff -u fomus/marks.lisp:1.3 fomus/marks.lisp:1.4 --- fomus/marks.lisp:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/marks.lisp Mon Jul 25 09:56:03 2005 @@ -17,13 +17,17 @@ (defun grace-slurs (pts) (loop for p in pts do - (loop for e in (part-events p) do (rmmark e :startgraceslur-) (rmmark e :graceslur-) (rmmark e :endgraceslur-)) (loop for e in (delete-if (lambda (x) (notany #'event-grace x)) (split-into-groups (part-events p) #'event-off)) - for s = (sort e #'sort-offdur) - do - (addmark (first s) :startgraceslur-) - (addmark (find-if-not #'event-grace s) :endgraceslur-)) + for s = (sort e (complement #'sort-offdur)) + do (loop with sl and li + for x in s + when (or (getmark x :endgraceslur-) (getmark x :graceslur-)) + do (if sl (error "Missing STARTGRACESLUR- mark in part ~A, offset ~A" (part-name p) (event-foff e)) (setf sl t)) (when li (addmark (first li) :startgraceslur-) (addmark (last-element li) :endgraceslur-) (setf li nil)) + unless sl do (push x li) + when (getmark x :startgraceslur-) do (if sl (setf sl nil) (error "Missing GRACESLUR-/ENDGRACESLUR- slur mark in part ~A, offset ~A" (part-name p) (event-foff e))) + finally + (when li (addmark (first li) :startgraceslur-) (addmark (last-element li) :endgraceslur-)))) (print-dot))) ;; must be in separate voices @@ -134,7 +138,11 @@ (if (null vo) l (remove-if-not (lambda (e) (find (event-voice* e) vo)) l))))) (if re r (remove-if #'restp r))))) (let ((o (let ((q (getprop p :quant))) ; fix quantize error - (if q (let ((x (find-if (lambda (x) (and (<= (car x) o0) (>= (cdr x) o0))) (rest q)))) + (if q (let ((x (find-if (lambda (x) (and (funcall (caar x) o0) + (if (< (cdar x) (cdr x)) + (< o0 (cdr x)) ; --> + (> o0 (cdr x))))) ; <-- + (rest q)))) (if x (cdr x) o0)) o0)))) (if di Index: fomus/package.lisp diff -u fomus/package.lisp:1.3 fomus/package.lisp:1.4 --- fomus/package.lisp:1.3 Sat Jul 23 11:23:14 2005 +++ fomus/package.lisp Mon Jul 25 09:56:03 2005 @@ -53,7 +53,7 @@ (use-package "DBG" "FM"))) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 2)) +(defparameter +version+ '(0 1 3)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005 David Psenicka, All Rights Reserved" Index: fomus/postproc.lisp diff -u fomus/postproc.lisp:1.1.1.1 fomus/postproc.lisp:1.2 --- fomus/postproc.lisp:1.1.1.1 Tue Jul 19 20:16:59 2005 +++ fomus/postproc.lisp Mon Jul 25 09:56:03 2005 @@ -241,7 +241,7 @@ (addprop m (list :barline :final)))) (print-dot))) (defun postproc-marksonoff (pts) - (loop for (a . b) in +marks-on-off+ do + (loop for (v . (a . b)) in +marks-on-off+ when (symbol-value v) do (loop with o for p in pts do (loop for m in (part-meas p) do (loop for g in (meas-voices m) do Index: fomus/quantize.lisp diff -u fomus/quantize.lisp:1.2 fomus/quantize.lisp:1.3 --- fomus/quantize.lisp:1.2 Thu Jul 21 17:38:43 2005 +++ fomus/quantize.lisp Mon Jul 25 09:56:03 2005 @@ -80,7 +80,7 @@ collect (adj (dv o (loop for i in ep when (<= i os) collect i) e1 ts) (dv os (loop for i in ep when (>= i os) collect i) e2 ts)))))))) (loop for p in parts - for ph = (gethash p h) + for ph = (gethash p h) ; ph = timesigs for part do (let* ((ee (sort (delete-duplicates (loop for e in (part-events p) collect (event-off e) collect (event-endoff e))) #'<)) (qs (sort (delete-duplicates @@ -102,38 +102,56 @@ (let ((o (event-off e))) (loop while (and (list>1p qs) (< (second qs) o)) do (pop qs)) (let ((e1 (loop-return-firstmin (diff x o) for x in qs))) - (if (event-grace e) + (flet ((aa (oo ee) + (cond ((< oo ee) (push (cons (cons #'>= oo) ee) ad)) ; --> + ((> oo ee) (push (cons (cons #'< oo) ; <-- + (loop for (x1 x2) on qs until (or (null x2) (>= x2 ee)) + finally (return x1))) + ad))))) + (if (event-grace e) (progn - (push (cons (event-off e) e1) ad) + (cond ((< (event-off e) e1) (push (cons (cons #'>= (event-off e)) e1) ad)) ; --> + ((> (event-off e) e1) (push (cons (cons #'<= (event-off e)) e1) ad))) ; <-- (setf (event-off e) e1 (event-dur* e) (let ((bd (/ (beat-division (loop for s in ph until (<= (timesig-off s) e1) finally (return s)))))) (let ((x (roundto (event-gracedur e) bd))) (when (<= x 0) bd x))))) (let ((e2 (let ((o (event-endoff e))) (loop-return-lastmin (diff x o) for x in qs)))) - (push (cons (event-off e) e1) ad) + (aa (event-off e) e1) (setf (event-off e) e1) (let ((x (- e2 e1))) (if (<= x 0) (progn - (addmark e :grace) + (debugn "gr: ~A" e) + (aa (event-endoff e) e1) + ;; (addmark e :grace) (setf (event-dur e) - (cons (- (loop for i in qs until (> i e1) finally (return i)) e1) + (cons *default-grace-dur* #|(- (loop for i in qs until (> i e1) finally (return i)) e1)|# (incf mg)))) (progn - (push (cons (event-endoff e) e2) ad) - (setf (event-dur* e) x)))))))) + (aa (event-endoff e) e2) + (setf (event-dur* e) x))))))))) finally - (addprop p (cons :quant - (merge-all ad (lambda (x y) (let ((x1 (car x)) (x2 (cdr x)) - (y1 (car y)) (y2 (cdr y))) - (when (= x2 y2) - (cons (if (< x1 x2) - #+debug (if (<= y1 y2) (min x1 y1) (error "Error in QUANTIZE-BYFIT 3")) - #-debug (min x1 y1) - #+debug (if (>= y1 y2) (max x1 y1) (error "Error in QUANTIZE-BYFIT 4")) - #-debug (max x1 y1)) - x2)))) - :call-rev nil)))))) + (addprop p (cons :quant ; temporary prop: collection of all point movements + (merge-all ad (lambda (x y) (let ((x1 (cdar x)) (x2 (cdr x)) + (y1 (cdar y)) (y2 (cdr y))) + (cond ((and (< x1 x2) (< y1 y2)) ; --> + (when (and (>= x2 y1) (>= y2 x1)) ; always #'>= + (cons (if (< x1 y1) (car x) (car y)) + (max x2 y2)))) + ((and (> x1 x2) (> y1 y2)) ; <-- + (cond ((or (and (> x1 y2) (> y1 x2)) ; overlap + (and (= x1 y2) (eq (caar x) #'<=)) ; touching + (and (= y1 x2) (eq (caar y) #'<=))) + (cons (cond ((= x1 y1) (cons (if (or (eq (caar x) #'<=) + (eq (caar y) #'<=)) + #'<= #'<) + x1)) + ((> x1 y1) (car x)) + (t (car y))) + (min x2 y2)))))))) + :call-rev nil))) + (setf (part-events p) (sort (part-events p) #'sort-offdur))))) (print-dot))))) (defun quantize (timesigs parts) @@ -141,24 +159,27 @@ (:quantize1 (quantize-byfit timesigs parts)) (otherwise (error "Unknown quantize function ~A" *auto-quantize-fun*)))) -(defparameter *quantize-adjust-grace-durs* t) +;; (defparameter *quantize-adjust-grace-durs* t) -(defun clean-quantize (parts) - (loop for p in parts do - (loop for v in (split-into-groups (part-events p) #'event-voice*) do - (when *quantize-adjust-grace-durs* - (loop with d - for e in (sort (copy-list v) (complement #'sort-offdur)) - if (getmark e :grace) - do (setf (event-dur* e) (if d (min d *default-grace-dur*) *default-grace-dur*)) - else if (event-grace e) do (setf d nil) else do (setf d (event-dur* e)))) - (loop with g and di = (>= *default-grace-num* 0) ; di = t if forward and default grace >= 0 - for e in (sort v (if di #'sort-offdur (complement #'sort-offdur))) - if (popmark e :grace) - do (setf (event-grace* e) (setf g (if g - (if di (max (1+ g) *default-grace-num*) (min (1- g) *default-grace-num*)) - *default-grace-num*))) - else if (event-grace e) do (setf g (event-grace e)))))) +;; (defun clean-quantize (parts) +;; (when *quantize-adjust-grace-durs* +;; (loop for p in parts do +;; (loop for v in (split-into-groups (part-events p) #'event-voice*) do +;; (loop with d and do +;; for e in (sort (copy-list v) (complement #'sort-offdur)) +;; if (and d (getmark e :grace) (eql (event-off e) do)) +;; do (setf (event-dur* e) (let for x = *default-grace-dur* then (/ x 2) until (<= x d) finally (return x))) +;; else if (notep e) do (setf d (event-dur* e)) +;; else do (setf d nil) +;; do (setf do (event-off e)))) +;; ;; (loop with g and di = (>= *default-grace-num* 0) ; di = t if forward and default grace >= 0 +;; ;; for e in (sort v (if di #'sort-offdur (complement #'sort-offdur))) +;; ;; if (popmark e :grace) +;; ;; do (setf (event-grace* e) (setf g (if g +;; ;; (if di (max (1+ g) *default-grace-num*) (min (1- g) *default-grace-num*)) +;; ;; *default-grace-num*))) +;; ;; else if (event-grace e) do (setf g (event-grace e))) +;; ))) (defun quantize-generic (parts) (loop for p in parts do Index: fomus/split.lisp diff -u fomus/split.lisp:1.2 fomus/split.lisp:1.3 --- fomus/split.lisp:1.2 Sat Jul 23 11:23:14 2005 +++ fomus/split.lisp Mon Jul 25 09:56:03 2005 @@ -144,6 +144,14 @@ (setf gs (loop for e in (split-into-groups gs (lambda (x) (cons (event-off x) (event-grace x))) :test 'equal) ; put vertical notes into chords (note = list of notes, combine all attributes) if (list>1p e) collect (make-chord e) else collect (first e))) + (loop ; split places at grace note offsets + for g in gs + for i = (event-off g) + do (setf ns (loop + for e in ns + for (j . k) = (split-event e i) + when j collect j + when k collect k))) (loop for e in (nconc gs ns) ; separate notes belonging to next measure--notes after endoff already split if (< (event-off e) endoff) collect e into v1 @@ -505,7 +513,7 @@ (let ((x (sort (copy-list li) (complement #'sort-offdur)))) (setf li (ex (second x) (first x) x)))))) li)) - (let ((lm (/ (* (beat-division timesig) 4)))) + (let ((lm (/ (* (beat-division timesig) 65536)))) (flet ((scorefun (nd) ; score relative to ea. level (if (splitnode-pts nd) (loop @@ -588,10 +596,10 @@ (mn (drst (loop for e in nds append (splitnode-evs e)) rl))))))) (solutfun (nd) ; complete/valid? (if (splitnode-pts nd) - (let ((x (splitnode-rl nd))) - (every (lambda (n) (or (truep n) (split-valid n off endoff x))) (splitnode-evs nd))) - (or (truep (splitnode-evs nd)) - (split-valid (splitnode-evs nd) off endoff (splitnode-rl nd)))))) + (let ((x (splitnode-rl nd))) + (every (lambda (n) (or (truep n) (split-valid n off endoff x))) (splitnode-evs nd))) + (or (truep (splitnode-evs nd)) + (split-valid (splitnode-evs nd) off endoff (splitnode-rl nd)))))) (multiple-value-bind (evs grs) (loop for p in events Index: fomus/voices.lisp diff -u fomus/voices.lisp:1.1.1.1 fomus/voices.lisp:1.2 --- fomus/voices.lisp:1.1.1.1 Tue Jul 19 20:16:55 2005 +++ fomus/voices.lisp Mon Jul 25 09:56:03 2005 @@ -148,7 +148,7 @@ :heaplim *voice-engine-heap* :scoregreaterfun #'scoregreaterfun :remscoregreaterfun #'remscoregreaterfun))) - (error "Cannot find voice distribution for part ~A" name)))))) + (error "Cannot distribute voices for part ~A" name)))))) (defun voices-setvoice (events) (loop for e in events when (listp (event-voice e)) do

1 0

[fomus-cvs] CVS update: fomus/TODO fomus/accidentals.lisp fomus/backend_ly.lisp fomus/classes.lisp fomus/data.lisp fomus/interface.lisp fomus/main.lisp fomus/marks.lisp fomus/misc.lisp fomus/package.lisp fomus/split.lisp fomus/util.lisp
by dpsenicka＠common-lisp.net 23 Jul '05

23 Jul '05

Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv20942 Modified Files: TODO accidentals.lisp backend_ly.lisp classes.lisp data.lisp interface.lisp main.lisp marks.lisp misc.lisp package.lisp split.lisp util.lisp Log Message: Testing/bug fixes Date: Sat Jul 23 11:23:14 2005 Author: dpsenicka Index: fomus/TODO diff -u fomus/TODO:1.2 fomus/TODO:1.3 --- fomus/TODO:1.2 Thu Jul 21 17:38:42 2005 +++ fomus/TODO Sat Jul 23 11:23:14 2005 @@ -3,6 +3,12 @@ IMMEDIATE Testing and bug fixes +BUG: :startslur- and :slur- marks +BUG: error in beams in CMUCL +DOC: dynamics marks can take order arguments (backend might not support it) +DOC: make sure user knows to use the package +DOC: make sure user knows about :default-beat setting +Adjust scores and penalties for decent results @@ -17,6 +23,7 @@ Reorganize code, update comments Reorganize settings MIDI input interface +Support for polymeters in backends @@ -24,4 +31,4 @@ Features for proportional notation (generate hidden rests of constant duration?) Key signatures (key detection algorithm) -Combine sections with different settings into one score +Combine separately notated sections with different settings into one score (concatenate multiple .fms files?) Index: fomus/accidentals.lisp diff -u fomus/accidentals.lisp:1.2 fomus/accidentals.lisp:1.3 --- fomus/accidentals.lisp:1.2 Thu Jul 21 17:38:42 2005 +++ fomus/accidentals.lisp Sat Jul 23 11:23:14 2005 @@ -114,7 +114,7 @@ (aa n2 a2)))) (if qt v (max v 0))))))) (defun nokeyq-intscore (tie note1 acc1 off1 eoff1 note2 acc2 off2 eoff2) - (let ((s (nokey-intscore (- note1 (cdr acc1)) (car acc1) off1 eoff1 (- note2 (cdr acc2)) (car acc2) off2 eoff2 t))) + (let ((s (nokey-intscore tie (- note1 (cdr acc1)) (car acc1) off1 eoff1 (- note2 (cdr acc2)) (car acc2) off2 eoff2 t))) (if (and (= (cdr acc1) 0) (= (cdr acc2) 0)) (max s 0) (let ((a1 (if (= (cdr acc1) 0) (car acc1) (cdr acc1))) (a2 (if (= (cdr acc2) 0) (car acc2) (cdr acc2)))) Index: fomus/backend_ly.lisp diff -u fomus/backend_ly.lisp:1.2 fomus/backend_ly.lisp:1.3 --- fomus/backend_ly.lisp:1.2 Thu Jul 21 17:38:42 2005 +++ fomus/backend_ly.lisp Sat Jul 23 11:23:14 2005 @@ -69,9 +69,6 @@ ;; LILYPOND BACKEND (defparameter +lilypond-head+ - '("\\version \"2.4.2\"" - "\\include \"english.ly\"")) -(defparameter +lilypond-headq+ ;; quarter tones aren't supported in english '("\\version \"2.4.2\"")) (defparameter +lilypond-defs+ '("octUp = #(set-octavation 1)" @@ -83,8 +80,8 @@ )) (defparameter +lilypond-num-note+ (vector "c" nil "d" nil "e" "f" nil "g" nil "a" nil "b")) -(defparameter +lilypond-num-acc+ (vector "ff" "f" "" "s" "ss")) -(defparameter +lilypond-num-accq+ (vector (vector nil "eseh") (vector "eseh" "es" "eh") (vector "eh" "" "ih") (vector "ih" "is" "isih") (vector nil "isis"))) +(defparameter +lilypond-num-acc+ (vector "eses" "es" "" "is" "isis")) +(defparameter +lilypond-num-accq+ (vector (vector nil "eses") (vector "eseh" "es" "eh") (vector "eh" "" "ih") (vector "ih" "is" "isih") (vector nil "isis"))) (defparameter +lilypond-num-reg+ (vector ",,," ",," "," "" "'" "''" "'''" "''''" "'''''")) (defparameter +lilypond-barlines+ '((:single . "|") (:double . "||") (:final . "|.") (:repeatleft . ":|") (:repeatright . "|:") (:repeatleftright . ":|:") (:invisible . ""))) @@ -118,7 +115,7 @@ (destructuring-bind (xxx &key filehead scorehead &allow-other-keys) options (declare (ignore xxx)) (format f "% ~A v~A.~A.~A~%~%" +title+ (first +version+) (second +version+) (third +version+)) - (loop for e in (if *quartertones* +lilypond-headq+ +lilypond-head+) do (format f "~A~%" e) finally (format f "~%")) ;; stuff at top + (loop for e in +lilypond-head+ do (format f "~A~%" e) finally (format f "~%")) ;; stuff at top (when filehead (loop for e in filehead do (format f "~A~%" e) finally (format f "~%"))) ;; user header (loop for e in +lilypond-defs+ do (format f "~A~%" e) finally (format f "~%")) ;; definitions (let ((de 0) (nms nil)) @@ -252,11 +249,11 @@ (t ""))) and ar = (conc-stringlist (loop for i in - (sort (loop for a in +lilypond-marks+ nconc (getmarks e (car a))) + (sort (loop for a in +lilypond-marks+ nconc (mapcar #'force-list (getmarks e (car a)))) (lambda (x y) (let ((x2 (second x)) (y2 (second y))) (cond ((and (numberp x2) (numberp y2)) (< x2 y2)) (x2 t))))) - collect (lookup i +lilypond-marks+))) + collect (lookup (first i) +lilypond-marks+))) ;and txt = ... and we0 = (cond ((and (getmark e :startwedge<) (getmark e :endwedge-)) "\\< ") ((and (getmark e :startwedge>) (getmark e :endwedge-)) "\\> ") @@ -270,26 +267,23 @@ (t "")) and dyn = (conc-stringlist (loop for i in - (sort (loop for a in +lilypond-dyns+ nconc (getmarks e (car a))) - (lambda (x y) (let ((x2 (second x)) (y2 (second y))) - (cond ((and (numberp x2) (numberp y2)) (< x2 y2)) - (x2 t))))) - collect (lookup i +lilypond-marks+))) + (loop for a in +lilypond-dyns+ nconc (mapcar #'force-list (getmarks e (car a)))) + collect (lookup (first i) +lilypond-dyns+))) and s1 = (conc-stringlist (loop - for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :startslur-)) + for xxx in (delete-if (lambda (x) (/= (second x) 1)) (getmarks e :startslur-)) collect "(")) and s2 = (conc-stringlist (loop - for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :endslur-)) + for xxx in (delete-if (lambda (x) (/= (second x) 1)) (getmarks e :endslur-)) collect ")")) and sl1 = (conc-stringlist (loop - for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :startslur-)) + for xxx in (delete-if (lambda (x) (/= (second x) 2)) (getmarks e :startslur-)) collect "(")) and sl2 = (conc-stringlist (loop - for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :endslur-)) + for xxx in (delete-if (lambda (x) (/= (second x) 2)) (getmarks e :endslur-)) collect ")")) do (format f "~A " (conc-strings st vo cl ot1 tu1 gr1 we0 bnu ba du sl1 s1 s2 sl2 be1 be2 ti ar we1 dyn #|txt|# we2 gr2 tu2 ot2))) when een do (format f s2)) Index: fomus/classes.lisp diff -u fomus/classes.lisp:1.2 fomus/classes.lisp:1.3 --- fomus/classes.lisp:1.2 Thu Jul 21 17:38:42 2005 +++ fomus/classes.lisp Sat Jul 23 11:23:14 2005 @@ -120,7 +120,7 @@ (declaim (inline timesig-num timesig-den)) (defun timesig-num (ts) (car (timesig-time ts))) (defun timesig-den (ts) (cdr (timesig-time ts))) -(defun timesig-beat* (ts) (if (timesig-comp ts) (/ 3 (timesig-den ts)) (or (timesig-beat ts) (/ (timesig-den ts))))) +(defun timesig-beat* (ts) (if (timesig-comp ts) (/ 3 (timesig-den ts)) (or (timesig-beat ts) *default-beat* (/ (timesig-den ts))))) (declaim (inline obj-partid)) (defgeneric obj-partid (x)) Index: fomus/data.lisp diff -u fomus/data.lisp:1.2 fomus/data.lisp:1.3 --- fomus/data.lisp:1.2 Thu Jul 21 17:38:42 2005 +++ fomus/data.lisp Sat Jul 23 11:23:14 2005 @@ -31,6 +31,8 @@ (defparameter *min-tuplet-dur* 1/2) ; fraction of beat smallest tuplets should span at minimum (1/2 = half a beat, etc.)--can be nil (defparameter *max-tuplet-dur* 4) +(defparameter *default-beat* nil) + ;; pitch quantizing (declaim (special *note-precision*)) (defparameter *quartertones* nil) @@ -321,7 +323,8 @@ (:default-meas-divs (or* null (list-of* (cons* (rational 0) (list-of* (list-of* (rational 0)))))) "list of ((RATIONAL (0)) (((RATIONAL (0)) ...) ...))") (:use-default-tuplet-divs boolean) (:default-tuplet-divs (or* null (list-of* (cons* (integer 1) (list-of* (list-of* (integer 1)))))) "list of ((INTEGER 1) (((INTEGER 1) ...) ...))") - + + (:default-beat (or null (rational (0)))) (:beat-division (or* (integer 1) (and (list* (integer 1) (integer 1)) (length* = 2))) "(INTEGER 1) or ((INTEGER 1) (INTEGER 1))") (:min-tuplet-dur (real (0))) (:max-tuplet-dur (real (0))) (:min-simple-tuplet-dur (real (0))) (:max-tuplet (or* (integer 2) (list-of* (integer 2))) "(INTEGER 2) or list of (INTEGER 2)") @@ -377,9 +380,9 @@ :startwedge> :startwedge< :wedge- :endwedge- :startgraceslur- :graceslur- :endgraceslur- :clef- :endclef- - :rfz :sfz :spp :sp :sff :sf :fp :fffff :ffff :fff :ff :f :mf :mp :p :pp :ppp :pppp :ppppp - :cautacc)))) - x (list* x)) ; spanners w/ only 1 level, non-articulations + :cautacc + :rfz :sfz :spp :sp :sff :sf :fp :fffff :ffff :fff :ff :f :mf :mp :p :pp :ppp :pppp :ppppp)))) + (or* x (list* x))) ; spanners w/ only 1 level, non-articulations (let* ((x (unique* sy (find* :fermata)))) (or* x (list* x) (list* x (find* :short :long :verylong)))) (let* ((x (unique* sy (find* :arpeggio)))) @@ -399,7 +402,7 @@ :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)))) - (or* x (list* x) (list* x integer))) ; articulations, some spanners + (or* x (list* x) (list* x integer))) ; articulations, dynamics, some spanners (let* ((x (unique* sy :clef (find* :clef :startclef-)))) (list* x (function* is-clef))) (let* ((x (unique* sy (find* :notehead)))) @@ -412,7 +415,7 @@ (unique* si 1 (eql* :dotted)) (list* (unique* si integer) (eql* :dotted)) (list* (eql* :dotted) (unique* si integer)))))) ; startslur- - (let* ((x (unique* sy (find* :slur- :endslur-)))) + (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))) (list* x string)) ; text @@ -435,21 +438,30 @@ (list* string (unique* tx integer)) (list* (unique* tx integer) string)))))) +(defparameter *checktype-markerr* "Found ~A, expected valid/unique mark") +(defparameter *checktype-markserr* "Found ~A, expected list of valid marks") + (defparameter +notemarks-type+ - '(with-unique* (sy si tt td tx) - (list-of* - (check* (type* +notemark-type+) "Found ~A, expected valid mark" t)))) + '(check* + (with-unique* (sy si tt td tx) + (list-of* + (check* (type* +notemark-type+) *checktype-markerr* t))) + *checktype-markserr* t)) (defparameter +markmarks-type+ - '(with-unique* (sy si tt td tx) - (list-of* - (check* (or* (type* +notemark-type+) - (cons (eql* :mark) (cons (or* (real 0) (list* real)) (and* list (type* +notemark-type+))))) - "Found ~A, expected valid mark" t)))) + '(check* + (with-unique* (sy si tt td tx) + (list-of* + (check* (or* (type* +notemark-type+) + (cons (eql* :mark) (cons (or* (real 0) (list* real)) (and* list (type* +notemark-type+))))) + *checktype-markerr* t))) + *checktype-markserr* t)) (defparameter +restmarks-type+ '(and* - (list-of* (check* (or* (satisfies is-restmarksym) (cons* (satisfies is-restmarksym) list)) "Found ~A, expected valid mark" t)) + (check* + (list-of* (check* (or* (satisfies is-restmarksym) (cons* (satisfies is-restmarksym) list)) *checktype-markerr* t)) + *checktype-markserr* t) (type* +notemarks-type+))) (defparameter +marks-rests+ Index: fomus/interface.lisp diff -u fomus/interface.lisp:1.1.1.1 fomus/interface.lisp:1.2 --- fomus/interface.lisp:1.1.1.1 Tue Jul 19 20:16:59 2005 +++ fomus/interface.lisp Sat Jul 23 11:23:14 2005 @@ -72,6 +72,10 @@ (let ((re (apply #'make-instance 'rest :partid partid args))) (push re *fomus-events*) t)) +(defun fomus-newmark (partid &rest args) + (let ((re (apply #'make-instance 'mark :partid partid args))) + (push re *fomus-events*) + t)) ;;(declaim (inline fomus-part)) (defun fomus-part (sym) @@ -81,9 +85,9 @@ (defun fomus-exec (&rest args) (unwind-protect (apply #'fomus - :global *fomus-global* - :parts (nreverse *fomus-parts*) - :events *fomus-events* + :global (append *global* *fomus-global*) + :parts (append *parts* (nreverse *fomus-parts*)) + :events (append *events* *fomus-events*) (append args *fomus-args*)) (fomus-init))) Index: fomus/main.lisp diff -u fomus/main.lisp:1.2 fomus/main.lisp:1.3 --- fomus/main.lisp:1.2 Thu Jul 21 17:38:43 2005 +++ fomus/main.lisp Sat Jul 23 11:23:14 2005 @@ -52,7 +52,7 @@ (when (and (numberp *verbose*) (>= *verbose* 1)) (out ";; Formatting music...")) (when *debug-filename* (save-debug)) (when (and (numberp *verbose*) (>= *verbose* 2)) (out "~&; Checking types...")) - (check-settings-types) + (check-setting-types) (find-cm) (check-settings) (multiple-value-bind (*timesigs* *keysigs* rm) (split-list *global* #'timesigp #'keysigp) @@ -151,7 +151,7 @@ (when (>= *verbose* 2) (out "~&; Chords...")) (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...")) + (when (>= *verbose* 2) (out "~&; Splits/ties/rests...")) (split pts) #+debug (fomus-proc-check pts 'ties) (clean-ties pts) #+debug (fomus-proc-check pts 'cleanties2) (when *auto-beams* Index: fomus/marks.lisp diff -u fomus/marks.lisp:1.2 fomus/marks.lisp:1.3 --- fomus/marks.lisp:1.2 Thu Jul 21 17:38:43 2005 +++ fomus/marks.lisp Sat Jul 23 11:23:14 2005 @@ -63,7 +63,7 @@ (addmark e (if a2 (list startsym n a2) (list startsym n))) ; fixed order now--level is mandatory 1st argument, modifier is optional (decf nu)) (error "Levels for marks ~A, ~A and ~A are out of order at offset ~A, part ~A" startsym contsym endsym (event-foff e) (part-name p))) - (error "Missing ending marks ~A or ~A for starting mark ~A at offset ~A, part ~A" contsym endsym startsym (event-foff e) (part-name p)))))) + (error "Missing ending mark ~A or ~A for starting mark ~A at offset ~A, part ~A" contsym endsym startsym (event-foff e) (part-name p)))))) finally (or (= nu 0) (error "Missing starting mark ~A in part ~A" startsym (part-name p)))) (print-dot)))) (defun expand-marks (pts) Index: fomus/misc.lisp diff -u fomus/misc.lisp:1.1.1.1 fomus/misc.lisp:1.2 --- fomus/misc.lisp:1.1.1.1 Tue Jul 19 20:16:56 2005 +++ fomus/misc.lisp Sat Jul 23 11:23:14 2005 @@ -301,7 +301,7 @@ ;; slightly more complicated type checking (defun check-type* (obj type &optional er un lt) (flet ((get-error (x) - (apply #'format nil (first x) + (apply #'format nil (typecase (first x) (symbol (symbol-value (first x))) (otherwise (first x))) (mapcar (lambda (z) (if (truep z) obj (cond ((functionp z) (funcall z obj)) @@ -341,7 +341,7 @@ (o (if th se obj))) (unless (find o (cdr x) :test #'equal) (push o (cdr x)) - (check-type* obj se er un lt)))) + (check-type* obj (or th se) er un lt)))) (let* (mapcar (lambda (x) (push (cons (first x) (second x)) lt)) fi) (check-type* obj se er un lt)) (error* (let ((x (get-error ty))) (if er (error er x) (error x)))) (with-error* (if (or (stringp (first fi)) (check-type* obj (first fi) er un lt)) Index: fomus/package.lisp diff -u fomus/package.lisp:1.2 fomus/package.lisp:1.3 --- fomus/package.lisp:1.2 Thu Jul 21 17:38:43 2005 +++ fomus/package.lisp Sat Jul 23 11:23:14 2005 @@ -8,10 +8,6 @@ (eval-when (:compile-toplevel) (declaim (optimize (safety 3) (debug 3)))) -;; debug feature flag -(eval-when (:compile-toplevel :load-toplevel :execute) - (pushnew :debug *features*)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; PACKAGE @@ -57,7 +53,7 @@ (use-package "DBG" "FM"))) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 1)) +(defparameter +version+ '(0 1 2)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005 David Psenicka, All Rights Reserved" Index: fomus/split.lisp diff -u fomus/split.lisp:1.1.1.1 fomus/split.lisp:1.2 --- fomus/split.lisp:1.1.1.1 Tue Jul 19 20:16:57 2005 +++ fomus/split.lisp Sat Jul 23 11:23:14 2005 @@ -233,7 +233,7 @@ (defparameter *dotted-note-level* t) ; can = (t or :all), :top or :sig for levels where dotted notes are allowed, nil = no dotted notes (defparameter *shortlongshort-notes-level* t) ; = (same as above) if special rhythmic patterns allowed (tied syncopations) -(defparameter *syncopated-notes-level* :top) ; b bah.. bah.. bah.. b +(defparameter *syncopated-notes-level* t) ; b bah.. bah.. bah.. b (defparameter *double-dotted-notes* t) ; = t if can use double dotted notes (defparameter *tuplet-dotted-rests* t) @@ -274,18 +274,18 @@ (make-sig :time (cons (* (rule-num rule) n) (rule-den rule)) :comp (rule-comp rule) :beat (rule-beat rule) :alt al :art ar :init in :irr (not ex) :comp (rule-comp rule)) (make-unit :div (if (rule-comp rule) 3 2) :tup nil :alt t :art t :init in :irr (not ex) :comp (rule-comp rule)))) - (snd (n tl tr) (if #|(> num (/ n))|# (if (rule-comp rule) (>= num (/ n)) (> num (/ n))) - (make-sig-nodiv :comp (rule-comp rule) :tlt tl :trt tr :comp (rule-comp rule)) - (make-unit-nodiv :tup nil :tlt tl :trt tr :comp (rule-comp rule))))) + (snd (n tl tr) (if (if (rule-comp rule) (>= num (/ n)) (> num (/ n))) #|(> num (/ n))|# + (make-sig-nodiv :comp (rule-comp rule) :tlt tl :trt tr :comp (rule-comp rule)) + (make-unit-nodiv :tup nil :tlt tl :trt tr :comp (rule-comp rule))))) (flet ((si (n wh al ar) ; n = division ratio, >1/4 or >3/8 comp. is designated with :sig, smaller durations become units (etypecase rule (initdiv (in n al ar nil)) - (sig (if #|(> num (/ n))|# (if (rule-comp rule) (>= num (/ n)) (> num (/ n))) - (make-sig :time (cons (* (rule-num rule) n) (rule-den rule)) :comp (rule-comp rule) :beat (rule-beat rule) - :alt (if (eq wh :l) (and (rule-alt rule) al) (and (rule-alt rule) (rule-art rule) al)) - :art (if (eq wh :r) (and (rule-art rule) ar) (and (rule-alt rule) (rule-art rule) ar)) - :irr (not ex) :comp (rule-comp rule)) - (make-unit :div 2 #|(if (rule-comp rule) 3 2)|# :tup nil :alt t :art t :irr (not ex) #|(or (rule-comp rule) (not ex))|# :comp (rule-comp rule))))))) + (sig (if (if (rule-comp rule) (>= num (/ n)) (> num (/ n))) #|(> num (/ n))|# + (make-sig :time (cons (* (rule-num rule) n) (rule-den rule)) :comp (rule-comp rule) :beat (rule-beat rule) + :alt (if (eq wh :l) (and (rule-alt rule) al) (and (rule-alt rule) (rule-art rule) al)) + :art (if (eq wh :r) (and (rule-art rule) ar) (and (rule-alt rule) (rule-art rule) ar)) + :irr (not ex) :comp (rule-comp rule)) + (make-unit :div 2 #|(if (rule-comp rule) 3 2)|# :tup nil :alt t :art t :irr (not ex) #|(or (rule-comp rule) (not ex))|# :comp (rule-comp rule))))))) (nconc (etypecase rule (initdiv (loop for ee in (force-list2 (rule-list rule)) @@ -304,7 +304,7 @@ (and (expof2 xx) (or (= num xx) (expof2 (- num xx))))) collect (in i la (or (null n) aa) ee))))))) (sig (loop - for nn in (or (lowmult num) (if (rule-comp rule) '(3) '(2))) + for nn in (or (lowmult (numerator num)) (if (rule-comp rule) '(3) '(2))) nconc (loop for j from 1 below nn for x = (/ j nn) ; x is the ratio @@ -324,13 +324,21 @@ (list (list 1/8 (si 1/8 :l t t) (snd 7/8 nil t)))))) (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 (al *syncopated-notes-level*) (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule) (>= num 3)) + (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)) (not (rule-comp rule))) - (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 (1- num) :initial-element (snd (/ num) nil nil)) - (list (snd (/ 1/2 num) nil t))))) + (cond ((integerp num) + (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 (1- num) :initial-element (snd (/ num) nil nil)) + (list (snd (/ 1/2 num) nil t))))) + ((= (denominator num) 2) + (nconc (list (nconc (list (loop for i from 1 below num collect (/ i num))) ; regular off beat syncopation + (make-list (- num 1/2) :initial-element (snd (/ num) nil nil)) + (list (snd (/ 1/2 num) nil t)))) + (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 (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule))) (loop with nu = (if (rule-comp rule) (* num 3/2) num) @@ -366,7 +374,7 @@ (when *double-dotted-notes* (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 + (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 (and tups (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule))) (let ((l (length (force-list (rule-tup rule))))) (when (< l mn) Index: fomus/util.lisp diff -u fomus/util.lisp:1.2 fomus/util.lisp:1.3 --- fomus/util.lisp:1.2 Thu Jul 21 17:38:43 2005 +++ fomus/util.lisp Sat Jul 23 11:23:14 2005 @@ -183,7 +183,7 @@ for x = (let ((bb (* nb d))) (or (lookup bb *default-meas-divs*) (lookup bb +default-meas-divs+))) - when x do (return (mapcar (lambda (y) (/ y d)) x)))))))) + when x do (return (loop for y in x collect (mapcar (lambda (z) (/ z d)) y))))))))) (defparameter *effective-grace-dur-mul* 1/2) ; multiplier for effective duration of grace notes--use this in any algorithm that needs a small durational value for grace notes @@ -475,7 +475,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; CHECK SETTINGS -(defun check-settings-types () +(defun check-setting-types () (loop for (sy ty er) in +settings+ do (let ((v (symbol-value (find-symbol (conc-strings "*" (symbol-name sy) "*") :fomus)))) (or (check-type* v ty) (error "Found ~A, expected ~A in setting ~A" v (or er ty) sy)))))

1 0

[fomus-cvs] CVS update: fomus/doc/fomus.html fomus/doc/fomus.xml fomus/doc/objects.xml fomus/doc/settings.xml
by dpsenicka＠common-lisp.net 21 Jul '05

21 Jul '05

Update of /project/fomus/cvsroot/fomus/doc In directory common-lisp.net:/tmp/cvs-serv23246/doc Modified Files: fomus.xml objects.xml settings.xml Added Files: fomus.html Log Message: Testing and bug fixes Date: Thu Jul 21 17:38:46 2005 Author: dpsenicka Index: fomus/doc/fomus.xml diff -u fomus/doc/fomus.xml:1.1.1.1 fomus/doc/fomus.xml:1.2 --- fomus/doc/fomus.xml:1.1.1.1 Tue Jul 19 20:17:05 2005 +++ fomus/doc/fomus.xml Thu Jul 21 17:38:46 2005 @@ -14,8 +14,8 @@ <bookinfo> <title>FOMUS Documentation</title> - <releaseinfo>Version 0.1.0</releaseinfo> - <date>7/19/2005</date> + <releaseinfo>Version 0.1.1</releaseinfo> + <date>7/21/2005</date> <author> <firstname>David</firstname> <surname>Psenicka</surname> @@ -23,7 +23,7 @@ </author> <legalnotice> <para>Copyright © 2005 David Psenicka, All Rights Reserved</para> - <para>See file "COPYING" for terms of use and distribution</para> + <para>See file "COPYING" for terms of use and distribution.</para> </legalnotice> </bookinfo> Index: fomus/doc/objects.xml diff -u fomus/doc/objects.xml:1.2 fomus/doc/objects.xml:1.3 --- fomus/doc/objects.xml:1.2 Wed Jul 20 06:50:01 2005 +++ fomus/doc/objects.xml Thu Jul 21 17:38:46 2005 @@ -673,7 +673,7 @@ If a number is used, 60 represents middle C, as in a MIDI file. Numbers are rounded depending on the whether semitones or quartertones are specified (see the - <varname><link linkend="auto.accs.fun">AUTO-ACCS-FUN</link></varname> setting). + <varname><link linkend="quartertones">QUARTERTONES</link></varname> setting). Symbols are assembled by concatenating a note letter name (<literal>A</literal> through <literal>G</literal>), a <literal>+</literal> or <literal>S</literal> for sharp or a <literal>-</literal> or <literal>F</literal> for flat, and an @@ -934,13 +934,6 @@ <classname><link linkend="class.rest">REST</link></classname> objects. </para> - <para> - A final important thing to note is that mark offsets aren't quantized. - - Since note and rest offsets may shift slightly, it might be helpful to alter mark offsets by some amount to insure they are distributed - as expected. - </para> - <para>Constructor: <function>(MAKE-MARK &key :ID <userinput>id</userinput> Index: fomus/doc/settings.xml diff -u fomus/doc/settings.xml:1.2 fomus/doc/settings.xml:1.3 --- fomus/doc/settings.xml:1.2 Wed Jul 20 06:50:01 2005 +++ fomus/doc/settings.xml Thu Jul 21 17:38:46 2005 @@ -169,6 +169,8 @@ <section> <title>Accidentals</title> <simplelist type="horiz" columns="3"> + <member><varname><link linkend="quartertones">:QUARTERTONES</link></varname></member> + <member><varname><link linkend="acc.throughout.meas">:ACC-THROUGHOUT-MEAS</link></varname></member> <member><varname><link linkend="acc.use.double">:ACC-USE-DOUBLE</link></varname></member> @@ -474,7 +476,7 @@ <para> Designates which function is to be used for determining note spellings. - Current possible values are <literal>:DEFAULT</literal>, <literal>:NOKEY1</literal> and <literal>:NOKEY-QTONES1</literal>. + Current possible values are <literal>:DEFAULT</literal> and <literal>:NOKEY1</literal>. <literal>:DEFAULT</literal> is equivalent to <literal>:NOKEY1</literal>. </para> @@ -628,8 +630,6 @@ Floating point numbers are treated with the <function>RATIONALIZE</function> function in this case (this isn't recommended). If offsets and durations of events aren't "notatable" then <application>FOMUS</application> will complain with an error. - - Note that mark objects aren't quantized (see class <classname><link linkend="class.mark">MARK</link></classname> for details). </para> </listitem> </varlistentry> @@ -1462,6 +1462,21 @@ grace notes so that they don't exceed the durations of the notes they precede. This only applies to grace notes that are automatically generated by the quantizing algorithm. + </para> + </listitem> + </varlistentry> + + <varlistentry> + <term><varname><anchor id="quartertones"/>:QUARTERTONES</varname></term> + <listitem> + <para> + If set to <literal>T</literal>, <application>FOMUS</application> rounds pitches to quartertone values + and uses quartertone notation in the score. + + This only works if the algorithm specified by the <varname><link linkend="auto.accs.fun">AUTO-ACCS-FUN</link></varname> setting + supports it. + + Currently, <literal>:NOKEY1</literal> supports quartertones. </para> </listitem> </varlistentry>

1 0

[fomus-cvs] CVS update: fomus/README fomus/TODO fomus/accidentals.lisp fomus/backend_ly.lisp fomus/classes.lisp fomus/data.lisp fomus/final.lisp fomus/load.lisp fomus/main.lisp fomus/marks.lisp fomus/package.lisp fomus/quantize.lisp fomus/util.lisp
by dpsenicka＠common-lisp.net 21 Jul '05

21 Jul '05

Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv23246 Modified Files: TODO accidentals.lisp backend_ly.lisp classes.lisp data.lisp final.lisp load.lisp main.lisp marks.lisp package.lisp quantize.lisp util.lisp Added Files: README Log Message: Testing and bug fixes Date: Thu Jul 21 17:38:43 2005 Author: dpsenicka Index: fomus/TODO diff -u fomus/TODO:1.1.1.1 fomus/TODO:1.2 --- fomus/TODO:1.1.1.1 Tue Jul 19 20:17:01 2005 +++ fomus/TODO Thu Jul 21 17:38:42 2005 @@ -15,6 +15,7 @@ MIDI backend Profile and optimize code for speed Reorganize code, update comments +Reorganize settings MIDI input interface Index: fomus/accidentals.lisp diff -u fomus/accidentals.lisp:1.1.1.1 fomus/accidentals.lisp:1.2 --- fomus/accidentals.lisp:1.1.1.1 Tue Jul 19 20:16:55 2005 +++ fomus/accidentals.lisp Thu Jul 21 17:38:42 2005 @@ -221,20 +221,21 @@ (setf (part-events e) (sort (nconc rs (case (auto-accs-fun) - (:nokey1 (acc-nokey evs (if *acc-use-double* '(-2 -1 0 1 2) '(-1 0 1)) - #'nokey-spell #'nokey-intscore (part-name e) #'identity)) - (:nokey-qtones1 (acc-nokey evs (if *acc-use-double* - '(-2 -1 0 1 2 (-1 . -1/2) (0 . -1/2) #|(1 . -1/2) (-1 . 1/2)|# (0 . 1/2) (1 . 1/2)) - '(-1 0 1 (-1 . -1/2) (0 . -1/2) #|(1 . -1/2) (-1 . 1/2)|# (0 . 1/2) (1 . 1/2))) - #'nokeyq-spell #'nokeyq-intscore (part-name e) - (lambda (x) (if (consp x) x (cons x 0))))) + (:nokey1 (if *quartertones* + (acc-nokey evs (if *acc-use-double* + '(-2 -1 0 1 2 (-1 . -1/2) (0 . -1/2) #|(1 . -1/2) (-1 . 1/2)|# (0 . 1/2) (1 . 1/2)) + '(-1 0 1 (-1 . -1/2) (0 . -1/2) #|(1 . -1/2) (-1 . 1/2)|# (0 . 1/2) (1 . 1/2))) + #'nokeyq-spell #'nokeyq-intscore (part-name e) + (lambda (x) (if (consp x) x (cons x 0)))) + (acc-nokey evs (if *acc-use-double* '(-2 -1 0 1 2) '(-1 0 1)) + #'nokey-spell #'nokey-intscore (part-name e) #'identity))) (otherwise (error "Unknown accidental assignment function ~A" *auto-accs-fun*)))) #'sort-offdur))))) (defmacro set-note-precision (&body forms) - `(let ((*note-precision* + `(let ((*note-precision* (case (auto-accs-fun) - (:nokey-qtones1 1/2) + (:nokey1 (if *quartertones* 1/2 1)) (otherwise 1)))) ,@forms)) @@ -299,7 +300,7 @@ #'sort-offdur))) (mapcar #'part-meas pa)))) (case (auto-accs-fun) ; m is list of measures (everything is sorted) - ((:nokey1 :nokey-qtones1) (acc-nokey-cautaccs ms)) + (:nokey1 (acc-nokey-cautaccs ms)) (otherwise (error "Unknown accidental assignment function ~A" *auto-accs-fun*)))))) (defun preproc-cautaccs (parts) @@ -349,7 +350,7 @@ (loop for m in (part-meas p) do (multiple-value-bind (evs rs) (split-list (meas-events m) #'notep) (case (auto-accs-fun) - ((:nokey1 :nokey-qtones1) (acc-nokey-postaccs evs)) + (:nokey1 (acc-nokey-postaccs evs)) (otherwise (error "Unknown accidental assignment function ~A" *auto-accs-fun*))) (setf (meas-events m) (sort (nconc rs evs) #'sort-offdur)))))) Index: fomus/backend_ly.lisp diff -u fomus/backend_ly.lisp:1.1.1.1 fomus/backend_ly.lisp:1.2 --- fomus/backend_ly.lisp:1.1.1.1 Tue Jul 19 20:17:00 2005 +++ fomus/backend_ly.lisp Thu Jul 21 17:38:42 2005 @@ -115,233 +115,232 @@ (defun save-lilypond (parts filename options view) (when (>= *verbose* 1) (out ";; Saving Lilypond file \"~A\"...~%" filename)) (with-open-file (f filename :direction :output :if-exists :supersede) - (let ((qu (= *note-precision* 1/2))) - (destructuring-bind (xxx &key filehead scorehead &allow-other-keys) options - (declare (ignore xxx)) - (format f "% ~A v~A.~A.~A~%~%" +title+ (first +version+) (second +version+) (third +version+)) - (loop for e in (if qu +lilypond-headq+ +lilypond-head+) do (format f "~A~%" e) finally (format f "~%")) ;; stuff at top - (when filehead (loop for e in filehead do (format f "~A~%" e) finally (format f "~%"))) ;; user header - (loop for e in +lilypond-defs+ do (format f "~A~%" e) finally (format f "~%")) ;; definitions - (let ((de 0) (nms nil)) - (flet ((lynote (wnum acc1 acc2 caut) - (if qu - (conc-strings - (svref +lilypond-num-note+ (mod wnum 12)) - (svref (svref +lilypond-num-accq+ (+ acc1 2)) (1+ (* acc2 2))) - (svref +lilypond-num-reg+ (1- (truncate wnum 12))) #|(when force "!")|# - (when caut "?")) - (conc-strings - (svref +lilypond-num-note+ (mod wnum 12)) - (svref +lilypond-num-acc+ (+ acc1 2)) - (svref +lilypond-num-reg+ (1- (truncate wnum 12))) #|(when force "!")|# - (when caut "?")))) - (lyname (p) - (incf de) - (conc-strings - (string-downcase - (conc-stringlist (loop for x across (part-name p) - when (alpha-char-p x) - collect (string x)))) - (string (code-char (+ 64 de))))) - (lyclef (c) - (ecase c (:treble "treble") (:alto "alto") (:tenor "tenor") (:bass "bass") (:percussion "percussion")))) - (loop - for p in parts - do (destructuring-bind (&key (lily-partname (lyname p)) - 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)))) - ""))) - (push lily-partname nms) - (format f "~A = {~%" lily-partname) - (when (part-name p) (format f " ~A~%" (format nil +lilypond-set-instrument+ (part-name p)))) - (when (part-abbrev p) (format f " ~A~%" (format nil +lilypond-set-instr+ (part-abbrev p)))) - (when (or (null *timesig-style*) (eq *timesig-style* :fraction)) - (if (> ns 1) - (loop for s from 1 to ns do - (format f " ~A~A~%" (lystaff s) +lilypond-set-timesig-style-frac+)) - (format f " ~A~%" +lilypond-set-timesig-style-frac+))) - (when (eq *tuplet-style* :ratio) (format f " ~A~%" +lilypond-set-tup-style-ratio+)) - (format f " \\autoBeamOff~%") - (if *acc-throughout-meas* - (format f " ~A~%" +lilypond-set-acc-style-default+) - (format f " ~A~%" +lilypond-set-acc-style-forget+)) + (destructuring-bind (xxx &key filehead scorehead &allow-other-keys) options + (declare (ignore xxx)) + (format f "% ~A v~A.~A.~A~%~%" +title+ (first +version+) (second +version+) (third +version+)) + (loop for e in (if *quartertones* +lilypond-headq+ +lilypond-head+) do (format f "~A~%" e) finally (format f "~%")) ;; stuff at top + (when filehead (loop for e in filehead do (format f "~A~%" e) finally (format f "~%"))) ;; user header + (loop for e in +lilypond-defs+ do (format f "~A~%" e) finally (format f "~%")) ;; definitions + (let ((de 0) (nms nil)) + (flet ((lynote (wnum acc1 acc2 caut) + (if *quartertones* + (conc-strings + (svref +lilypond-num-note+ (mod wnum 12)) + (svref (svref +lilypond-num-accq+ (+ acc1 2)) (1+ (* acc2 2))) + (svref +lilypond-num-reg+ (1- (truncate wnum 12))) #|(when force "!")|# + (when caut "?")) + (conc-strings + (svref +lilypond-num-note+ (mod wnum 12)) + (svref +lilypond-num-acc+ (+ acc1 2)) + (svref +lilypond-num-reg+ (1- (truncate wnum 12))) #|(when force "!")|# + (when caut "?")))) + (lyname (p) + (incf de) + (conc-strings + (string-downcase + (conc-stringlist (loop for x across (part-name p) + when (alpha-char-p x) + collect (string x)))) + (string (code-char (+ 64 de))))) + (lyclef (c) + (ecase c (:treble "treble") (:alto "alto") (:tenor "tenor") (:bass "bass") (:percussion "percussion")))) + (loop + for p in parts + do (destructuring-bind (&key (lily-partname (lyname p)) + 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)))) + ""))) + (push lily-partname nms) + (format f "~A = {~%" lily-partname) + (when (part-name p) (format f " ~A~%" (format nil +lilypond-set-instrument+ (part-name p)))) + (when (part-abbrev p) (format f " ~A~%" (format nil +lilypond-set-instr+ (part-abbrev p)))) + (when (or (null *timesig-style*) (eq *timesig-style* :fraction)) (if (> ns 1) - (loop for (xxx cl s) in (sort (getprops p :clef) #'< :key #'third) do - (format f " ~A\\clef ~A~%" (lystaff s) (lyclef cl))) - (format f " \\clef ~A~%" (lyclef (second (getprop p :clef))))) - (loop for e in parthead do (format f " ~A~%" e)) - (format f "~%") - (loop - for m in (part-meas p) and mn from 1 - for ts = (meas-timesig m) do - (when (getprop m :startsig) (format f " \\time ~A/~A~%" (timesig-num ts) (timesig-den ts))) - (multiple-value-bind (s1 s2 s3) - (if (list>1p (meas-events m)) - (values " << { " "} \\\\~% { " "} >> ~A| % ~A~%") - (values " " nil "~A| % ~A~%")) - (format f s1) - (loop for (ee een) on (meas-events m) ; ee = list of events - do (loop - for (pre e nxe) on (cons nil ee) while e - for fm = (getmark e :measrest) - for cl = (let ((c (getmark e :clef))) - (if (and c (null (fourth c))) (format nil "\\clef ~A " (lyclef (second c))) - "")) - and st = (let ((m (getmark e '(:staff :global)))) - (if (and m (null (fourth m))) (lystaff (third m)) "")) - and vo = (if (list>1p (meas-events m)) - (let ((m (getmark e '(:voice :ord1324)))) - (if m - (case (third m) - (1 "\\voiceOne ") (2 "\\voiceTwo ") (3 "\\voiceThree ") (4 "\\voiceFour ") (otherwise "\\oneVoice ")) - "")) - "") - and gr1 = (let ((g (event-grace e))) - (if g - (let ((g1 (getmark e :startgrace))) - (cond ((and g1 (getmark e :endgrace)) (if (< g 0) "\\acciaccatura " "\\appoggiatura ")) - (g1 (if (< g 0) "\\acciaccatura {" "\\appoggiatura {")))) - "")) - and gr2 = (if (and (event-grace e) (getmark e :endgrace) (not (getmark e :startgrace))) "}" "") - and ot1 = (cond ((or (getmark e :start8up-) (getmark e :8up)) "\\octUp ") - ((or (getmark e :start8down-) (getmark e :8down)) "\\octDown ")) - and ot2 = (cond ((or (getmark e :end8up-) (getmark e :8up)) " \\octReset") - ((or (getmark e :end8down-) (getmark e :8down)) " \\octReset")) - and ba = (if (notep e) - (if (chordp e) - (format nil "<~A>" (conc-stringlist - (loop - for (n nn) on (event-notes* e) - and w in (event-writtennotes e) - and a in (event-accs e) - and a2 in (event-addaccs e) - collect (lynote w a a2 (getmark e (list :cautacc n)) #|(getmark e (list :showacc n))|#) - when nn collect " "))) - (lynote (event-writtennote e) (event-acc e) (event-addacc e) - (getmark e (list :cautacc (event-note* e))) #|(getmark e (list :showacc n))|#)) - (if fm (if (event-inv e) "\\skip " "R") (if (event-inv e) "s" "r"))) - and du = (if fm (format nil "1*~A/~A" (timesig-num ts) (timesig-den ts)) - (multiple-value-bind (wd ds) (event-writtendur* e ts) - (let ((du (case wd - (2 "\\breve") - (4 "\\longa") - (otherwise (/ wd))))) - (ecase ds - (0 (format nil "~A" du)) - (1 (format nil "~A." du)) - (2 (format nil "~A.." du)))))) - and tu1 = (let ((uu (sort (getmarks e :starttup) #'< :key #'second))) - (conc-stringlist - (loop for u in uu for r = (third u) - collect (format nil "\\times ~A/~A {" (cdr r) (car r))))) ; tup is durmult - and tu2 = (let ((uu (getmarks e :endtup))) - (conc-stringlist - (loop repeat (length uu) collect "}"))) - and ti = (if (and (notep e) (or-list (force-list (event-tiert e)))) "\~" "") - and be1 = (if (and (notep e) (= (event-beamlt e) 0) (> (event-beamrt e) 0)) "[" "") - and be2 = (if (and (notep e) (> (event-beamlt e) 0) (= (event-beamrt e) 0)) "]" "") - and bnu = (let ((l (and (notep e) (notep pre) (> (min (event-nbeams e ts) (event-nbeams pre ts)) (event-beamlt e) 0))) - (r (and (notep e) (notep nxe) (> (min (event-nbeams e ts) (event-nbeams nxe ts)) (event-beamrt e) 0)))) - (cond ((and l r) (format nil "\\beamLR #~A #~A " (event-beamlt e) (event-beamrt e))) - (l (format nil "\\beamL #~A " (event-beamlt e))) - (r (format nil "\\beamR #~A " (event-beamrt e))) - (t ""))) - and ar = (conc-stringlist - (loop for i in - (sort (loop for a in +lilypond-marks+ nconc (getmarks e (car a))) - (lambda (x y) (let ((x2 (second x)) (y2 (second y))) - (cond ((and (numberp x2) (numberp y2)) (< x2 y2)) - (x2 t))))) - collect (lookup i +lilypond-marks+))) + (loop for s from 1 to ns do + (format f " ~A~A~%" (lystaff s) +lilypond-set-timesig-style-frac+)) + (format f " ~A~%" +lilypond-set-timesig-style-frac+))) + (when (eq *tuplet-style* :ratio) (format f " ~A~%" +lilypond-set-tup-style-ratio+)) + (format f " \\autoBeamOff~%") + (if *acc-throughout-meas* + (format f " ~A~%" +lilypond-set-acc-style-default+) + (format f " ~A~%" +lilypond-set-acc-style-forget+)) + (if (> ns 1) + (loop for (xxx cl s) in (sort (getprops p :clef) #'< :key #'third) do + (format f " ~A\\clef ~A~%" (lystaff s) (lyclef cl))) + (format f " \\clef ~A~%" (lyclef (second (getprop p :clef))))) + (loop for e in parthead do (format f " ~A~%" e)) + (format f "~%") + (loop + for m in (part-meas p) and mn from 1 + for ts = (meas-timesig m) do + (when (getprop m :startsig) (format f " \\time ~A/~A~%" (timesig-num ts) (timesig-den ts))) + (multiple-value-bind (s1 s2 s3) + (if (list>1p (meas-events m)) + (values " << { " "} \\\\~% { " "} >> ~A| % ~A~%") + (values " " nil "~A| % ~A~%")) + (format f s1) + (loop for (ee een) on (meas-events m) ; ee = list of events + do (loop + for (pre e nxe) on (cons nil ee) while e + for fm = (getmark e :measrest) + for cl = (let ((c (getmark e :clef))) + (if (and c (null (fourth c))) (format nil "\\clef ~A " (lyclef (second c))) + "")) + and st = (let ((m (getmark e '(:staff :global)))) + (if (and m (null (fourth m))) (lystaff (third m)) "")) + and vo = (if (list>1p (meas-events m)) + (let ((m (getmark e '(:voice :ord1324)))) + (if m + (case (third m) + (1 "\\voiceOne ") (2 "\\voiceTwo ") (3 "\\voiceThree ") (4 "\\voiceFour ") (otherwise "\\oneVoice ")) + "")) + "") + and gr1 = (let ((g (event-grace e))) + (if g + (let ((g1 (getmark e :startgrace))) + (cond ((and g1 (getmark e :endgrace)) (if (< g 0) "\\acciaccatura " "\\appoggiatura ")) + (g1 (if (< g 0) "\\acciaccatura {" "\\appoggiatura {")))) + "")) + and gr2 = (if (and (event-grace e) (getmark e :endgrace) (not (getmark e :startgrace))) "}" "") + and ot1 = (cond ((or (getmark e :start8up-) (getmark e :8up)) "\\octUp ") + ((or (getmark e :start8down-) (getmark e :8down)) "\\octDown ")) + and ot2 = (cond ((or (getmark e :end8up-) (getmark e :8up)) " \\octReset") + ((or (getmark e :end8down-) (getmark e :8down)) " \\octReset")) + and ba = (if (notep e) + (if (chordp e) + (format nil "<~A>" (conc-stringlist + (loop + for (n nn) on (event-notes* e) + and w in (event-writtennotes e) + and a in (event-accs e) + and a2 in (event-addaccs e) + collect (lynote w a a2 (getmark e (list :cautacc n)) #|(getmark e (list :showacc n))|#) + when nn collect " "))) + (lynote (event-writtennote e) (event-acc e) (event-addacc e) + (getmark e (list :cautacc (event-note* e))) #|(getmark e (list :showacc n))|#)) + (if fm (if (event-inv e) "\\skip " "R") (if (event-inv e) "s" "r"))) + and du = (if fm (format nil "1*~A/~A" (timesig-num ts) (timesig-den ts)) + (multiple-value-bind (wd ds) (event-writtendur* e ts) + (let ((du (case wd + (2 "\\breve") + (4 "\\longa") + (otherwise (/ wd))))) + (ecase ds + (0 (format nil "~A" du)) + (1 (format nil "~A." du)) + (2 (format nil "~A.." du)))))) + and tu1 = (let ((uu (sort (getmarks e :starttup) #'< :key #'second))) + (conc-stringlist + (loop for u in uu for r = (third u) + collect (format nil "\\times ~A/~A {" (cdr r) (car r))))) ; tup is durmult + and tu2 = (let ((uu (getmarks e :endtup))) + (conc-stringlist + (loop repeat (length uu) collect "}"))) + and ti = (if (and (notep e) (or-list (force-list (event-tiert e)))) "\~" "") + and be1 = (if (and (notep e) (= (event-beamlt e) 0) (> (event-beamrt e) 0)) "[" "") + and be2 = (if (and (notep e) (> (event-beamlt e) 0) (= (event-beamrt e) 0)) "]" "") + and bnu = (let ((l (and (notep e) (notep pre) (> (min (event-nbeams e ts) (event-nbeams pre ts)) (event-beamlt e) 0))) + (r (and (notep e) (notep nxe) (> (min (event-nbeams e ts) (event-nbeams nxe ts)) (event-beamrt e) 0)))) + (cond ((and l r) (format nil "\\beamLR #~A #~A " (event-beamlt e) (event-beamrt e))) + (l (format nil "\\beamL #~A " (event-beamlt e))) + (r (format nil "\\beamR #~A " (event-beamrt e))) + (t ""))) + and ar = (conc-stringlist + (loop for i in + (sort (loop for a in +lilypond-marks+ nconc (getmarks e (car a))) + (lambda (x y) (let ((x2 (second x)) (y2 (second y))) + (cond ((and (numberp x2) (numberp y2)) (< x2 y2)) + (x2 t))))) + collect (lookup i +lilypond-marks+))) ;and txt = ... - and we0 = (cond ((and (getmark e :startwedge<) (getmark e :endwedge-)) "\\< ") - ((and (getmark e :startwedge>) (getmark e :endwedge-)) "\\> ") - (t "")) - and we1 = (cond ((getmark e :endwedge-) "\\!") - ((getmark e :startwedge<) "\\<") - ((getmark e :startwedge>) "\\>") - (t "")) - and we2 = (cond ((and (getmark e :startwedge<) (not (getmark e :endwedge-))) "\\<") - ((and (getmark e :startwedge>) (not (getmark e :endwedge-))) "\\>") - (t "")) - and dyn = (conc-stringlist - (loop for i in - (sort (loop for a in +lilypond-dyns+ nconc (getmarks e (car a))) - (lambda (x y) (let ((x2 (second x)) (y2 (second y))) - (cond ((and (numberp x2) (numberp y2)) (< x2 y2)) - (x2 t))))) - collect (lookup i +lilypond-marks+))) - and s1 = (conc-stringlist - (loop - for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :startslur-)) - collect "(")) - and s2 = (conc-stringlist - (loop - for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :endslur-)) - collect ")")) - and sl1 = (conc-stringlist - (loop - for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :startslur-)) - collect "(")) - and sl2 = (conc-stringlist - (loop - for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :endslur-)) - collect ")")) - do (format f "~A " (conc-strings st vo cl ot1 tu1 gr1 we0 bnu ba du sl1 s1 s2 sl2 be1 be2 ti ar we1 dyn #|txt|# we2 gr2 tu2 ot2))) - when een do (format f s2)) - (format f s3 - (let ((x (getprop m :barline))) - (if x (format nil "\\bar \"~A\" " (lookup (second x) +lilypond-barlines+)) "")) - mn))) - (format f "}~%~%") - (if (> ns 1) - (format f "~A = {~% ~A~%}~%~%" - (conc-strings lily-partname "S") - (conc-stringlist - (loop with nu = 0 - for n = nil then (timesig-num (meas-timesig m)) - and d = nil then (timesig-den (meas-timesig m)) - for m in (part-meas p) - when (and (getprop m :startsig) (> nu 0)) - collect (format nil "\\skip 1*~A/~A*~A " n d nu) into re and do (setf nu 0) - do (incf nu) - finally (return (nconc re (list (format nil "\\skip 1*~A/~A*~A" n d nu)))))))))))) - (format f "\\score {~%") ;; score block - (loop for e in scorehead do (format f " ~A~%" e)) - (when (or *title* *subtitle* *composer*) - (format f " \\header {~%") - (when *title* (format f " title = \"~A\"~%" *title*)) - (when *subtitle* (format f " subtitle = \"~A\"~%" *subtitle*)) - (when *composer* (format f " composer = \"~A\"~%" *composer*)) - (format f " }~%")) - (loop - with in = 2 - for p in parts and nm in (nreverse nms) do - (loop - 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"))) - (:grandstaff (format f "~A\\new PianoStaff <<~%" (make-string in :initial-element #\space)))) - (format f "~A<<~%" (make-string in :initial-element #\space))) - (incf in 2)) - (let ((ns (instr-staves (part-instr p)))) - (if (<= ns 1) - (format f "~A\\new Staff \\~A~%" (make-string in :initial-element #\space) nm) - (progn - (loop for s from 1 to ns do (format f "~A\\context Staff = ~A \\~A~%" - (make-string in :initial-element #\space) - (code-char (+ 64 s)) - (conc-strings nm "S"))) - (format f "~A\\context Staff = A \\new Voice \\~A~%" (make-string in :initial-element #\space) nm)))) - (loop - for xxx in (getprops p :endgroup) - do (decf in 2) (format f "~A>>~%" (make-string in :initial-element #\space)))) - (format f "}~%")))))) + and we0 = (cond ((and (getmark e :startwedge<) (getmark e :endwedge-)) "\\< ") + ((and (getmark e :startwedge>) (getmark e :endwedge-)) "\\> ") + (t "")) + and we1 = (cond ((getmark e :endwedge-) "\\!") + ((getmark e :startwedge<) "\\<") + ((getmark e :startwedge>) "\\>") + (t "")) + and we2 = (cond ((and (getmark e :startwedge<) (not (getmark e :endwedge-))) "\\<") + ((and (getmark e :startwedge>) (not (getmark e :endwedge-))) "\\>") + (t "")) + and dyn = (conc-stringlist + (loop for i in + (sort (loop for a in +lilypond-dyns+ nconc (getmarks e (car a))) + (lambda (x y) (let ((x2 (second x)) (y2 (second y))) + (cond ((and (numberp x2) (numberp y2)) (< x2 y2)) + (x2 t))))) + collect (lookup i +lilypond-marks+))) + and s1 = (conc-stringlist + (loop + for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :startslur-)) + collect "(")) + and s2 = (conc-stringlist + (loop + for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :endslur-)) + collect ")")) + and sl1 = (conc-stringlist + (loop + for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :startslur-)) + collect "(")) + and sl2 = (conc-stringlist + (loop + for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :endslur-)) + collect ")")) + do (format f "~A " (conc-strings st vo cl ot1 tu1 gr1 we0 bnu ba du sl1 s1 s2 sl2 be1 be2 ti ar we1 dyn #|txt|# we2 gr2 tu2 ot2))) + when een do (format f s2)) + (format f s3 + (let ((x (getprop m :barline))) + (if x (format nil "\\bar \"~A\" " (lookup (second x) +lilypond-barlines+)) "")) + mn))) + (format f "}~%~%") + (if (> ns 1) + (format f "~A = {~% ~A~%}~%~%" + (conc-strings lily-partname "S") + (conc-stringlist + (loop with nu = 0 + for n = nil then (timesig-num (meas-timesig m)) + and d = nil then (timesig-den (meas-timesig m)) + for m in (part-meas p) + when (and (getprop m :startsig) (> nu 0)) + collect (format nil "\\skip 1*~A/~A*~A " n d nu) into re and do (setf nu 0) + do (incf nu) + finally (return (nconc re (list (format nil "\\skip 1*~A/~A*~A" n d nu)))))))))))) + (format f "\\score {~%") ;; score block + (loop for e in scorehead do (format f " ~A~%" e)) + (when (or *title* *subtitle* *composer*) + (format f " \\header {~%") + (when *title* (format f " title = \"~A\"~%" *title*)) + (when *subtitle* (format f " subtitle = \"~A\"~%" *subtitle*)) + (when *composer* (format f " composer = \"~A\"~%" *composer*)) + (format f " }~%")) + (loop + with in = 2 + for p in parts and nm in (nreverse nms) do + (loop + 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"))) + (:grandstaff (format f "~A\\new PianoStaff <<~%" (make-string in :initial-element #\space)))) + (format f "~A<<~%" (make-string in :initial-element #\space))) + (incf in 2)) + (let ((ns (instr-staves (part-instr p)))) + (if (<= ns 1) + (format f "~A\\new Staff \\~A~%" (make-string in :initial-element #\space) nm) + (progn + (loop for s from 1 to ns do (format f "~A\\context Staff = ~A \\~A~%" + (make-string in :initial-element #\space) + (code-char (+ 64 s)) + (conc-strings nm "S"))) + (format f "~A\\context Staff = A \\new Voice \\~A~%" (make-string in :initial-element #\space) nm)))) + (loop + for xxx in (getprops p :endgroup) + do (decf in 2) (format f "~A>>~%" (make-string in :initial-element #\space)))) + (format f "}~%"))))) (when view (view-lilypond filename options))) Index: fomus/classes.lisp diff -u fomus/classes.lisp:1.1.1.1 fomus/classes.lisp:1.2 --- fomus/classes.lisp:1.1.1.1 Tue Jul 19 20:16:58 2005 +++ fomus/classes.lisp Thu Jul 21 17:38:42 2005 @@ -287,7 +287,7 @@ (defparameter +timesig-repl-type+ '(class* timesig-repl - (time (check* (and* (list-of* (integer 1)) (length* = 2)) "Found ~A, expected list ((INTEGER 1) (INTEGER 1)) in TIME slot" t)) + (time (check* (and* (list* (integer 1) (integer 1))) "Found ~A, expected list ((INTEGER 1) (INTEGER 1)) in TIME slot" t)) (beat (check* (or null (rational (0))) "Found ~A, expected (RATIONAL (0)) in BEAT slot" t)) (div (check* (or* null (list-of* (rational (0))) (list-of-unique* (list-of* (rational (0))))) "Found ~A, expected list of (RATIONAL (0)) or ((RATIONAL (0)) ...) in DIV slot" t)) (comp (check* boolean) "Found ~A, expected BOOLEAN in COMP slot" t) @@ -344,10 +344,10 @@ (class* part (name (check* (or null string) "Found ~A, expected STRING in NAME slot" t)) (abbrev (check* (or null string) "Found ~A, expected STRING in ABBREV slot" t)) - (opts (check* key-arg-pairs* "Found ~A, expected KEYWORD/ARGUMENT PAIRS in OPTS slot" t)) + (opts (check* key-arg-pairs* "Found ~A, expected KEYWORD/ARGUMENT-PAIRS in OPTS slot" t)) (events (check* (or* null (list-of* (check* (or note rest mark timesig) "Found ~A, expected NOTE, REST or TIMESIG in list in EVENTS slot" t))) "Expected list of NOTE, REST or TIMESIG in EVENTS slot")) - (instr (check* (or symbol instr (cons symbol (key-arg-pairs* ,@+instr-keys+))) "Found ~A, expected SYMBOL, INSTR or (SYMBOL KEYWORD/ARGUMENT PAIRS) in INSTR slot" t)) + (instr (check* (or* symbol instr (cons* symbol (key-arg-pairs* ,@+instr-keys+))) "Found ~A, expected SYMBOL, INSTR or (SYMBOL KEYWORD/ARGUMENT-PAIRS...) in INSTR slot" t)) (partid (check* (or symbol real) "Found ~A, expected SYMBOL or REAL in PARTID slot" t)))) (with-error* (part "~~A, part ~A" (function part-name)) (class* part Index: fomus/data.lisp diff -u fomus/data.lisp:1.1.1.1 fomus/data.lisp:1.2 --- fomus/data.lisp:1.1.1.1 Tue Jul 19 20:16:57 2005 +++ fomus/data.lisp Thu Jul 21 17:38:42 2005 @@ -23,8 +23,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; QUANTIZING -(declaim (special *note-precision*)) - ;; nested tuplets indicated by a list (defparameter *max-tuplet* 7) @@ -33,6 +31,10 @@ (defparameter *min-tuplet-dur* 1/2) ; fraction of beat smallest tuplets should span at minimum (1/2 = half a beat, etc.)--can be nil (defparameter *max-tuplet-dur* 4) +;; pitch quantizing +(declaim (special *note-precision*)) +(defparameter *quartertones* nil) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; CONVERSION @@ -283,7 +285,7 @@ (:use-cm boolean) (:cm-scale t) (:loadxmls-fun (or function string symbol)) (:backend (or* (cons* symbol key-arg-pairs*) (list-of* (cons* symbol key-arg-pairs*))) - "(SYMBOL KEYWORD/ARGUMENTS PAIRS ...) or list of (SYMBOL KEYWORD/ARGUMENTS PAIRS ...)") + "(SYMBOL KEYWORD/ARGUMENTS-PAIRS...) or list of (SYMBOL KEYWORD/ARGUMENTS-PAIRS...)") (:base-filename string) (:global (or* null (list-of* (type* +timesig-type+))) "list of TIMESIG objects") @@ -304,7 +306,8 @@ (:default-grace-dur (rational (0))) (:default-grace-num integer) (:effective-grace-dur-mul (rational (0))) (:min-auto-timesig-dur (rational (0))) (:default-timesig (type* +timesig-repl-type+) "TIMESIG object") - + + (:quartertones boolean) (:auto-accidentals boolean) (:auto-cautionary-accs boolean) (:auto-staff/clef-changes boolean) (:auto-ottavas boolean) (:auto-grace-slurs boolean) (:auto-voicing boolean) (:auto-beams boolean) (:auto-quantize boolean) (:auto-multivoice-rests boolean) (:auto-multivoice-notes boolean) Index: fomus/final.lisp diff -u fomus/final.lisp:1.1.1.1 fomus/final.lisp:1.2 --- fomus/final.lisp:1.1.1.1 Tue Jul 19 20:16:59 2005 +++ fomus/final.lisp Thu Jul 21 17:38:43 2005 @@ -24,7 +24,7 @@ for x = (read f nil 'eof) until (eq x 'eof) for y = (read f nil 'eof) - when (eq y 'eof) do (error "KEYWORD/ARGUMENT PAIRS expected in initialization file") + when (eq y 'eof) do (error "KEYWORD/ARGUMENT-PAIRS expected in initialization file") do (setf nt0 (find-symbol (conc-strings "*" (symbol-name x) "*") :fomus)) if nt0 collect (find-symbol (conc-strings "*" (symbol-name x) "*") :fomus) into nt and collect y into nt else do (format t ";; WARNING: Unknown setting ~A~%" x) @@ -43,10 +43,10 @@ ;; print load greeting (eval-when (:load-toplevel :execute) - (when (>= *verbose* 1) (format t ";; ~A v~A.~A.~A~%;; ~A~%;; ~A~%;; ~A~%~%" + (when (>= *verbose* 1) (format t ";; ~A v~A.~A.~A~%~A~%" +title+ (first +version+) (second +version+) (third +version+) - +subtitle+ +copyright+ +termscond+))) + (conc-stringlist (loop for e in +banner+ collect (format nil ";; ~A~%" e)))))) (eval-when (:load-toplevel :execute) (load-initfile)) Index: fomus/load.lisp diff -u fomus/load.lisp:1.1.1.1 fomus/load.lisp:1.2 --- fomus/load.lisp:1.1.1.1 Tue Jul 19 20:17:01 2005 +++ fomus/load.lisp Thu Jul 21 17:38:43 2005 @@ -1,11 +1,11 @@ ;; -*-lisp-*- ;; Load file for FOMUS -(with-open-file (f (merge-pathnames "fomus.asd" *load-pathname*) :direction :input) - (destructuring-bind (xxx1 xxx2 &key components &allow-other-keys) (read f) - (declare (ignore xxx1 xxx2)) - (loop for (xxx na) in components - for cl = (merge-pathnames na *load-pathname*) - for cn = (compile-file-pathname cl) - when (>= (file-write-date cl) (file-write-date cn)) do (compile-file cl) - do (load cn)))) \ No newline at end of file +(loop for na in + '("package" "misc" "deps" "data" "classes" "util" "accidentals" "beams" "marks" "other" "ottavas" "parts" "postproc" "split" "staves" "voices" "quantize" "backend_ly" + "backends" "main" "interface" "final") + for cl = (merge-pathnames na *load-pathname*) + for cn = (compile-file-pathname cl) + for wd = (file-write-date cn) + when (or (null wd) (>= (file-write-date cl) (file-write-date cn))) do (compile-file cl) + do (load cn)) \ No newline at end of file Index: fomus/main.lisp diff -u fomus/main.lisp:1.1.1.1 fomus/main.lisp:1.2 --- fomus/main.lisp:1.1.1.1 Tue Jul 19 20:16:55 2005 +++ fomus/main.lisp Thu Jul 21 17:38:43 2005 @@ -34,7 +34,9 @@ (defun save-debug () (when (>= *verbose* 2) (out "~&; Saving debug file \"~A\"..." *debug-filename*)) (with-open-file (f *debug-filename* :direction :output :if-exists :supersede) - (format f ";; -*-lisp-*-~%;; ~A v~A.~A.~A~%~%(FOMUS~%" +title+ (first +version+) (second +version+) (third +version+)) + (format f ";; -*-lisp-*-~%;; ~A v~A.~A.~A~%;; ~A ~A~%~%(FOMUS~%" + +title+ (first +version+) (second +version+) (third +version+) + (lisp-implementation-type) (lisp-implementation-version)) (mapc (lambda (s) (format f " ~S ~S~&" (first s) (let ((x (symbol-value (find-symbol (conc-strings "*" (symbol-name (first s)) "*") :fomus)))) @@ -183,6 +185,6 @@ (let ((r (fomus-proc))) (loop for x in (or (force-list2 *backend*) '((:data))) do (destructuring-bind (ba &key filename view &allow-other-keys) x - (set-note-precision (backend ba (or filename (change-filename *base-filename* :ext (lookup ba +backendexts+))) r x view))))) + (backend ba (or filename (change-filename *base-filename* :ext (lookup ba +backendexts+))) r x view)))) t) Index: fomus/marks.lisp diff -u fomus/marks.lisp:1.1.1.1 fomus/marks.lisp:1.2 --- fomus/marks.lisp:1.1.1.1 Tue Jul 19 20:16:59 2005 +++ fomus/marks.lisp Thu Jul 21 17:38:43 2005 @@ -99,7 +99,7 @@ for k = (pop mks) while k do (loop with fo = (listp (event-off k)) ; fuzzy offset? (next available note forwards or backwards) with nu = (if fo (first (event-off k)) (event-off k)) - with o = (abs nu) and di = (>= nu 0) ; offset and direction + with o0 = (abs nu) and di = (>= nu 0) ; offset and direction for m in (event-marks k) do (loop with fl = (force-list m) with sy = (first fl) @@ -133,15 +133,21 @@ collect e) (if (null vo) l (remove-if-not (lambda (e) (find (event-voice* e) vo)) l))))) (if re r (remove-if #'restp r))))) - (if di - (if fo - (loop for e in (rm fo) until (> (event-off e) o) finally (return e)) - (loop for (e1 e2) on (cons nil (rm fo)) until (or (null e2) (> (event-off e2) o)) - finally (return (or e1 e2)))) - (if fo - (loop for e in (rm ba) until (< (event-endoff e) o) finally (return e)) - (loop for (e1 e2) on (cons nil (rm ba)) until (or (null e2) (< (event-endoff e2) o)) - finally (return (or e1 e2)))))))) + (let ((o (let ((q (getprop p :quant))) ; fix quantize error + (if q (let ((x (find-if (lambda (x) (and (<= (car x) o0) (>= (cdr x) o0))) (rest q)))) + (if x (cdr x) o0)) + o0)))) + (if di + (if fo + (loop for e in (rm fo) until (> (event-off e) o) finally (return e)) + (loop for (e1 e2) on (cons nil (rm fo)) until (or (null e2) (> (event-off e2) o)) + finally (return (or e1 e2)))) + (if fo + (loop for e in (rm ba) until (< (event-endoff e) o) finally (return e)) + (loop for (e1 e2) on (cons nil (rm ba)) until (or (null e2) (< (event-endoff e2) o)) + finally (return (or e1 e2))))))))) (if (eq sy :mark) (push (copy-event k :off (second fl) :voice (event-voice* ev) :marks (list (cddr fl))) mks) - (addmark ev m))))) (print-dot))) \ No newline at end of file + (addmark ev m))))) + (print-dot) + finally (mapc (lambda (p) (rmprop p :quant)) pts))) \ No newline at end of file Index: fomus/package.lisp diff -u fomus/package.lisp:1.1.1.1 fomus/package.lisp:1.2 --- fomus/package.lisp:1.1.1.1 Tue Jul 19 20:16:55 2005 +++ fomus/package.lisp Thu Jul 21 17:38:43 2005 @@ -20,6 +20,7 @@ (:use "COMMON-LISP" #|"MISCFUNS"|#) (:export "FOMUS" "LOAD-INITFILE" ; interface functions "FOMUS-INIT" "FOMUS-NEWTIMESIG" "FOMUS-NEWPART" "FOMUS-NEWMARK" "FOMUS-NEWNOTE" "FOMUS-NEWREST" "FOMUS-EXEC" "FOMUS-PART" + "LIST-FOMUS-SETTINGS" ; make/copy functions "MAKE-TIMESIG" "MAKE-TIMESIG-REPL" "MAKE-PART" "MARK-MARK" "MAKE-NOTE" "MAKE-REST" "MAKE-INSTR" "MAKE-PERC" "COPY-INSTR" "COPY-PERC" "MAKE-MEAS" "COPY-TIMESIG" "COPY-TIMESIG-REPL" "COPY-EVENT" "COPY-PART" "COPY-MEAS" @@ -56,10 +57,11 @@ (use-package "DBG" "FM"))) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 0)) -(defparameter +subtitle+ "Lisp music notation formatter") -(defparameter +copyright+ "Copyright (c) 2005 David Psenicka, All Rights Reserved") -(defparameter +termscond+ "See file \"COPYING\" for terms of use and distribution") +(defparameter +version+ '(0 1 1)) +(defparameter +banner+ + `("Lisp music notation formatter" + "Copyright (c) 2005 David Psenicka, All Rights Reserved" + "See file \"COPYING\" for terms of use and distribution.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; GLOBAL Index: fomus/quantize.lisp diff -u fomus/quantize.lisp:1.1.1.1 fomus/quantize.lisp:1.2 --- fomus/quantize.lisp:1.1.1.1 Tue Jul 19 20:17:00 2005 +++ fomus/quantize.lisp Thu Jul 21 17:38:43 2005 @@ -97,16 +97,20 @@ #'<))) (loop with mg = (or (max-list (loop for e in (part-events p) when (event-grace e) collect (event-grace e))) (1- *default-grace-num*)) + and ad for e in (part-events p) do (let ((o (event-off e))) (loop while (and (list>1p qs) (< (second qs) o)) do (pop qs)) (let ((e1 (loop-return-firstmin (diff x o) for x in qs))) (if (event-grace e) - (setf (event-off e) e1 - (event-dur* e) (let ((bd (/ (beat-division (loop for s in ph until (<= (timesig-off s) e1) finally (return s)))))) - (let ((x (roundto (event-gracedur e) bd))) - (when (<= x 0) bd x)))) + (progn + (push (cons (event-off e) e1) ad) + (setf (event-off e) e1 + (event-dur* e) (let ((bd (/ (beat-division (loop for s in ph until (<= (timesig-off s) e1) finally (return s)))))) + (let ((x (roundto (event-gracedur e) bd))) + (when (<= x 0) bd x))))) (let ((e2 (let ((o (event-endoff e))) (loop-return-lastmin (diff x o) for x in qs)))) + (push (cons (event-off e) e1) ad) (setf (event-off e) e1) (let ((x (- e2 e1))) (if (<= x 0) @@ -115,7 +119,21 @@ (setf (event-dur e) (cons (- (loop for i in qs until (> i e1) finally (return i)) e1) (incf mg)))) - (setf (event-dur* e) x)))))))))) + (progn + (push (cons (event-endoff e) e2) ad) + (setf (event-dur* e) x)))))))) + finally + (addprop p (cons :quant + (merge-all ad (lambda (x y) (let ((x1 (car x)) (x2 (cdr x)) + (y1 (car y)) (y2 (cdr y))) + (when (= x2 y2) + (cons (if (< x1 x2) + #+debug (if (<= y1 y2) (min x1 y1) (error "Error in QUANTIZE-BYFIT 3")) + #-debug (min x1 y1) + #+debug (if (>= y1 y2) (max x1 y1) (error "Error in QUANTIZE-BYFIT 4")) + #-debug (max x1 y1)) + x2)))) + :call-rev nil)))))) (print-dot))))) (defun quantize (timesigs parts) Index: fomus/util.lisp diff -u fomus/util.lisp:1.1.1.1 fomus/util.lisp:1.2 --- fomus/util.lisp:1.1.1.1 Tue Jul 19 20:16:58 2005 +++ fomus/util.lisp Thu Jul 21 17:38:43 2005 @@ -569,3 +569,15 @@ :time (cons (first (timesig-time ts)) (second (timesig-time ts)))))) (timesig-check nt) nt)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; USER UTILITIES + +(defun list-fomus-settings () + (let* ((tc (+ 2 (max (1+ (loop for x in +settings+ maximize (length (symbol-name (first x))))) 4))) + (tl (+ tc 1 (max (loop for (xxx t1 t2) in +settings+ maximize (length (or t2 (princ-to-string t1)))) 4)))) + (format t "; NAME~VTTYPE~VTDEFAULT VALUE~%~%" tc tl) + (loop for (sy t1 t2) in +settings+ do + (format t "; ~A~VT~A~VT~A~%" sy tc (or t2 t1) tl (prin1-to-string (symbol-value (find-symbol (conc-strings "*" (symbol-name sy) "*") :fomus))))))) + + \ No newline at end of file

1 0

[fomus-cvs] CVS update: fomus/doc/marks.xml fomus/doc/objects.xml fomus/doc/settings.xml
by dpsenicka＠common-lisp.net 20 Jul '05

20 Jul '05

Update of /project/fomus/cvsroot/fomus/doc In directory common-lisp.net:/tmp/cvs-serv16769 Modified Files: marks.xml objects.xml settings.xml Log Message: Doc update Date: Wed Jul 20 06:50:01 2005 Author: dpsenicka Index: fomus/doc/marks.xml diff -u fomus/doc/marks.xml:1.1.1.1 fomus/doc/marks.xml:1.2 --- fomus/doc/marks.xml:1.1.1.1 Tue Jul 19 20:17:05 2005 +++ fomus/doc/marks.xml Wed Jul 20 06:50:00 2005 @@ -44,7 +44,7 @@ </para> </listitem> <listitem><para> - The starting mark is included in the object occuring at the start of the spanner and the mark without a prefix + The starting mark is included in the object occurring at the start of the spanner and the mark without a prefix is included in objects following the starting mark. The last object with a mark in it before a new starting mark is found is considered to be the end of the spanner. @@ -79,7 +79,7 @@ <variablelist> <varlistentry> <term><userinput><anchor id="markarg.art.order"/>art-order</userinput></term> - <listitem>An integer for articulations specifying relative closeness to the notehead (lower numbered articulations are closer than higher numbered ones)</listitem> + <listitem>An integer for articulations specifying relative closeness to the note head (lower numbered articulations are closer than higher numbered ones)</listitem> </varlistentry> <varlistentry> <term><userinput><anchor id="markarg.clef"/>clef</userinput></term> @@ -91,8 +91,8 @@ <listitem> This is an integer distinguishing between inner and outer levels of spanner markings. - Smaller numbers are "inner" markings occuring closest to the staff while larger numbers are "outer" markings - occuring farthest from the staff. + Smaller numbers are "inner" markings occurring closest to the staff while larger numbers are "outer" markings + occurring farthest from the staff. The default value is 1 </listitem> @@ -103,8 +103,8 @@ slot in the <classname><link linkend="class.note">NOTE</link></classname> class).</listitem> </varlistentry> <varlistentry> - <term><userinput><anchor id="markarg.notehead"/>notehead</userinput></term> - <listitem>One of the following notehead symbols: (not implemented yet).</listitem> + <term><userinput><anchor id="markarg.notehead"/>note head</userinput></term> + <listitem>One of the following note head symbols: (not implemented yet).</listitem> </varlistentry> <varlistentry> <term><userinput><anchor id="markarg.string"/>string</userinput></term> @@ -112,7 +112,7 @@ </varlistentry> <varlistentry> <term><userinput><anchor id="markarg.trem.subdiv"/>trem-subdiv</userinput></term> - <listitem>A durational value (a ratio or integer) for a tremelo subdivision</listitem> + <listitem>A durational value (a ratio or integer) for a tremolo subdivision</listitem> </varlistentry> </variablelist> </para> @@ -191,10 +191,10 @@ <title>Ornamentations</title> <simplelist> - <member><function>(<anchor id="tremelo"/>:TREMELO &optional <userinput><link link="markarg.trem.subdiv">trem-subdiv</link></userinput>)</function></member> - <member><function>(<anchor id="righthandtremelo"/>:RIGHTHANDTREMELO &optional + <member><function>(<anchor id="tremelo"/>:TREMOLO &optional <userinput><link link="markarg.trem.subdiv">trem-subdiv</link></userinput>)</function></member> + <member><function>(<anchor id="righthandtremelo"/>:RIGHTHANDTREMOLO &optional <userinput><link link="markarg.trem.subdiv">trem-subdiv</link></userinput>)</function></member> - <member><function>(<anchor id="lefthandtremelo"/>:LEFTHANDTREMELO &optional + <member><function>(<anchor id="lefthandtremelo"/>:LEFTHANDTREMOLO &optional <userinput><link link="markarg.trem.subdiv">trem-subdiv</link></userinput>)</function></member> <member><function><anchor id="longtrill"/>:LONGTRILL</function></member> <member><function>(<anchor id="arpeggio"/>:ARPEGGIO &optional <literal>:UP</literal>/<literal>:DOWN</literal>)</function></member> Index: fomus/doc/objects.xml diff -u fomus/doc/objects.xml:1.1.1.1 fomus/doc/objects.xml:1.2 --- fomus/doc/objects.xml:1.1.1.1 Tue Jul 19 20:17:05 2005 +++ fomus/doc/objects.xml Wed Jul 20 06:50:01 2005 @@ -303,7 +303,7 @@ The offset is measured in "beats," which may indicate different notational positions depending on previous time signatures and what values are present in their <structfield><link linkend="timesig.beat">BEAT</link></structfield> slots. - The number must be precise and notatable (floating point numbers are not recommended and values like 10/3 that don't + The number must be precise and "notatable" (floating point numbers are not recommended and values like 10/3 that don't occur on a regular beat divisions are currently impossible for <application>FOMUS</application> to notate). </para> </listitem> @@ -313,7 +313,7 @@ <term><function><anchor id="timesig.time"/>TIMESIG-TIME</function></term> <listitem> <para> - This is a required list of two integers, specifying the numberator and denominator of the printed time signature. + This is a required list of two integers, specifying the numerator and denominator of the printed time signature. </para> </listitem> </varlistentry> @@ -357,13 +357,13 @@ <listitem> <para> This is a single list or list of lists containing ratios or integers that add up to the total number of beats - in a meaure (as specified by either the <structfield><link linkend="timesig.time">TIME</link></structfield> or + in a measure (as specified by either the <structfield><link linkend="timesig.time">TIME</link></structfield> or <structfield><link linkend="timesig.beat">BEAT</link></structfield> slots). It represents all of the choices available for dividing up measures following this time signature. If the slot contains the default value of <literal>NIL</literal>, <application>FOMUS</application> looks up - divisions first in a user-supplied table if one exists (see the <varname><link linkend="default.meas.divs">DEFALT-MEAS-DIVS</link></varname> + divisions first in a user-supplied table if one exists (see the <varname><link linkend="default.meas.divs">DEFAULT-MEAS-DIVS</link></varname> setting) then in <application>FOMUS</application>'s default table. A value usually only needs to be specified here if the user wants to force <application>FOMUS</application> @@ -618,7 +618,7 @@ that make the best use of tuplets within given constraints while minimizing the amount of adjustment error. If this quantizing algorithm is switched off, then the user must insure that all offset and duration values - are precise and notatable (floating point numbers are not recommended in this case). + are precise and "notatable" (floating point numbers are not recommended in this case). </para> </listitem> </varlistentry> @@ -638,7 +638,7 @@ function. Symbols in this case designate notational values and not beats, although - numbers are still interpretted with respect to beats and not filtered through <application>CM</application>'s + numbers are still interpreted with respect to beats and not filtered through <application>CM</application>'s <function>RHYTHM</function> function. </para> @@ -652,7 +652,7 @@ Also, grace notes with the same position form chords, and notes with negative positions are notated with a slash. - The duration value at the front of the list is still interpretted in terms of beats and notated as such even though + The duration value at the front of the list is still interpreted in terms of beats and notated as such even though the note does not take up time in the measure. Specifying a duration of <literal>'(1/4 -1)</literal>, for example, specifies a grace sixteenth note with a slash @@ -901,7 +901,7 @@ Marks designate extra information that to be applied to a <classname><link linkend="class.note">NOTE</link></classname> or <classname><link linkend="class.rest">REST</link></classname> object - such as articulations, modifications like tremelos or harmonics, printed text, etc.. + such as articulations, modifications like tremolos or harmonics, printed text, etc.. After voices and staff assignments have been established, information in the <classname><link linkend="class.mark">MARK</link></classname> objects is dumped into the <structfield><link linkend="note.marks">MARKS</link></structfield> slots of <classname><link linkend="class.note">NOTE</link></classname> and @@ -1013,7 +1013,7 @@ only need to appear in one place. In the case of the example above, a mark with this value in its <structfield><link linkend="mark.voice">VOICE</link></structfield> - slot that is applied to a grandstaff is attached to a note in a voice close to the inside of the staff. + slot that is applied to a grand staff is attached to a note in a voice close to the inside of the staff. </para> <para> @@ -1266,11 +1266,11 @@ <para> The value of this slot influences how <application>FOMUS</application> decides when to change clefs. - A clef change isn't considered necessary until the number of leger lines required exceeds a threshold value. + A clef change isn't considered necessary until the number of ledger lines required exceeds a threshold value. Other factors determine if there is actually a clef change or not. - If the value is an integer, it designates the threshold number of leger lines in all cases. + If the value is an integer, it designates the threshold number of ledger lines in all cases. If it's a list, the first element of the list must be an integer specifying a default threshold. @@ -1278,7 +1278,7 @@ This exception list contains a clef symbol (see the <structfield><link linkend="instr.clefs">CLEFS</link></structfield> slot above) followed by one of the two symbols <literal>:UP</literal> or <literal>:DN</literal> - and ended by an integer specifying the number of leger lines. + and ended by an integer specifying the number of ledger lines. An example illustrates this data structure. @@ -1298,10 +1298,10 @@ <para> This value influences how <application>FOMUS</application> chooses where to place ottava brackets above the staff. - An ottava bracket isn't considered necessary until the number of leger lines required exceeds a threshold value. + An ottava bracket isn't considered necessary until the number of ledger lines required exceeds a threshold value. An integer in this slot indicates the threshold value, while - a list of two elements specifies the threshold for the ottava bracket to begin and the threshold below which the number of leger lines must + a list of two elements specifies the threshold for the ottava bracket to begin and the threshold below which the number of ledger lines must drop for it to end. </para> </listitem> @@ -1398,7 +1398,7 @@ <para> This is an integer or symbol designating where the instrument's notes are to appear on the staff. - The value is interpretted as if notated with a treble cleff signature. + The value is interpreted as if notated with a treble clef signature. See <function>EVENT-NOTE</function> in the <classname><link linkend="class.note">NOTE</link></classname> class for information on specifying notes with symbols. Index: fomus/doc/settings.xml diff -u fomus/doc/settings.xml:1.1.1.1 fomus/doc/settings.xml:1.2 --- fomus/doc/settings.xml:1.1.1.1 Tue Jul 19 20:17:03 2005 +++ fomus/doc/settings.xml Wed Jul 20 06:50:01 2005 @@ -253,7 +253,7 @@ <listitem> <para> This is a real number between <literal>0</literal> and <literal>1</literal> indicating the score for - finding note spellings that form augmented or dimished (rather than diatonic) intervals. + finding note spellings that form augmented or diminished (rather than diatonic) intervals. This value should probably be less than <varname><link linkend="acc.diatonic.int.score">ACC-DIATONIC-INT-SCORE</link></varname>. </para> @@ -265,7 +265,7 @@ <listitem> <para> This is a real number between <literal>0</literal> and <literal>1</literal> indicating the score for - spelling an ascending chromatic line with flats or a decending chromatic line with sharps. + spelling an ascending chromatic line with flats or a descending chromatic line with sharps. This value should probably be less than <varname><link linkend="acc.good.unison.score">ACC-GOOD-UNISON-SCORE</link></varname>. </para> @@ -521,7 +521,7 @@ <term><varname><anchor id="auto.distr.rests.fun"/>:AUTO-DISTR-RESTS-FUN</varname></term> <listitem> <para> - Designates which function is to be used for determining how rests are distributed amoung staves. + Designates which function is to be used for determining how rests are distributed among staves. Current possible values are <literal>:DEFAULT</literal> and <literal>:RESTS1</literal>. @@ -627,7 +627,7 @@ Floating point numbers are treated with the <function>RATIONALIZE</function> function in this case (this isn't recommended). - If offsets and durations of events aren't notatable then <application>FOMUS</application> will complain with an error. + If offsets and durations of events aren't "notatable" then <application>FOMUS</application> will complain with an error. Note that mark objects aren't quantized (see class <classname><link linkend="class.mark">MARK</link></classname> for details). </para> @@ -689,7 +689,7 @@ <term><varname><anchor id="auto.voicing"/>:AUTO-VOICING</varname></term> <listitem> <para> - If set to <literal>T</literal>, <application>FOMUS</application> automatically decides how to distribute notes amoung multiple voices, + If set to <literal>T</literal>, <application>FOMUS</application> automatically decides how to distribute notes among multiple voices, given the choices specified in the <classname>NOTE</classname>, <classname>REST</classname> and <classname>MARK</classname> objects. If set to <literal>NIL</literal>, the user must explicitly specify which voice an event belongs to. @@ -845,7 +845,7 @@ <listitem> <para> When set to <literal>T</literal>, the cautionary accidental algorithm considers the presence ottava brackets, placing - cautionary accidentals where apparant octave transpositions might cause confusion. + cautionary accidentals where apparent octave transpositions might cause confusion. </para> </listitem> </varlistentry> @@ -854,7 +854,7 @@ <term><varname><anchor id="check.ranges"/>:CHECK-RANGES</varname></term> <listitem> <para> - When set to <literal>T</literal>, activates a check that prints warnings if it finds notes out of range for their intruments. + When set to <literal>T</literal>, activates a check that prints warnings if it finds notes out of range for their instruments. The <structfield>MINP</structfield> and <structfield>MAXP</structfield> slots in the appropriate <classname>INSTR</classname> object must be set for this to have any effect. @@ -891,8 +891,8 @@ It affects how clef change decisions are made. - When notes require leger lines that can be avoided by a clef change, the algorithm will consider one if the number of - leger lines increases past a certain threshold (specified in the <structfield><link linkend="instr.cleflegls">CLEFLEGLS</link></structfield> slot of the + When notes require ledger lines that can be avoided by a clef change, the algorithm will consider one if the number of + ledger lines increases past a certain threshold (specified in the <structfield><link linkend="instr.cleflegls">CLEFLEGLS</link></structfield> slot of the <classname><link linkend="struct.instr">INSTR</link></classname> structure). If set to a number this setting will cause the algorithm to consider one anyways if it occurs for the specified duration. @@ -1205,7 +1205,7 @@ <listitem> <para> When set to <literal>T</literal> or <literal>:SOME</literal>, indicates that <application>FOMUS</application> hides some rests - when combining multiple voices in a grandstaff. + when combining multiple voices in a grand staff. This makes the notation easier to read for multi-staff instruments by eliminating rests that aren't necessary. @@ -1386,7 +1386,7 @@ This is a real number greater than <literal>0</literal>, specifying the minimum duration that a group of rests must occupy in order to be hidden. - Extra rests may be hidden when multiple voices are being combined in a grandstaff. + Extra rests may be hidden when multiple voices are being combined in a grand staff. </para> </listitem> </varlistentry> @@ -1430,7 +1430,7 @@ <term><varname><anchor id="parts"/>:PARTS</varname></term> <listitem> <para> - This is a list of <classname><link linkend="class.part">PART</link></classname> objects, each representing a stave or grandstaff in the score. + This is a list of <classname><link linkend="class.part">PART</link></classname> objects, each representing a stave or grand staff in the score. At least one part must be specified. </para> @@ -1505,7 +1505,7 @@ <para> This must be set to an integer greater or equal to <literal>100</literal>. - This value affects the performance of the search algorithm that decides how notes are distributed amoung staves. + This value affects the performance of the search algorithm that decides how notes are distributed among staves. A larger value will cause the algorithm to be slower but more accurate while a smaller value has the opposite affect. </para> @@ -1519,7 +1519,7 @@ This must be set to a real number between <literal>0</literal> and <literal>1</literal>. The value together with the value of <varname><link linkend="staff.importance.steps">STAFF-IMPORTANCE-STEPS</link></varname> - affects the performance of the algorithm that decides how notes are distributed amoung staves. + affects the performance of the algorithm that decides how notes are distributed among staves. As the algorithm searches ahead through possible paths, it regards previous paths as less important depending on how much farther the current best path is. @@ -1539,7 +1539,7 @@ This must be set to an integer greater than <literal>0</literal>. This value together with the value of <varname><link linkend="staff.importance.score">STAFF-IMPORTANCE-SCORE</link></varname> - affects the performance of the algorithm that decides how notes are distributed amoung staves. + affects the performance of the algorithm that decides how notes are distributed among staves. As the algorithm searches ahead through possible paths, it regards previous paths as less important depending on how much farther the current best path is. @@ -1651,7 +1651,7 @@ <varname><link linkend="cm.scale">CM-SCALE</link></varname> as if it were passed as the <literal>:IN</literal> argument to <application>CM</application>'s <function>KEYNUM</function> function. - Also, durations specified as symbols indicate notational durations and are interpretted + Also, durations specified as symbols indicate notational durations and are interpreted as such using <application>CM</application>'s <function>RHYTHM</function> function. Numbers are still interpreted by <application>FOMUS</application> in terms of beats. @@ -1727,7 +1727,7 @@ <listitem> <para> This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for too much - material occuring in one voice and not another. + material occurring in one voice and not another. </para> </listitem> </varlistentry> @@ -1778,7 +1778,7 @@ <para> This must be set to an integer greater or equal to <literal>100</literal>. - This value affects the performance of the search algorithm that decides how notes are distributed amoung voices. + This value affects the performance of the search algorithm that decides how notes are distributed among voices. A larger value will cause the algorithm to be slower but more accurate while a smaller value has the opposite affect. </para> @@ -1816,7 +1816,7 @@ <listitem> <para> This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for placing lower pitched notes - above higher pitched notes when distributing them amoung voices. + above higher pitched notes when distributing them among voices. </para> </listitem> </varlistentry> @@ -1828,7 +1828,7 @@ This must be set to a real number between <literal>0</literal> and <literal>1</literal>. The value together with the value of <varname><link linkend="voice.importance.steps">VOICE-IMPORTANCE-STEPS</link></varname> - affects the performance of the algorithm that decides how notes are distributed amoung voices. + affects the performance of the algorithm that decides how notes are distributed among voices. As the algorithm searches ahead through possible paths, it regards previous paths as less important depending on how much farther the current best path is. @@ -1848,7 +1848,7 @@ This must be set to an integer value greater than 0. The value together with the value of <varname><link linkend="voice.importance.score">VOICE-IMPORTANCE-SCORE</link></varname> - affects the performance of the algorithm that decides how notes are distributed amoung voices. + affects the performance of the algorithm that decides how notes are distributed among voices. As the algorithm searches ahead through possible paths, it regards previous paths as less important depending on how much farther the current best path is. @@ -1891,7 +1891,7 @@ <term><varname><anchor id="voice.leading.penalty"/>:VOICE-LEADING-PENALTY</varname></term> <listitem> <para> - This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for occurances of disjunct melodic lines + This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for occurrences of disjunct melodic lines and wide intervals in voices. This helps to insure that material in each voice is playable. @@ -1929,10 +1929,10 @@ <term><varname><anchor id="voice.simult.penalty"/>:VOICE-SIMULT-PENALTY</varname></term> <listitem> <para> - This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for simultaneous notes occuring in + This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for simultaneous notes occurring in one voice. - This causes chords to be distributed evenly amoung all voices. + This causes chords to be distributed evenly among all voices. </para> </listitem> </varlistentry>

1 0

[fomus-cvs] CVS update: Module imported: fomus
by dpsenicka＠common-lisp.net 19 Jul '05

19 Jul '05

Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv9145 Log Message: Initial import Status: Vendor Tag: fomus Release Tags: alpha N fomus/accidentals.lisp N fomus/parts.lisp N fomus/package.lisp N fomus/backends.lisp N fomus/main.lisp N fomus/voices.lisp N fomus/misc.lisp N fomus/deps.lisp N fomus/data.lisp N fomus/other.lisp N fomus/split.lisp N fomus/classes.lisp N fomus/util.lisp N fomus/staves.lisp N fomus/ottavas.lisp N fomus/marks.lisp N fomus/postproc.lisp N fomus/beams.lisp N fomus/fomus.asd N fomus/interface.lisp N fomus/final.lisp N fomus/backend_ly.lisp N fomus/quantize.lisp N fomus/COPYING N fomus/load.lisp N fomus/TODO N fomus/doc/intro.xml N fomus/doc/settings.xml N fomus/doc/install.xml N fomus/doc/objects.xml N fomus/doc/backends.xml N fomus/doc/init.xml N fomus/doc/fomus.xml N fomus/doc/usage.xml N fomus/doc/marks.xml No conflicts created by this import Date: Tue Jul 19 20:17:05 2005 Author: dpsenicka New module fomus added

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

fomus-cvs