Mercurial > hg > amuse
changeset 67:8b31d54c95be
base/: {TIME-SIGNATURE,KEY-SIGNATURE,TEMPO}-EQUAL moved here from implementations/mtp/
darcs-hash:20070706093228-c0ce4-9ca0951f98303474fb5da95fc20ebdb2c3fa4db0.gz
| author | Marcus Pearce <m.pearce@gold.ac.uk> |
|---|---|
| date | Fri, 06 Jul 2007 10:32:28 +0100 |
| parents | 6c8fd815603e |
| children | 95dce8c7f08c |
| files | base/generics.lisp base/methods.lisp base/package.lisp implementations/mtp/methods.lisp |
| diffstat | 4 files changed, 37 insertions(+), 20 deletions(-) [+] |
line wrap: on
line diff
--- a/base/generics.lisp Wed Jul 04 12:00:15 2007 +0100 +++ b/base/generics.lisp Fri Jul 06 10:32:28 2007 +0100 @@ -221,15 +221,21 @@ (defgeneric get-applicable-time-signatures (anchored-period composition) (:method (ap c) (find-overlapping ap (time-signatures c)))) +(defgeneric time-signature-equal (ts1 ts2)) + ;;; Tempo (defgeneric get-applicable-tempi (anchored-period composition) (:method (ap c) (find-overlapping ap (tempi c)))) +(defgeneric tempo-equal (t1 t2)) + ;;; Tonality (Key Signature / Mode) (defgeneric get-applicable-key-signatures (object1 object2)) +(defgeneric key-signature-equal (ks1 ks2)) + ;;; Dynamics ;;; Voice ;;; Boundary Strength (phrasing)
--- a/base/methods.lisp Wed Jul 04 12:00:15 2007 +0100 +++ b/base/methods.lisp Fri Jul 06 10:32:28 2007 +0100 @@ -30,15 +30,43 @@ (defmethod beat-units ((time-signature basic-time-signature)) (%basic-time-signature-denominator time-signature)) +(defmethod time-signature-equal ((ts1 basic-time-signature) + (ts2 basic-time-signature)) + (let ((n1 (time-signature-numerator ts1)) + (n2 (time-signature-numerator ts2)) + (d1 (time-signature-denominator ts1)) + (d2 (time-signature-denominator ts2))) + (and n1 n2 (= n1 n2) + d1 d2 (= d1 d2)))) + (defmethod key-signature-sharps ((key-signature basic-key-signature)) (%basic-key-signature-sharp-count key-signature)) (defmethod key-signature-mode ((ks midi-key-signature)) (%midi-key-signature-mode ks)) +(defmethod key-signature-equal ((ks1 basic-key-signature) + (ks2 basic-key-signature)) + (let ((s1 (key-signature-sharps ks1)) + (s2 (key-signature-sharps ks2))) + (and s1 s2 (= s1 s2)))) + +(defmethod key-signature-equal ((ks1 midi-key-signature) + (ks2 midi-key-signature)) + (let ((s1 (key-signature-sharps ks1)) + (s2 (key-signature-sharps ks2)) + (m1 (key-signature-mode ks1)) + (m2 (key-signature-mode ks2))) + (and s1 s2 (= s1 s2) + m1 m2 (= m1 m2)))) + (defmethod bpm ((tempo tempo)) (%tempo-bpm tempo)) +(defmethod tempo-equal ((t1 tempo) (t2 tempo)) + (and (bpm t1) (bpm t2) (= t1 t2))) + + ;; Time protocol (defmethod time+ ((object1 moment) (object2 period))
--- a/base/package.lisp Wed Jul 04 12:00:15 2007 +0100 +++ b/base/package.lisp Fri Jul 06 10:32:28 2007 +0100 @@ -109,4 +109,7 @@ #:make-basic-key-signature #:make-midi-key-signature #:make-tempo + #:time-signature-equal + #:key-signature-equal + #:tempo-equal ))
--- a/implementations/mtp/methods.lisp Wed Jul 04 12:00:15 2007 +0100 +++ b/implementations/mtp/methods.lisp Fri Jul 06 10:32:28 2007 +0100 @@ -90,16 +90,6 @@ ;;; Constituents from compositions: time-signatures -(defgeneric time-signature-equal (ts1 ts2)) -(defmethod time-signature-equal ((ts1 basic-time-signature) - (ts2 basic-time-signature)) - (let ((n1 (time-signature-numerator ts1)) - (n2 (time-signature-numerator ts2)) - (d1 (time-signature-denominator ts1)) - (d2 (time-signature-denominator ts2))) - (and n1 n2 (= n1 n2) - d1 d2 (= d1 d2)))) - (defgeneric time-signature (event)) (defmethod time-signature ((e mtp-event)) (let ((pulses (%mtp-pulses e)) @@ -141,16 +131,6 @@ ;;; Constituents from compositions: key-signatures -(defgeneric key-signature-equal (ks1 ks2)) -(defmethod key-signature-equal ((ks1 midi-key-signature) - (ks2 midi-key-signature)) - (let ((s1 (key-signature-sharps ks1)) - (s2 (key-signature-sharps ks2)) - (m1 (key-signature-mode ks1)) - (m2 (key-signature-mode ks2))) - (and s1 s2 (= s1 s2) - m1 m2 (= m1 m2)))) - (defgeneric key-signature (event)) (defmethod key-signature ((e mtp-event)) (let ((keysig (%mtp-keysig e))