Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv27753

Modified Files: buffer.lisp gui.lisp modes.lisp Log Message: Completed implementation of quartertone playback for regular temperaments. Fixed keybinding bug for microsharper.

--- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/21 11:14:25 1.47 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/28 13:56:53 1.48 @@ -317,35 +317,44 @@ ;;; irregular temperaments. (defclass regular-temperament (tuning) ((octave-cents :initform 1200 :initarg :octave-cents :accessor octave-cents) - (fifth-cents :initform 700 :initarg :fifth-cents :accessor fifth-cents)) - ;; TODO: Add cent sizes of various microtonal accidentals, perhaps in an alist? - ) + (fifth-cents :initform 700 :initarg :fifth-cents :accessor fifth-cents) + (quartertone-cents :initform 50 :initarg :quartertone-cents :accessor quartertone-cents) + ;; TODO: Add cent sizes of various microtonal accidentals, perhaps in an alist? + ))

(defmethod print-gsharp-object progn ((tuning regular-temperament) stream) (format stream "~_:octave-cents ~W ~_:fifth-cents ~W " (octave-cents tuning) (fifth-cents tuning)))

(defmethod note-cents ((note note) (tuning regular-temperament)) - (let ((octave-cents (octave-cents tuning)) - (fifth-cents (fifth-cents tuning))) - (multiple-value-bind (octave pitch) (floor (pitch note) 7) - (+ (* octave-cents (1+ octave)) - (ecase pitch - (0 0) - (1 (+ (* -1 octave-cents) (* 2 fifth-cents))) - (2 (+ (* -2 octave-cents) (* 4 fifth-cents))) - (3 (- octave-cents fifth-cents)) - (4 fifth-cents) - (5 (+ (* -1 octave-cents) (* 3 fifth-cents))) - (6 (+ (* -2 octave-cents) (* 5 fifth-cents)))) - (* (ecase (accidentals note) - (:double-flat -2) - (:flat -1) - (:natural 0) - (:sharp 1) - (:double-sharp 2)) - (- (* 7 fifth-cents) - (* 4 octave-cents))))))) + (let ((octaves 1) + (fifths 0) + (sharps 0) ;; short for 7 fifths up and 4 octaves down + (quartertones 0)) + (incf octaves (floor (pitch note) 7)) + (ecase (mod (pitch note) 7) + (0 (progn)) + (1 (progn (incf octaves -1) (incf fifths 2))) + (2 (progn (incf octaves -2) (incf fifths 4))) + (3 (progn (incf octaves 1) (incf fifths -1))) + (4 (progn (incf fifths 1))) + (5 (progn (incf octaves -1) (incf fifths 3))) + (6 (progn (incf octaves -2) (incf fifths 5)))) + (ecase (accidentals note) + (:double-flat (incf sharps -2)) + (:sesquiflat (incf sharps -1) (incf quartertones -1)) + (:flat (incf sharps -1)) + (:semiflat (incf quartertones -1)) + (:natural) + (:semisharp (incf quartertones 1)) + (:sharp (incf sharps 1)) + (:sesquisharp (incf sharps 1) (incf quartertones 1)) + (:double-sharp (incf sharps 2))) + (incf octaves (* -4 sharps)) + (incf fifths (* 7 sharps)) + (+ (* octaves (octave-cents tuning)) + (* fifths (fifth-cents tuning)) + (* quartertones (quartertone-cents tuning)))))

;;; TODO: (defclass irregular-temperament ...)

--- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/21 11:14:25 1.78 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/28 13:56:53 1.79 @@ -366,12 +366,14 @@

(define-gsharp-command (com-set-segment-tuning-regular-temperament :name t) ((octave-cents 'cl:number :prompt "Octave size in cents") - (fifth-cents 'cl:number :prompt "Fifth size in cents")) + (fifth-cents 'cl:number :prompt "Fifth size in cents") + (quartertone-cents 'cl:number :prompt "Quartertone size in cents")) ;; TODO: prompt for sizes of various microtonal accidentals (let ((segment (segment (current-cursor)))) (setf (tuning segment) (make-instance 'regular-temperament :octave-cents octave-cents - :fifth-cents fifth-cents)))) + :fifth-cents fifth-cents + :quartertone-cents quartertone-cents))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/21 11:14:27 1.24 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/28 13:56:53 1.25 @@ -84,7 +84,7 @@

(set-key 'com-sharper 'cluster-table '((##))) (set-key 'com-flatter 'cluster-table '(#@)) -(set-key 'com-microsharper 'cluster-table '((## :control))) +(set-key 'com-microsharper 'cluster-table '((## :control :shift))) (set-key 'com-microflatter 'cluster-table '((#@ :control :shift))) (set-key 'com-add-note-c 'cluster-table '(#\C)) (set-key 'com-add-note-d 'cluster-table '(#\D))