[gsharp-cvs] CVS gsharp

[mjonsson]

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))