Mercurial > hg > amuse
changeset 109:a9a1c7aa86a9
rename mips-pitch -> diatonic-pitch
darcs-hash:20070726131834-dc3a5-86b4b1aa5dc46bef8f25fa9111e2e08e51046c9b.gz
| author | c.rhodes <c.rhodes@gold.ac.uk> |
|---|---|
| date | Thu, 26 Jul 2007 14:18:34 +0100 |
| parents | b445959f4cc1 |
| children | ea542c06c364 |
| files | base/classes.lisp base/constructors.lisp base/methods.lisp base/package.lisp |
| diffstat | 4 files changed, 19 insertions(+), 19 deletions(-) [+] |
line wrap: on
line diff
--- a/base/classes.lisp Thu Jul 26 14:10:18 2007 +0100 +++ b/base/classes.lisp Thu Jul 26 14:18:34 2007 +0100 @@ -49,12 +49,13 @@ ((number :accessor %chromatic-pitch-number :initarg :number)) (:documentation "A pitch represented as a number, with higher values representing high pitches.")) -(defclass mips-pitch (pitch) +(defclass diatonic-pitch (pitch) ((cp :initarg :cp :accessor %p-pc :reader diatonic-pitch-cp) (mp :initarg :mp :accessor %p-pm :reader diatonic-pitch-mp)) - (:documentation "A MIPS pitch: cp is an integer representing -chromatic pitch (An0 = 0, middle C = 39); mp is an integer -representing the morphetic pitch (An0 = 0, middle c = 23).")) + (:documentation "A diatonic pitch, represented using MIPS: cp is an +integer representing chromatic pitch (An0 = 0, middle C = 39); mp is +an integer representing the morphetic pitch (An0 = 0, middle C = +23).")) (defclass pitch-interval (pitch-interval-designator) ((span :accessor %pitch-interval-span :initarg :span)))
--- a/base/constructors.lisp Thu Jul 26 14:10:18 2007 +0100 +++ b/base/constructors.lisp Thu Jul 26 14:18:34 2007 +0100 @@ -36,10 +36,10 @@ (let* ((name (if (numberp name) (elt "ABCDEFG" name) name)) (asa-string (asa-string name accidental octave)) (p (mips:pn-p asa-string))) - (make-instance 'mips-pitch :cp (first p) :mp (second p))))) + (make-instance 'diatonic-pitch :cp (first p) :mp (second p))))) (defun make-mips-pitch (cp mp) - (make-instance 'mips-pitch :cp cp :mp mp)) + (make-instance 'diatonic-pitch :cp cp :mp mp)) (defun make-chromatic-pitch-interval (span) (make-instance 'pitch-interval :span span))
--- a/base/methods.lisp Thu Jul 26 14:10:18 2007 +0100 +++ b/base/methods.lisp Thu Jul 26 14:18:34 2007 +0100 @@ -12,17 +12,17 @@ (unless (or (before e1 e2) (meets e1 e2)) (setf result nil)))))) -;;; MIPS pitch +;;; diatonic pitch (represented using MIPS) -(defmethod asa-pitch-string ((mp mips-pitch)) +(defmethod asa-pitch-string ((mp diatonic-pitch)) (mips:p-pn (list (%p-pc mp) (%p-pm mp)))) -(defmethod diatonic-pitch-octave ((mp mips-pitch)) +(defmethod diatonic-pitch-octave ((mp diatonic-pitch)) (let* ((asa-string (asa-pitch-string mp)) (start (position-if #'digit-char-p asa-string))) (values (parse-integer asa-string :start start)))) -(defmethod diatonic-pitch-accidental ((mp mips-pitch)) +(defmethod diatonic-pitch-accidental ((mp diatonic-pitch)) (let* ((asa-string (asa-pitch-string mp)) (start 1) (end (position-if #'digit-char-p asa-string)) @@ -30,28 +30,28 @@ (multiplier (cdr (assoc (char asa-string 1) malist)))) (* multiplier (- end start)))) -(defmethod diatonic-pitch-name ((mp mips-pitch)) +(defmethod diatonic-pitch-name ((mp diatonic-pitch)) (elt (asa-pitch-string mp) 0)) -(defmethod pitch= ((p1 mips-pitch) (p2 mips-pitch)) +(defmethod pitch= ((p1 diatonic-pitch) (p2 diatonic-pitch)) (let ((c1 (%p-pc p1)) (m1 (%p-pm p1)) (c2 (%p-pc p2)) (m2 (%p-pm p2))) (and c1 c2 (= c1 c2) m1 m2 (= m1 m2)))) -(defmethod middle-c ((mp mips-pitch)) - (make-mips-pitch 39 23)) +(defmethod middle-c ((mp diatonic-pitch)) + (make-diatonic-pitch 39 23)) -(defmethod midi-pitch-number ((mp mips-pitch)) +(defmethod midi-pitch-number ((mp diatonic-pitch)) (+ (%p-pc mp) 21)) -(defmethod octave ((mp mips-pitch)) +(defmethod octave ((mp diatonic-pitch)) (1- (floor (midi-pitch-number mp) 12))) -(defmethod diatonic-pitch ((mp mips-pitch)) +(defmethod diatonic-pitch ((mp diatonic-pitch)) mp) -(defmethod print-object ((o mips-pitch) stream) +(defmethod print-object ((o diatonic-pitch) stream) (print-unreadable-object (o stream :type t) (let ((asa-string (asa-pitch-string o))) (write asa-string :stream stream))))