Mercurial > hg > amuse
changeset 182:470e83242576
Bug fixes for tuning and tactus guessing
darcs-hash:20080710114805-40ec0-a889d9b281c8f37934a5eefde8e1269f9cf05d89.gz
| author | d.lewis <d.lewis@gold.ac.uk> |
|---|---|
| date | Thu, 10 Jul 2008 12:48:05 +0100 |
| parents | a397dfe432f6 |
| children | 5b2d0e5a99f1 |
| files | implementations/tabcode/amuse-tabcode.asd implementations/tabcode/methods.lisp implementations/tabcode/tabcode-import.lisp tools/gsharp-output.lisp |
| diffstat | 4 files changed, 46 insertions(+), 17 deletions(-) [+] |
line wrap: on
line diff
--- a/implementations/tabcode/amuse-tabcode.asd Wed Jul 09 08:35:09 2008 +0100 +++ b/implementations/tabcode/amuse-tabcode.asd Thu Jul 10 12:48:05 2008 +0100 @@ -4,4 +4,5 @@ ((:file "package") (:file "classes" :depends-on ("package")) (:file "methods" :depends-on ("package" "classes")) - (:file "tabcode-import" :depends-on ("package" "classes")))) \ No newline at end of file + (:file "tabcode-import" :depends-on ("package" "classes")) + (:file "ecolm" :depends-on ("tabcode-import" "methods" "classes" "package")))) \ No newline at end of file
--- a/implementations/tabcode/methods.lisp Wed Jul 09 08:35:09 2008 +0100 +++ b/implementations/tabcode/methods.lisp Thu Jul 10 12:48:05 2008 +0100 @@ -50,7 +50,11 @@ (do ((proportion 4 (/ proportion 2))) ((= (rem (/ (duration bar) proportion) beats-in-bar) 0) - (setf beat-duration proportion)))) + (setf beat-duration proportion)) + (unless (>= proportion 1/4) + (setf beat-duration (round (/ (duration bar) + beats-in-bar))) + (return)))) ((null (ll metre)) (cond ((string= (ul metre) "C") @@ -58,11 +62,20 @@ (setf beat-duration 1)) ((string= (ul metre) "C/") (setf beats-in-bar 2) - (setf beat-duration 2))))) + (setf beat-duration 2))) + ;; clearly wrong, but for the time being try this (better is + ;; work out for the whole piece + (do ((proportion 4 (/ proportion 2))) + ((= (rem (/ (duration bar) proportion) + beats-in-bar) 0) + (setf beat-duration proportion)) + (unless (>= proportion 2) + (setf beat-duration 2) + (return))))) (unless (= (rem (duration bar) (* beat-duration beats-in-bar)) 0) - (error "Bar length doesn't match metrical symbol, I think")) + (print "Bar length doesn't match metrical symbol, I think")) (let ((beat-period (make-standard-anchored-period (timepoint bar) beat-duration))) (do ()
--- a/implementations/tabcode/tabcode-import.lisp Wed Jul 09 08:35:09 2008 +0100 +++ b/implementations/tabcode/tabcode-import.lisp Thu Jul 10 12:48:05 2008 +0100 @@ -191,21 +191,31 @@ (setf current-tuning (apply-tuning (cdr (assoc "tuning" rules :test #'string=)) current-tuning))) - ((assoc "tuning-named" rules :test #'string=) + ((or (assoc "tuning-named" rules :test #'string=) + (assoc "tuning_named" rules :test #'string=)) (setf current-tuning - (apply-tuning (cdr (assoc (string-downcase (cdr (assoc "tuning-named" - rules :test #'string=))) + (apply-tuning (cdr (assoc (string-downcase + (cdr (or (assoc "tuning-named" + rules :test #'string=) + (assoc "tuning_named" + rules :test #'string=)))) *tuning-names* :test #'string=)) current-tuning)))) (cond - ((assoc "bass-tuning" rules :test #'string=) + ((or (assoc "bass-tuning" rules :test #'string=) + (assoc "bass_tuning" rules :test #'string=)) (setf current-tuning - (apply-tuning (cdr (assoc "bass-tuning" rules :test #'string=)) - current-tuning 6))) - ((assoc "bass-tuning-named" rules :test #'string=) + (apply-tuning (cdr (or (assoc "bass-tuning" rules :test #'string=) + (assoc "bass_tuning" rules :test #'string=))) + current-tuning 6))) + ((or (assoc "bass-tuning-named" rules :test #'string=) + (assoc "bass_tuning_named" rules :test #'string=)) (setf current-tuning - (apply-tuning (cdr (assoc (string-downcase (cdr (assoc "bass-tuning-named" - rules :test #'string=))) + (apply-tuning (cdr (assoc (string-downcase + (cdr (or (assoc "bass-tuning-named" + rules :test #'string=) + (assoc "bass_tuning_named" + rules :test #'string=)))) *tuning-names* :test #'string=)) current-tuning 6))))
--- a/tools/gsharp-output.lisp Wed Jul 09 08:35:09 2008 +0100 +++ b/tools/gsharp-output.lisp Thu Jul 10 12:48:05 2008 +0100 @@ -177,10 +177,15 @@ (beat-period (amuse::current-beat (make-standard-moment 0) composition) (amuse::current-beat (cut-off beat-period) composition)) (beat-time (timepoint beat-period) (timepoint beat-period))) - ((time>= (onset beat-period) (cut-off composition)) - (reverse (if current - (cons (reverse current) starts) - starts))) + ((time>= (cut-off beat-period) (cut-off composition)) + (progn + (when (and (cdr bars) + (>= beat-time (second bars))) + (push (reverse current) starts) + (setf current nil + bars (cdr bars))) + (push beat-time current) + (reverse (cons (reverse current) starts)))) (when (and (cdr bars) (>= beat-time (second bars))) (push (reverse current) starts)