From crhodes at common-lisp.net  Sat Jun  2 15:14:41 2007
From: crhodes at common-lisp.net (crhodes)
Date: Sat,  2 Jun 2007 11:14:41 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070602151441.3967874388@common-lisp.net>

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

Modified Files:
	buffer.lisp 
Log Message:
Fix for :name foo being printed before the class name in 
print-gsharp-object, reported by Brian Gruber.


--- /project/gsharp/cvsroot/gsharp/buffer.lisp	2007/01/17 12:21:01	1.42
+++ /project/gsharp/cvsroot/gsharp/buffer.lisp	2007/06/02 15:14:40	1.43
@@ -15,10 +15,11 @@
 (defclass gsharp-object () ())
 
 (defgeneric print-gsharp-object (obj stream)
-  (:method-combination progn :most-specific-last))
+  (:method-combination progn))
 
-(defmethod print-gsharp-object progn ((obj gsharp-object) stream)
-  (format stream "~s ~2i" (class-name (class-of obj))))
+(defmethod print-gsharp-object :around ((obj gsharp-object) stream)
+  (format stream "~s ~2i" (class-name (class-of obj)))
+  (call-next-method))
 
 ;;; (defmethod print-object :around ((obj gsharp-object) stream)
 ;;;  (format stream "[~a " (slot-value obj 'print-character))



From crhodes at common-lisp.net  Wed Jun  6 13:16:05 2007
From: crhodes at common-lisp.net (crhodes)
Date: Wed,  6 Jun 2007 09:16:05 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070606131605.E66BD47005@common-lisp.net>

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

Modified Files:
	buffer.lisp 
Log Message:
Make things a bit less likely to crash: only do the full readable 
printing if *print-circle* is true; otherwise just do a normal
print-unreadable-object (which will handle the *print-readably* correct 
behaviour for us).


--- /project/gsharp/cvsroot/gsharp/buffer.lisp	2007/06/02 15:14:40	1.43
+++ /project/gsharp/cvsroot/gsharp/buffer.lisp	2007/06/06 13:16:02	1.44
@@ -27,8 +27,10 @@
 ;;;   (format stream "] "))
 
 (defmethod print-object ((obj gsharp-object) stream)
-  (pprint-logical-block (stream nil :prefix "[" :suffix "]")
-    (print-gsharp-object obj stream)))
+  (if *print-circle*
+      (pprint-logical-block (stream nil :prefix "[" :suffix "]")
+        (print-gsharp-object obj stream))
+      (print-unreadable-object (obj stream :type t :identity t))))
 
 (defgeneric name (obj))
 



From crhodes at common-lisp.net  Thu Jun  7 09:26:05 2007
From: crhodes at common-lisp.net (crhodes)
Date: Thu,  7 Jun 2007 05:26:05 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070607092605.B01CE2E1D6@common-lisp.net>

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

Modified Files:
	gui.lisp modes.lisp 
Log Message:
Somewhat hacky motion-by-layout commands (line- and page-based).  These
was by far the most annoying motion commands to be lacking when actually 
editing scores, in my opinion; C-a and C-e are absolutely wired into my 
fingers.

Future candidates for inclusion: motion by layer (ideally in a way 
that's related to the layout, so that in the common case where there is 
one layer per staff the Right Thing happens); motion by 
note-in-associated-layer (lyrics).

Also remove C-h binding for delete-current-element, and put Backspace in 
instead; this lets the ESA help bindings work.


--- /project/gsharp/cvsroot/gsharp/gui.lisp	2007/01/16 05:17:40	1.74
+++ /project/gsharp/cvsroot/gsharp/gui.lisp	2007/06/07 09:26:04	1.75
@@ -1016,6 +1016,98 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
+;;; motion by layout (page or line)
+
+;;; support routines, needed because we're not cacheing the page
+;;; breaks (other than in the buffer Obseq) nor the linebreaks (at
+;;; all)
+(defun position-containing-current-bar (sequence)
+  (let ((bar (bar (current-cursor))))
+    (position-if (lambda (measure) (member bar (measure-bars measure)))
+                 sequence)))
+(defun get-page-lines (buffer page-measures)
+  (score-pane:with-staff-size 6
+    (let* (;; all this untimely ripp'd from DRAW-BUFFER in
+	   ;; drawing.lisp.  Needs to be kept in sync, otherwise the
+	   ;; layout for motion will be different from the layout on
+	   ;; the screen...
+           (staves (staves buffer))
+           (timesig-offset (gsharp-drawing::compute-timesig-offset staves))
+           (method (let ((old-method (buffer-cost-method buffer)))
+                     (make-measure-cost-method (min-width old-method)
+                                               (spacing-style old-method)
+                                               (- (line-width old-method) timesig-offset)
+                                               (lines-per-page old-method))))
+           (systems-per-page (max 1 (floor 12 (length staves)))))
+      (gsharp-drawing::layout-page page-measures systems-per-page method))))
+
+;;; FIXME: these routines should implement numeric-argument handling
+(define-gsharp-command (com-forward-page :name t)
+    ()
+  (let ((cursor (current-cursor)))
+    (gsharp-measure::new-map-over-obseq-subsequences
+     (lambda (page-measures)
+       (let ((position (position-containing-current-bar page-measures)))
+         (when position
+           (loop repeat (- (length page-measures) position)
+                 if (last-bar-p cursor)
+                 do (go-to-end-of-bar cursor) (return-from com-forward-page)
+                 else do (forward-bar cursor)
+                 finally (return-from com-forward-page)))))
+     (current-buffer))))
+(define-gsharp-command (com-backward-page :name t)
+    ()
+  (let ((cursor (current-cursor)))
+    (gsharp-measure::new-map-over-obseq-subsequences
+     (let ((last 0))
+       (lambda (page-measures)
+         (let ((position (position-containing-current-bar page-measures)))
+           (when position
+             (loop repeat (+ position last)
+                   do (backward-bar cursor)
+                   finally (progn
+                             (go-to-beginning-of-bar cursor)
+                             (return-from com-backward-page)))))
+         (setf last (length page-measures))))
+     (current-buffer))))
+
+(define-gsharp-command (com-end-of-line :name t)
+    ()    
+  (let ((buffer (current-buffer))
+        (cursor (current-cursor)))
+    (gsharp-measure::new-map-over-obseq-subsequences
+     (lambda (page-measures)
+       (when (position-containing-current-bar page-measures)
+         (let ((lines (get-page-lines buffer page-measures)))
+           (dolist (line lines)
+             (let ((position (position-containing-current-bar line)))
+               (when position
+                 (loop repeat (- (length line) position 1)
+                       do (forward-bar cursor)
+                       finally (progn
+                                 (go-to-end-of-bar cursor)
+                                 (return-from com-end-of-line)))))))))
+     buffer)))
+(define-gsharp-command (com-beginning-of-line :name t)
+    ()    
+  (let ((buffer (current-buffer))
+        (cursor (current-cursor)))
+    (gsharp-measure::new-map-over-obseq-subsequences
+     (lambda (page-measures)
+       (when (position-containing-current-bar page-measures)
+         (let ((lines (get-page-lines buffer page-measures)))
+           (dolist (line lines)
+             (let ((position (position-containing-current-bar line)))
+               (when position
+                 (loop repeat position
+                       do (backward-bar cursor)
+                       finally (progn
+                                 (go-to-beginning-of-bar cursor)
+                                 (return-from com-beginning-of-line)))))))))
+     buffer)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
 ;;; delete commands
 
 (defun go-to-beginning-of-bar (cursor)
--- /project/gsharp/cvsroot/gsharp/modes.lisp	2007/01/16 05:11:09	1.21
+++ /project/gsharp/cvsroot/gsharp/modes.lisp	2007/06/07 09:26:05	1.22
@@ -8,7 +8,14 @@
 (set-key `(com-forward-measure ,*numeric-argument-marker*) 'global-gsharp-table '((#\f :control :meta)))
 (set-key `(com-backward-measure ,*numeric-argument-marker*) 'global-gsharp-table '((#\b :control :meta)))
 (set-key `(com-delete-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\d :control)))
-(set-key `(com-erase-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\h :control)))
+(set-key `(com-delete-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\Rubout)))
+(set-key `(com-erase-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\Backspace)))
+
+;;; FIXME: implement numeric arg handling
+(set-key 'com-forward-page 'global-gsharp-table '((#\x :control) #\]))
+(set-key 'com-backward-page 'global-gsharp-table '((#\x :control) #\[))
+(set-key 'com-end-of-line 'global-gsharp-table '((#\e :control)))
+(set-key 'com-beginning-of-line 'global-gsharp-table '((#\a :control)))
 
 (set-key 'com-insert-barline 'global-gsharp-table '(#\|))
 



From crhodes at common-lisp.net  Thu Jun  7 10:21:48 2007
From: crhodes at common-lisp.net (crhodes)
Date: Thu,  7 Jun 2007 06:21:48 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070607102148.1BC72650D5@common-lisp.net>

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

Modified Files:
	drawing.lisp 
Log Message:
Placement of semibreve rests when they are the only element in the bar 
(conventionally meaning whole-bar rest): place them in the middle of the 
bar.  The semantic interpretation (e.g. by Play Segment) is unlikely to 
respect this conventional meaning currently (noticeable if you use these 
whole-bar rests in a piece in 3/4, say)


--- /project/gsharp/cvsroot/gsharp/drawing.lisp	2007/01/07 06:05:35	1.74
+++ /project/gsharp/cvsroot/gsharp/drawing.lisp	2007/06/07 10:21:47	1.75
@@ -311,6 +311,13 @@
 		 finally (setf (elasticity-function measure) result)))
   (reduce #'add-elasticities measures :key #'elasticity-function))
 
+(defun single-whole-rest-in-bar-p (element)
+  (let* ((bar (bar element))
+         (elements (elements bar)))
+    (and (null (cdr elements))
+         (typep element 'rest)
+         (eq (notehead element) :whole))))
+
 (defun compute-measure-coordinates (measure x y force)
   (loop with timelines = (timelines measure)
 	for i from 0 below (flexichain:nb-elements timelines)
@@ -320,7 +327,9 @@
 				 (* force (elasticity timeline))))
         do (loop for element in (elements timeline)
 		 do (setf (final-absolute-element-xoffset element)
-			  (round (+ xx (score-pane:staff-step (xoffset element)))))))
+                          (if (single-whole-rest-in-bar-p element)
+                              (round (+ x (/ (size-at-force (elasticity-function measure) force) 2)))
+                              (round (+ xx (score-pane:staff-step (xoffset element))))))))
   (loop for bar in (measure-bars measure)
 	do (compute-bar-coordinates bar x y (size-at-force (elasticity-function measure) force))))
 
@@ -487,10 +496,6 @@
 			 (values best-splits best-min best-max))))))))
     (split-aux sequence 0 (length sequence) n)))
 		     
-					
-
-	
-
 (defun layout-page (measures n method)
   (if (<= (length measures) n)
       (mapcar #'list measures)



From crhodes at common-lisp.net  Sun Jun 10 08:10:03 2007
From: crhodes at common-lisp.net (crhodes)
Date: Sun, 10 Jun 2007 04:10:03 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070610081003.DF02D2E1BB@common-lisp.net>

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

Modified Files:
	drawing.lisp 
Log Message:
When drawing the gsharp cursor, also scroll the viewport if necessary so 
that the cursor remains on the screen.

Currently this is a little ugly in UI, because of slightly nasty 
discontinuities in the drawing process, and pretty ugly in the code.  
FIXME commentaries are noted


--- /project/gsharp/cvsroot/gsharp/drawing.lisp	2007/06/07 10:21:47	1.75
+++ /project/gsharp/cvsroot/gsharp/drawing.lisp	2007/06/10 08:10:03	1.76
@@ -772,35 +772,54 @@
 
 (defun draw-the-cursor (pane cursor cursor-element last-note)
   (let* ((staff (car (staves (layer cursor))))
-	 (bar (bar cursor)))
+	 (bar (bar cursor))
+	 (sy (system-y-position bar))
+	 (yoffset (- (gsharp-drawing::staff-yoffset staff))))
+    (let ((region (pane-viewport-region pane)))
+      (when region
+	;; FIXME: adjusting the viewport at this point leads to ugly
+	;; jumps in the display when going across pages, as the page
+	;; is first laid out and drawn, then the viewport is moved.
+	;; If we instead cleared the pane, laid out the page, adjusted
+	;; the viewport, and finally drew the page (and cursor) then
+	;; that jump would probably go away.
+	;;
+	;; FIXME: this calculation only takes account of the centre of
+	;; the cursor.  Refactor this whole DRAW-THE-CURSOR function
+	;; so that it's easy to take account of the vertical extent of
+	;; the cursor.
+	(unless (< (bounding-rectangle-min-y region)
+		   (- sy yoffset)
+		   (bounding-rectangle-max-y region))
+	  (let ((maxy (- (bounding-rectangle-max-y pane) (bounding-rectangle-height region))))
+	    (scroll-extent pane 0 (max 0 (min maxy
+					      (- sy (floor (bounding-rectangle-height region) 2)))))))))
+				       
     (flet ((draw-cursor (x)
-	     (let* ((sy (system-y-position bar))
-		    ;; Why (- STAFF-YOFFSET)?  dunno.  -- CSR, 2005-10-28
-		    (yoffset (- (gsharp-drawing::staff-yoffset staff))))
-	       (if (typep staff 'fiveline-staff)
-		   (let* ((clef (clef staff))
-			  (bottom-line (bottom-line clef))
-			  (lnote-offset (score-pane:staff-step (- last-note bottom-line))))
-		     (draw-line* pane
-				 x (+ sy (- (+ (score-pane:staff-step 12) yoffset)))
-				 x (+ sy (- (+ (score-pane:staff-step -4) yoffset)))
-				 :ink +yellow+)
-		     (draw-line* pane
-				 (- x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)))
-				 (- x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)))
-				 :ink +red+)
-		     (draw-line* pane
-				 (+ x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)))
-				 (+ x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)))
-				 :ink +red+))
-		   (progn (draw-line* pane
-				      (+ x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset)))
-				      (+ x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset)))
-				      :ink +red+)
-			  (draw-line* pane
-				      (- x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset)))
-				      (- x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset)))
-				      :ink +red+))))))
+	     (if (typep staff 'fiveline-staff)
+		 (let* ((clef (clef staff))
+			(bottom-line (bottom-line clef))
+			(lnote-offset (score-pane:staff-step (- last-note bottom-line))))
+		   (draw-line* pane
+			       x (+ sy (- (+ (score-pane:staff-step 12) yoffset)))
+			       x (+ sy (- (+ (score-pane:staff-step -4) yoffset)))
+			       :ink +yellow+)
+		   (draw-line* pane
+			       (- x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)))
+			       (- x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)))
+			       :ink +red+)
+		   (draw-line* pane
+			       (+ x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)))
+			       (+ x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)))
+			       :ink +red+))
+		 (progn (draw-line* pane
+				    (+ x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset)))
+				    (+ x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset)))
+				    :ink +red+)
+			(draw-line* pane
+				    (- x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset)))
+				    (- x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset)))
+				    :ink +red+)))))
       (score-pane:with-staff-size 6
 	(let* ((x (final-absolute-measure-xoffset bar))
 	       (width (final-width bar))



From crhodes at common-lisp.net  Sun Jun 10 08:15:29 2007
From: crhodes at common-lisp.net (crhodes)
Date: Sun, 10 Jun 2007 04:15:29 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070610081529.C20182F067@common-lisp.net>

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

Modified Files:
	gui.lisp modes.lisp 
Log Message:
select-layer-by-layout commands and keybindings (C-down and C-up for 
now)


--- /project/gsharp/cvsroot/gsharp/gui.lisp	2007/06/07 09:26:04	1.75
+++ /project/gsharp/cvsroot/gsharp/gui.lisp	2007/06/10 08:15:28	1.76
@@ -1108,6 +1108,38 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
+;;; selecting layers based on layout (next/previous staff)
+
+;;; FIXME: numeric argument handling again
+(define-gsharp-command (com-previous-staff :name t)
+    ()
+  (let ((staff (car (staves (layer (current-cursor))))))
+    (loop for (prev curr) on (staves (current-buffer))
+	  if (eq curr staff)
+	  do (let ((layers (layers (segment (current-cursor)))))
+	       (dolist (layer layers)
+		 (when (member prev (staves layer))
+		   (select-layer (current-cursor) layer)
+		   (do ()
+		       ((eq prev (car (staves layer))))
+		     (com-rotate-staves))
+		   (return-from com-previous-staff)))))))
+(define-gsharp-command (com-next-staff :name t)
+    ()
+  (let ((staff (car (staves (layer (current-cursor))))))
+    (loop for (curr next) on (staves (current-buffer))
+	  if (eq curr staff)
+	  do (let ((layers (layers (segment (current-cursor)))))
+	       (dolist (layer layers)
+		 (when (member next (staves layer))
+		   (select-layer (current-cursor) layer)
+		   (do ()
+		       ((eq next (car (staves layer))))
+		     (com-rotate-staves))
+		   (return-from com-next-staff)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
 ;;; delete commands
 
 (defun go-to-beginning-of-bar (cursor)
--- /project/gsharp/cvsroot/gsharp/modes.lisp	2007/06/07 09:26:05	1.22
+++ /project/gsharp/cvsroot/gsharp/modes.lisp	2007/06/10 08:15:29	1.23
@@ -17,6 +17,10 @@
 (set-key 'com-end-of-line 'global-gsharp-table '((#\e :control)))
 (set-key 'com-beginning-of-line 'global-gsharp-table '((#\a :control)))
 
+;;; FIXME: implement numeric arg handling
+(set-key 'com-previous-staff 'global-gsharp-table '((:up :control)))
+(set-key 'com-next-staff 'global-gsharp-table '((:down :control)))
+
 (set-key 'com-insert-barline 'global-gsharp-table '(#\|))
 
 (set-key 'com-end-of-score 'global-gsharp-table '((#\> :shift :meta)))



From mjonsson at common-lisp.net  Fri Jun 15 16:26:15 2007
From: mjonsson at common-lisp.net (mjonsson)
Date: Fri, 15 Jun 2007 12:26:15 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070615162615.1044A74371@common-lisp.net>

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

Modified Files:
	buffer.lisp play.lisp 
Log Message:
Changed test.mid to /tmp/test.mid in play.lisp, removed code duplication calculating durations of bars

--- /project/gsharp/cvsroot/gsharp/buffer.lisp	2007/06/06 13:16:02	1.44
+++ /project/gsharp/cvsroot/gsharp/buffer.lisp	2007/06/15 16:26:14	1.45
@@ -646,7 +646,7 @@
 ;;; kind of cache, in order to avoid looping over each 
 ;;; element and computing the duration of each one each time.
 (defmethod duration ((bar bar))
-  (reduce #'+ (mapcar #'duration (elements bar))))
+  (reduce #'+ (elements bar) :key #'duration))
 
 (defgeneric make-bar-for-staff (staff &rest args &key elements))
 
--- /project/gsharp/cvsroot/gsharp/play.lisp	2006/03/02 09:29:44	1.5
+++ /project/gsharp/cvsroot/gsharp/play.lisp	2007/06/15 16:26:14	1.6
@@ -14,9 +14,7 @@
 
 (defun measure-durations (slices)
   (let ((durations (mapcar (lambda (slice)
-			     (mapcar (lambda (bar)
-				       (reduce #'+ (elements bar)
-					       :key #'duration))
+			     (mapcar #'duration
 				     (bars slice)))
 			   slices)))
     (loop while durations
@@ -80,11 +78,11 @@
 		     :format 1
 		     :division 25
 		     :tracks tracks)))
-    (write-midi-file midifile "test.mid")
+    (write-midi-file midifile "/tmp/test.mid")
     #+cmu
-    (ext:run-program "timidity" '("test.mid"))
+    (ext:run-program "timidity" '("/tmp/test.mid"))
     #+sbcl
-    (sb-ext:run-program "timidity" '("test.mid") :search t)
+    (sb-ext:run-program "timidity" '("/tmp/test.mid") :search t)
     #-(or cmu sbcl)
     (error "write compatibility layer for RUN-PROGRAM")))
 



From mjonsson at common-lisp.net  Mon Jun 18 15:18:17 2007
From: mjonsson at common-lisp.net (mjonsson)
Date: Mon, 18 Jun 2007 11:18:17 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070618151817.E6FB166001@common-lisp.net>

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

Modified Files:
	buffer.lisp gui.lisp packages.lisp play.lisp 
Log Message:
Added support for regular temperaments

--- /project/gsharp/cvsroot/gsharp/buffer.lisp	2007/06/15 16:26:14	1.45
+++ /project/gsharp/cvsroot/gsharp/buffer.lisp	2007/06/18 15:18:17	1.46
@@ -260,6 +260,89 @@
 (defun note-equal (note1 note2)
   (= (pitch note1) (pitch note2)))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Tuning (support for microtonal and historical tunings/temperaments)
+
+;;; FIXME: add name-mixin also?
+(defclass tuning (gsharp-object)
+  ((master-pitch-note :initform (make-instance 'note :pitch 33 ; a above middle c
+                                                     :staff (make-instance 'staff))
+                      :initarg :master-pitch-note
+                      :type note
+                      :accessor master-pitch-note)
+   (master-pitch-freq :initform 440
+                      :initarg :master-pitch-freq
+                      :accessor master-pitch-freq)))
+
+(defmethod print-gsharp-object progn ((tuning tuning) stream)
+  (format stream "~_:master-pitch-note ~W ~_:master-pitch-freq ~W "
+          (master-pitch-note tuning) (master-pitch-freq tuning)))
+
+;;; Returns how a note should be tuned in a given tuning
+;;; in terms of a cent value.
+(defgeneric note-cents (note tuning))
+
+;;; 12-edo is provided for efficiency only. It is a 
+;;; special case of a regular temperament. Perhaps it
+;;; should be removed?
+(defclass 12-edo (tuning)
+  ())
+
+(defmethod print-gsharp-object progn ((tuning 12-edo) stream)
+  ;; no parameters to save
+  )
+
+(defmethod note-cents ((note note) (tuning 12-edo))
+  (multiple-value-bind (octave pitch) (floor (pitch note) 7)
+    (+ (* 1200 (1+ octave))
+       (ecase pitch (0 0) (1 200) (2 400) (3 500) (4 700) (5 900) (6 1100))
+       (ecase (accidentals note)
+         (:double-flat -200)
+         (:flat -100)
+         (:natural 0)
+         (:sharp 100)
+         (:double-sharp 200)))))
+
+;;; regular temperaments are temperaments that
+;;; retain their interval sizes regardless of modulation, as opposed to
+;;; 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?
+  )
+
+(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)))))))
+ 
+;;; TODO: (defclass irregular-temperament ...)
+ 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Element
@@ -987,7 +1070,9 @@
   ((print-character :allocation :class :initform #\S)
    (buffer :initform nil :initarg :buffer :accessor buffer)
    (layers :initform '() :initarg :layers :accessor layers)
-   (tempo :initform 128 :initarg :tempo :accessor tempo)))
+   (tempo :initform 128 :initarg :tempo :accessor tempo)
+   (tuning :initform (make-instance '12-edo)
+           :initarg :tuning :accessor tuning)))
 
 (defmethod initialize-instance :after ((s segment) &rest args &key staff)
   (declare (ignore args))
@@ -999,7 +1084,8 @@
           do (setf (segment layer) s))))
 
 (defmethod print-gsharp-object progn ((s segment) stream)
-  (format stream "~_:layers ~W ~_:tempo ~W " (layers s) (tempo s)))
+  (format stream "~_:layers ~W ~_:tempo ~W ~_:tuning ~W "
+          (layers s) (tempo s) (tuning s)))
 
 (defun read-segment-v3 (stream char n)
   (declare (ignore char n))
--- /project/gsharp/cvsroot/gsharp/gui.lisp	2007/06/10 08:15:28	1.76
+++ /project/gsharp/cvsroot/gsharp/gui.lisp	2007/06/18 15:18:17	1.77
@@ -364,6 +364,15 @@
   (let ((segment (segment (current-cursor))))
     (setf (tempo segment) tempo)))
 
+(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"))
+  ;; 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))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; layer menu
--- /project/gsharp/cvsroot/gsharp/packages.lisp	2007/01/31 15:25:04	1.59
+++ /project/gsharp/cvsroot/gsharp/packages.lisp	2007/06/18 15:18:17	1.60
@@ -94,7 +94,9 @@
 	   #:right-edge #:left-offset
 	   #:left-margin #:text #:append-char #:erase-char
 	   #:tie-right #:tie-left
-	   #:needs-saving))
+	   #:needs-saving
+           #:tuning #:master-pitch-note #:master-pitch-freq
+           #:note-cents #:12-edo #:regular-temperament))
 
 (defpackage :gsharp-numbering
   (:use :gsharp-utilities :gsharp-buffer :clim-lisp)
--- /project/gsharp/cvsroot/gsharp/play.lisp	2007/06/15 16:26:14	1.6
+++ /project/gsharp/cvsroot/gsharp/play.lisp	2007/06/18 15:18:17	1.7
@@ -1,16 +1,17 @@
 (in-package :gsharp-play)
 
+(defvar *tuning*)
+(defvar *tempo*)
+
 (defun midi-pitch (note)
-  (+ (* 12 (+ (floor (pitch note) 7) 1))
-     (ecase (mod (pitch note) 7) (0 0) (1 2) (2 4) (3 5) (4 7) (5 9) (6 11))
-     (ecase (accidentals note)
-       (:double-flat -2) 
-       (:flat -1) 
-       (:natural 0)
-       (:sharp 1)
-       (:double-sharp 2))))
+  (round (+ (+ 6700 ; a above middle c, 440 Hz
+               (* 1200 (log (/ (master-pitch-freq *tuning*) 440) 2)))
+            (- (note-cents note *tuning*)
+               (note-cents (master-pitch-note *tuning*) *tuning*)))
+         100))
 
-(defvar *tempo*)
+(defun cents-adjustment (note)
+  (nth-value 1 (midi-pitch note)))
 
 (defun measure-durations (slices)
   (let ((durations (mapcar (lambda (slice)
@@ -18,19 +19,40 @@
 				     (bars slice)))
 			   slices)))
     (loop while durations
-	  collect (reduce #'max (mapcar #'car durations))
+	  collect (reduce #'max durations :key #'car)
 	  do (setf durations (remove nil (mapcar #'cdr durations))))))
 
+(defun average (list &key (key #'identity))
+  (let ((sum 0)
+        (count 0))
+    (dolist (elem list)
+      (incf count)
+      (incf sum (funcall key elem)))
+    (/ sum count)))
+
 (defun events-from-element (element time channel)
   (when (typep element 'cluster)
-    (append (mapcar (lambda (note)
+    (append (list
+             (make-instance 'pitch-bend-message
+                            :time time
+                            :status (+ #xE0 channel)
+                            :value (+ 8192 ;; middle of pitch-bend controller
+                                      (round
+                                       (* 4096/100 ;; 4096 points per 100 cents
+                                          ;; midi can only do per-channel pitch bend,
+                                          ;; not per-note pitch bend, so as a sad
+                                          ;; compromise we average the pitch bends
+                                          ;; of all notes in the cluster
+                                          (average (notes element)
+                                           :key #'cents-adjustment))))))
+            (mapcar (lambda (note)
 		      (make-instance 'note-on-message
-				     :time time
+                                     :time time
 				     :status (+ #x90 channel)
 				     :key (midi-pitch note) :velocity 100))
 		    (remove-if #'tie-left (notes element)))
-	    (mapcar (lambda (note)
-		      (make-instance 'note-off-message
+            (mapcar (lambda (note)
+                      (make-instance 'note-off-message
 				     :time (+ time (* *tempo* (duration element)))
 				     :status (+ #x80 channel)
 				     :key (midi-pitch note) :velocity 100))
@@ -55,6 +77,7 @@
   (let* ((slices (mapcar #'body (layers segment)))
 	 (durations (measure-durations slices))
          (*tempo* (tempo segment))
+         (*tuning* (gsharp-buffer:tuning segment))
 	 (tracks (loop for slice in slices
 		       for i from 0
 		       collect (track-from-slice slice i durations)))
@@ -85,4 +108,3 @@
     (sb-ext:run-program "timidity" '("/tmp/test.mid") :search t)
     #-(or cmu sbcl)
     (error "write compatibility layer for RUN-PROGRAM")))
-



From crhodes at common-lisp.net  Tue Jun 19 10:01:37 2007
From: crhodes at common-lisp.net (crhodes)
Date: Tue, 19 Jun 2007 06:01:37 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070619100137.D180C7208F@common-lisp.net>

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

Modified Files:
	play.lisp 
Log Message:
a above middle c is 69, not 67.


--- /project/gsharp/cvsroot/gsharp/play.lisp	2007/06/18 15:18:17	1.7
+++ /project/gsharp/cvsroot/gsharp/play.lisp	2007/06/19 10:01:37	1.8
@@ -4,7 +4,7 @@
 (defvar *tempo*)
 
 (defun midi-pitch (note)
-  (round (+ (+ 6700 ; a above middle c, 440 Hz
+  (round (+ (+ 6900 ; a above middle c, 440 Hz
                (* 1200 (log (/ (master-pitch-freq *tuning*) 440) 2)))
             (- (note-cents note *tuning*)
                (note-cents (master-pitch-note *tuning*) *tuning*)))



From crhodes at common-lisp.net  Thu Jun 21 11:14:29 2007
From: crhodes at common-lisp.net (crhodes)
Date: Thu, 21 Jun 2007 07:14:29 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070621111429.4908E67045@common-lisp.net>

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

Modified Files:
	buffer.lisp gui.lisp measure.lisp modes.lisp sdl.lisp 
Log Message:
Support for semi/sesqui sharp/flat.

* don't declare the type of the accidentals slot any more; we can put
  that back in a little, after we work out a declarative way of defining
  all properties of accidentals.

* microsharpen and microflatten commands and functions; define sharpen 
  and flatten in terms of those (and knowing which accidentals are the
  tonal ones).  Keybindings for the commands.

* a more declarative table-based system for kerning accidentals, along 
  with the ability to specify a per-glyph default (and a default 
  default).  Choose a sensible default default; also alter the 
  :sharp/:sharp table when +4 steps away, as the previous value was 
  colliding a little too much.

* support for playing the semi accidentals in equal temperament.  No 
  support in linear temperament, as I don't know what they mean.

* glyphs defined with a little too much liberal cut'n'paste.  Some 
  FIXMEs note the essential differences between the related glyphs.


--- /project/gsharp/cvsroot/gsharp/buffer.lisp	2007/06/18 15:18:17	1.46
+++ /project/gsharp/cvsroot/gsharp/buffer.lisp	2007/06/21 11:14:25	1.47
@@ -219,8 +219,10 @@
    (head :initform nil :initarg :head :reader head
          :type (or (member :whole :half :filled) null))
    (accidentals :initform :natural :initarg :accidentals :reader accidentals
-                :type (member :natural :flat :double-flat
-                              :sharp :double-sharp))
+		;; FIXME: we want :TYPE ACCIDENTAL here but need to
+		;; sort out order of definition for that to be useful.
+		#+nil #+nil 
+                :type (member :natural :flat :double-flat :sharp :double-sharp))
    (dots :initform nil :initarg :dots :reader dots
          :type (or (integer 0 3) null))
    (%tie-right :initform nil :initarg :tie-right :accessor tie-right)
@@ -230,8 +232,9 @@
   (declare (type (integer 0 127) pitch)
            (type staff staff)
            (type (or (member :whole :half :filled) null) head)
-           (type (member :natural :flat :double-flat
-                         :sharp :double-sharp)
+	   ;; FIXME: :TYPE ACCIDENTAL
+	   #+nil #+nil
+           (type (member :natural :flat :double-flat :sharp :double-sharp)
                  accidentals)
            (type (or (integer 0 3) null) dots)
            (ignore head accidentals dots))
@@ -300,9 +303,13 @@
        (ecase pitch (0 0) (1 200) (2 400) (3 500) (4 700) (5 900) (6 1100))
        (ecase (accidentals note)
          (:double-flat -200)
+	 (:sesquiflat -150)
          (:flat -100)
+	 (:semiflat -50)
          (:natural 0)
+	 (:semisharp 50)
          (:sharp 100)
+	 (:sesquisharp 150)
          (:double-sharp 200)))))
 
 ;;; regular temperaments are temperaments that
--- /project/gsharp/cvsroot/gsharp/gui.lisp	2007/06/18 15:18:17	1.77
+++ /project/gsharp/cvsroot/gsharp/gui.lisp	2007/06/21 11:14:25	1.78
@@ -822,17 +822,61 @@
       (add-note element new-note)
       (setf *current-note* new-note))))
 
+(defmacro define-microtonal-accidentals (&rest microaccidentals)
+  `(progn
+    (setf (symbol-plist 'microsharpen)
+          ',(loop for (a b) on microaccidentals
+		  if b collect a and collect b
+		  else collect a and collect a))
+    (setf (symbol-plist 'microflatten)
+          ',(loop for (a b) on (reverse microaccidentals)
+		  if b collect a and collect b
+		  else collect a and collect a))
+    (deftype accidental () '(member , at microaccidentals))
+    (defun microsharpen (accidental)
+      (or (getf (symbol-plist 'microsharpen) accidental)
+	  (error 'type-error :datum accidental :expected-type 'microaccidental)))
+    (defun microflatten (accidental)
+      (or (getf (symbol-plist 'microflatten) accidental)
+	  (error 'type-error :datum accidental :expected-type 'microaccidental)))))
+
+(defmacro define-accidentals (&rest accidentals)
+  `(progn
+    (deftype accidental () '(member , at accidentals))
+    (defun sharpen (accidental)
+      (do ((a (microsharpen accidental) (microsharpen a))
+	   (olda accidental a))
+	  ((or (eq a olda) (member a ',accidentals)) a)))
+    (defun flatten (accidental)
+      (do ((a (microflatten accidental) (microflatten a))
+	   (olda accidental a))
+	  ((or (eq a olda) (member a ',accidentals)) a)))))
+
+(define-microtonal-accidentals :double-flat :sesquiflat :flat :semiflat
+			       :natural 
+			       :semisharp :sharp :sesquisharp :double-sharp)
+
+(define-accidentals :double-flat :flat :natural :sharp :double-sharp)
+    
 (define-gsharp-command com-sharper ()
   (let* ((cluster (cur-cluster))
          (note (cur-note))
          (new-note (make-note (pitch note) (staff note)
                      :head (head note)
-                     :accidentals (ecase (accidentals note)
-                                    (:double-sharp :double-sharp)
-                                    (:sharp :double-sharp)
-                                    (:natural :sharp)
-                                    (:flat :natural)
-                                    (:double-flat :flat))
+                     :accidentals (sharpen (accidentals note))
+                     :dots (dots note))))
+    (remove-note note)
+    (add-note cluster new-note)
+    (setf *current-note* new-note)))
+
+(define-gsharp-command com-microsharper ()
+  ;; FIXME: what are CUR-CLUSTER and CUR-NOTE and how do they relate
+  ;; to CURRENT-CLUSTER &c?
+  (let* ((cluster (cur-cluster))
+         (note (cur-note))
+         (new-note (make-note (pitch note) (staff note)
+                     :head (head note)
+                     :accidentals (microsharpen (accidentals note))
                      :dots (dots note))))
     (remove-note note)
     (add-note cluster new-note)
@@ -843,12 +887,18 @@
          (note (cur-note))
          (new-note (make-note (pitch note) (staff note)
                      :head (head note)
-                     :accidentals (ecase (accidentals note)
-                                    (:double-sharp :sharp)
-                                    (:sharp :natural)
-                                    (:natural :flat)
-                                    (:flat :double-flat)
-                                    (:double-flat :double-flat))
+                     :accidentals (flatten (accidentals note))
+                     :dots (dots note))))
+    (remove-note note)
+    (add-note cluster new-note)
+    (setf *current-note* new-note)))
+
+(define-gsharp-command com-microflatter ()
+  (let* ((cluster (cur-cluster))
+         (note (cur-note))
+         (new-note (make-note (pitch note) (staff note)
+                     :head (head note)
+                     :accidentals (microflatten (accidentals note))
                      :dots (dots note))))
     (remove-note note)
     (add-note cluster new-note)
--- /project/gsharp/cvsroot/gsharp/measure.lisp	2006/06/21 16:31:54	1.32
+++ /project/gsharp/cvsroot/gsharp/measure.lisp	2007/06/21 11:14:25	1.33
@@ -248,48 +248,57 @@
 		  nil
 		  (accidentals note)))))
 
-;;; table of x offsets (in staff steps) of accendentals.
-;;; The first index represents a notehead or a type of accidental.
-;;; The second index represents a type of accidentsl.
-;;; The third index is a vertical distance, measured in difference
-;;; in staff steps between the two. 
-;;; The table entry gives how much the accidental represented by
-;;; the second parameter must be positioned to the left of the 
-;;; first one. 
-;;; Entries in the table are offset by 5 in the last dimension
-;;; so that vertical distances between -5 and 5 can be represented
-(defparameter *accidental-offset*
-  ;;;     -5  -4  -3  -2  -1   0   1   2   3   4   5
-  #3A(((   0   0   0 3.5 3.5 3.5 3.5 3.5 3.5   1   0)    ; notehead - dbl flat
-       (   0   0   0 3.5 3.5 3.5 3.5 3.5 3.5   1   0)    ; notehead - flat
-       (   0 3.5 3.5 3.5 3.5 3.5 3.5 3.5   1   1   0)    ; notehead - natural
-       (   0 3.5 3.5 3.5 3.5 3.5 3.5 3.5   1   1   0)    ; notehead - sharp
-       (   0   0   0 3.5 3.5 3.5 3.5 3.5   0   0   0))   ; notehead - dbl sharp
-      (( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8   3   3   0)    ; dbl flat - dbl flat
-       ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8   3   3   0)    ; dbl flat - flat
-       ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8   3   3   0)    ; dbl flat - natural
-       (   4   4   4   4   4   4   4   4   4 3.5   0)    ; dbl flat - sharp
-       ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8   0   0   0))   ; dbl flat - dbl sharp
-      ((   2   2   2   2   2   2   2   2 1.5   1   0)    ; flat - dbl flat
-       (   2   2   2   2   2   2   2   2 1.5   1   0)    ; flat - flat
-       (   2   2   2   2   2   2   2   2 1.5   1   0)    ; flat - natural
-       ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 1.5   0)    ; flat - sharp
-       ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4   0   0   0))   ; flat - dbl sharp
-      ((   2   2   2   2   2   2   2   2   2 1.5 1.5)    ; natural - dbl flat
-       (   2   2   2   2   2   2   2   2   2 1.5 1.5)    ; natural - flat
-       (   2   2   2   2   2   2   2   2   2 1.5 1.5)    ; natural - natural
-       (   2   2   2   2   2   2   2   2   2   2   2)    ; natural - sharp
-       (   2   2   2   2   2   2   2   2   1   1   1))   ; natural - dbl sharp
-      ((   0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0)    ; sharp - dbl flat
-       (   0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0)    ; sharp - flat
-       ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0)    ; sharp - natural
-       ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 2.0)    ; sharp - sharp
-       (   0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4   0   0))   ; sharp - dbl sharp
-      ((   0   0 2.4 2.4 2.4 2.4 2.4 2.4   2   1   0)    ; dbl sharp - dbl flat
-       (   0   0 2.4 2.4 2.4 2.4 2.4 2.4   2   1   0)    ; dbl sharp - flat
-       (   0   0 2.4 2.4 2.4 2.4 2.4 2.4   2   1   0)    ; dbl sharp - natural
-       (   0 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8   0)    ; dbl sharp - sharp
-       (   0   0   0 2.8 2.8 2.8 2.8 2.8   0   0   0)))) ; dbl sharp - dbl sharp
+(defmacro define-accidental-kerning (left right table)
+  `(let ((plist (getf (symbol-plist 'accidental-kerning) ',right)))
+    (setf (getf (symbol-plist 'accidental-kerning) ',right)
+          (cons (cons ',left ',table)
+	        (remove ',left plist :key #'car)))))
+(defmacro define-default-accidental-kerning (right table)
+  `(define-accidental-kerning default ,right ,table))
+
+(macrolet ((define-kernings (&rest args)
+	       `(progn ,@(loop for (left right table) on args by #'cdddr
+			       collect `(define-accidental-kerning ,left ,right ,table)))))
+  (define-kernings
+    :double-flat  :notehead     #(  0   0   0 3.5 3.5 3.5 3.5 3.5 3.5   1   0)
+    :flat         :notehead     #(  0   0   0 3.5 3.5 3.5 3.5 3.5 3.5   1   0)
+    :natural      :notehead     #(  0 3.5 3.5 3.5 3.5 3.5 3.5 3.5   1   1   0)
+    :sharp        :notehead     #(  0 3.5 3.5 3.5 3.5 3.5 3.5 3.5   1   1   0)
+    :double-sharp :notehead     #(  0   0   0 3.5 3.5 3.5 3.5 3.5   0   0   0)
+
+    :double-flat  :double-flat  #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8   3   3   0)
+    :flat         :double-flat  #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8   3   3   0)
+    :natural      :double-flat  #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8   3   3   0)
+    :sharp        :double-flat  #(  4   4   4   4   4   4   4   4   4 3.5   0)
+    :double-sharp :double-flat  #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8   0   0   0)
+
+    :double-flat  :flat         #(  2   2   2   2   2   2   2   2 1.5   1   0)
+    :flat         :flat         #(  2   2   2   2   2   2   2   2 1.5   1   0)
+    :natural      :flat         #(  2   2   2   2   2   2   2   2 1.5   1   0)
+    :sharp        :flat         #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 1.5   0)
+    :double-sharp :flat         #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4   0   0   0)
+
+    :double-flat  :natural      #(  2   2   2   2   2   2   2   2   2 1.5 1.5)
+    :flat         :natural      #(  2   2   2   2   2   2   2   2   2 1.5 1.5)
+    :natural      :natural      #(  2   2   2   2   2   2   2   2   2 1.5 1.5)
+    :sharp        :natural      #(  2   2   2   2   2   2   2   2   2   2   2)
+    :double-sharp :natural      #(  2   2   2   2   2   2   2   2   1   1   1)
+
+    :double-flat  :sharp        #(  0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0)
+    :flat         :sharp        #(  0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0)
+    :natural      :sharp        #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0)
+    :sharp        :sharp        #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0)
+    :double-sharp :sharp        #(  0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4   0   0)
+
+    :double-flat  :double-sharp #(  0   0 2.4 2.4 2.4 2.4 2.4 2.4   2   1   0)
+    :flat         :double-sharp #(  0   0 2.4 2.4 2.4 2.4 2.4 2.4   2   1   0)
+    :natural      :double-sharp #(  0   0 2.4 2.4 2.4 2.4 2.4 2.4   2   1   0)
+    :sharp        :double-sharp #(  0 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8   0)
+    :double-sharp :double-sharp #(  0   0   0 2.8 2.8 2.8 2.8 2.8   0   0   0)
+    ))
+
+(defvar *default-accidental-kerning* 
+  #(4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0))
 
 ;;; given 1) a type of accidental 2) its position (in staff steps) 3)
 ;;; a type of accidental or a type of notehead, and 4) its position,
@@ -297,24 +306,16 @@
 ;;; steps to the left that it must be moved in order to avoid overlap
 ;;; with the second one.
 (defun accidental-distance (acc1 pos1 acc2 pos2)
-  (let ((dist (- pos2 pos1)))
-    (if (> (abs dist) 5)
-	0
-	(aref *accidental-offset*
-	      (ecase acc2
-		(:notehead 0)
-		(:double-flat 1)
-		(:flat 2)
-		(:natural 3)
-		(:sharp 4)
-		(:double-sharp 5))
-	      (ecase acc1
-		(:double-flat 0)
-		(:flat 1)
-		(:natural 2)
-		(:sharp 3)
-		(:double-sharp 4))
-	      (+ dist 5)))))		
+  (let* ((dist (- pos2 pos1))
+	 (right-info (getf (symbol-plist 'accidental-kerning) acc2))
+	 (left-right-info (cdr (assoc acc1 right-info)))
+	 (default-right-info (cdr (assoc 'default right-info))))
+    (cond
+      ((> (abs dist) 5) 0)
+      ((or (not right-info) (and (not left-right-info) (not default-right-info)))
+       (aref *default-accidental-kerning* (+ dist 5)))
+      ((not left-right-info) (aref default-right-info (+ dist 5)))
+      (t (aref left-right-info (+ dist 5))))))
 
 ;;; given two notes (where the first one has an accidental, and the
 ;;; second one may or may not have an accidental) and the conversion
--- /project/gsharp/cvsroot/gsharp/modes.lisp	2007/06/10 08:15:29	1.23
+++ /project/gsharp/cvsroot/gsharp/modes.lisp	2007/06/21 11:14:27	1.24
@@ -84,6 +84,8 @@
 
 (set-key 'com-sharper 'cluster-table '((#\#)))
 (set-key 'com-flatter 'cluster-table '(#\@))
+(set-key 'com-microsharper 'cluster-table '((#\# :control)))
+(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))
 (set-key 'com-add-note-e 'cluster-table '(#\E))
--- /project/gsharp/cvsroot/gsharp/sdl.lisp	2006/06/07 22:40:26	1.31
+++ /project/gsharp/cvsroot/gsharp/sdl.lisp	2007/06/21 11:14:27	1.32
@@ -1009,6 +1009,56 @@
 ;;;
 ;;; Accidentals
 
+(defmethod compute-design ((font font) (shape (eql :semisharp)))
+  (with-slots ((sld staff-line-distance)
+	       (slt staff-line-thickness)
+	       stem-thickness
+	       yoffset) font
+    (let* (;; A factor that determines the space between the vertical
+	   ;; bars and the outer edge of the character as a fraction of
+	   ;; the staff line distance
+	   (edge-distance-multiplier 0.2)
+	   ;; A factor that determines the height of the thin part as a
+	   ;; fraction of the staff line distance
+	   (height-multiplier 2.5)
+	   ;; A factor that determines the width of the hole as a fraction of the
+	   ;; staff line distance.
+	   (hole-width-multiplier 0.33)
+	   (hole-width (round (* hole-width-multiplier sld)))
+	   ;; Hope that half a pixel will not be visible and will not influence 
+	   ;; the required distance to the noteheads.  
+	   ;;
+	   ;; FIXME: this is the only real difference between the
+	   ;; :semisharp and :sesquisharp glyph calculations, and the
+	   ;; :sharp glyph.  Find a way to unify the glyph
+	   ;; computations in a proper metafonty way.
+	   (xoffset (if (oddp hole-width) 0.5 0.5))
+	   (edge-distance (* edge-distance-multiplier sld))
+	   (width (+ hole-width (* 2 stem-thickness) (* 2 edge-distance)))
+	   ;; FIXME: this leads to a blurry glyph at most sizes:
+	   ;; choose a coordinate which lies on a pixel boundary in
+	   ;; preference.
+	   (xleft (* -0.25 width))
+	   (xright (- xleft))
+	   (yleft (* -0.15 width))
+	   (yright (- yleft))
+	   ;; The path for the thick part symmetric around (0, 0)
+	   (thickpart (mf (complex xleft yleft) -- (complex xright yright)))
+	   ;; Determine the y coordinate of the previous path at the
+	   ;; cross point of the thin part.  Use congruent triangles.
+	   (ythin (/ (* (- xright edge-distance) yright) xright))
+	   (height (* height-multiplier sld))
+	   ;; The path for the thin part symmetric around (0, 0)
+	   (thinpart (mf (complex 0 (* 0.5 height)) -- (complex 0 (* -0.5 height)))))
+      (clim:region-union
+       (with-pen (rotate (scale +razor+ (* 0.4 sld)) (/ pi 2))
+	 (clim:region-union (draw-path (translate thickpart
+						  (complex xoffset (+ yoffset (* 0.5 sld)))))
+			    (draw-path (translate thickpart
+						  (complex xoffset (+ yoffset (* -0.5 sld)))))))
+       (with-pen (scale +razor+ stem-thickness)
+	 (draw-path (translate thinpart (complex xoffset yoffset))))))))
+
 (defmethod compute-design ((font font) (shape (eql :sharp)))
   (with-slots ((sld staff-line-distance)
 	       (slt staff-line-thickness)
@@ -1060,6 +1110,58 @@
 							      (* 0.5 stem-thickness))
 							   (+ yoffset ythin))))))))))
 
+(defmethod compute-design ((font font) (shape (eql :sesquisharp)))
+  (with-slots ((sld staff-line-distance)
+	       (slt staff-line-thickness)
+	       stem-thickness
+	       yoffset) font
+    (let* (;; A factor that determines the space between the vertical
+	   ;; bars and the outer edge of the character as a fraction of
+	   ;; the staff line distance
+	   (edge-distance-multiplier 0.2)
+	   ;; A factor that determines the height of the thin part as a
+	   ;; fraction of the staff line distance
+	   (height-multiplier 2.5)
+	   ;; A factor that determines the width of the hole as a fraction of the
+	   ;; staff line distance.
+	   (hole-width-multiplier 0.33)
+	   (hole-width (round (* hole-width-multiplier sld)))
+	   ;; Hope that half a pixel will not be visible and will not
+	   ;; influence the required distance to the noteheads.
+	   ;;
+	   ;; FIXME: see note in :semisharp glyph at this point
+	   (xoffset (if (oddp hole-width) 0.5 0.5))
+	   (edge-distance (* edge-distance-multiplier sld))
+	   (width (+ hole-width (* 2 stem-thickness) (* 2 edge-distance)))
+	   (xleft (* -0.75 width))
+	   (xright (- xleft))
+	   (yleft (* -0.15 width))
+	   (yright (- yleft))
+	   ;; The path for the thick part symmetric around (0, 0)
+	   (thickpart (mf (complex xleft yleft) -- (complex xright yright)))
+	   ;; Determine the y coordinate of the previous path at the
+	   ;; cross point of the thin part.  Use congruent triangles.
+	   (ythin (/ (* (- xright edge-distance) yright) xright))
+	   (height (* height-multiplier sld))
+	   ;; The path for the thin part symmetric around (0, 0)
+	   (thinpart (mf (complex 0 (* 0.5 height)) -- (complex 0 (* -0.5 height)))))
+      (clim:region-union
+       (with-pen (rotate (scale +razor+ (* 0.4 sld)) (/ pi 2))
+	 (clim:region-union (draw-path (translate thickpart
+						  (complex xoffset (+ yoffset (* 0.5 sld)))))
+			    (draw-path (translate thickpart
+						  (complex xoffset (+ yoffset (* -0.5 sld)))))))
+       (with-pen (scale +razor+ stem-thickness)
+	 (clim:region-union 
+	  (clim:region-union
+	   (draw-path (translate thinpart
+				 (complex (- xoffset hole-width (* 1 stem-thickness))
+					  (- yoffset ythin))))
+	   (draw-path (translate thinpart (complex (- xoffset (* 0 stem-thickness)) yoffset))))
+	  (draw-path (translate thinpart
+				(complex (+ xoffset hole-width (* 1 stem-thickness))
+					 (+ yoffset ythin))))))))))
+
 (defmethod compute-design ((font font) (shape (eql :double-sharp)))
   (with-slots ((sld staff-line-distance) xoffset yoffset) font
     (flet ((c (x y) (complex x y)))
@@ -1075,13 +1177,38 @@
 		      (translate (rotate leg (* pi 1.0)) (c xoffset yoffset))
 		      (translate (rotate leg (* pi 1.5)) (c xoffset yoffset))))))))
 
+(defmethod compute-design ((font font) (shape (eql :semiflat)))
+  (with-slots ((sld staff-line-distance) stem-thickness) font
+    (flet ((c (x y) (complex x y)))
+      (let* ((outer (xyscale (translate (rotate +half-circle+ pi) #c(-0.5 0))
+			     (* 1 sld) (* 1 sld)))
+	     ;; FIXME: 1.2 here (and in the :sesquiflat glyph, below)
+	     ;; represents the difference in width between the
+	     ;; :semiflat bulge and the regular :flat bulge.  Find a
+	     ;; way to share code between the glyphs.
+	     (inner (xyscale (translate (rotate +half-circle+ pi) #c(-0.6 0))
+			     (* 0.75 sld) (* (/ 0.75 1.2) sld)))
+	     (middle (mf (climi::path-end outer) -- (climi::path-end inner)))
+	     (finish (mf (climi::path-start inner) -- (climi::path-start outer)))
+	     (combined (climi::close-path
+			(reduce #'clim:region-union
+				(list outer middle (climi::reverse-path inner) finish)))))
+	(clim:region-union (translate (rotate (slant combined 0.6) (- (/ pi 2)))
+				      (c (round (- (* -0.2 sld) stem-thickness)) (* -0.5 sld)))
+			   (with-pen (scale +razor+ stem-thickness)
+			     (draw-path (mf (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness))
+					       (* 1.5 sld))
+					    --
+					    (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness))
+					       (* -0.5 sld))))))))))
+
 (defmethod compute-design ((font font) (shape (eql :flat)))
   (with-slots ((sld staff-line-distance) stem-thickness) font
     (flet ((c (x y) (complex x y)))
       (let* ((outer (xyscale (translate +half-circle+ #c(-0.5 0))
 			     sld (* 1.2 sld)))
 	     (inner (scale (translate +half-circle+ #c(-0.6 0))
-			   (* 0.8 sld)))
+			   (* 0.75 sld)))
 	     (middle (mf (climi::path-end outer) -- (climi::path-end inner)))
 	     (finish (mf (climi::path-start inner) -- (climi::path-start outer)))
 	     (combined (climi::close-path
@@ -1096,6 +1223,38 @@
 					    (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness))
 					       (* -0.5 sld))))))))))
 
+(defmethod compute-design ((font font) (shape (eql :sesquiflat)))
+  (with-slots ((sld staff-line-distance) stem-thickness) font
+    (flet ((c (x y) (complex x y)))
+      (let* ((outer (xyscale (translate (rotate +half-circle+ pi) #c(-0.5 0))
+			     (* 1 sld) (* 1 sld)))
+	     (inner (xyscale (translate (rotate +half-circle+ pi) #c(-0.6 0))
+			     (* 0.75 sld) (* (/ 0.75 1.2) sld)))
+	     (middle (mf (climi::path-end outer) -- (climi::path-end inner)))
+	     (finish (mf (climi::path-start inner) -- (climi::path-start outer)))
+	     (combined (climi::close-path
+			(reduce #'clim:region-union
+				(list outer middle (climi::reverse-path inner) finish))))
+	     (outer1 (xyscale (translate +half-circle+ #c(-0.5 0))
+			     sld (* 1.2 sld)))
+	     (inner1 (scale (translate +half-circle+ #c(-0.6 0))
+			   (* 0.75 sld)))
+	     (middle1 (mf (climi::path-end outer1) -- (climi::path-end inner1)))
+	     (finish1 (mf (climi::path-start inner1) -- (climi::path-start outer1)))
+	     (combined1 (climi::close-path
+			 (reduce #'clim:region-union
+				 (list outer1 middle1 (climi::reverse-path inner1) finish1)))))
+	(clim:region-union (clim:region-union (translate (rotate (slant combined (* 0.6 1.2)) (- (/ pi 2)))
+							 (c (round (- (* -0.2 sld) stem-thickness)) (* -0.5 sld)))
+					      (translate (rotate (slant combined1 -0.6) (- (/ pi 2)))
+							 (c (round (* -0.2 sld)) (* -0.5 sld))))
+			   (with-pen (scale +razor+ stem-thickness)
+			     (draw-path (mf (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness))
+					       (* 1.5 sld))
+					    --
+					    (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness))
+					       (* -0.5 sld))))))))))
+
 (defmethod compute-design ((font font) (shape (eql :double-flat)))
   (with-slots ((sld staff-line-distance) stem-thickness) font
     (flet ((c (x y) (complex x y)))



From mjonsson at common-lisp.net  Thu Jun 28 12:58:17 2007
From: mjonsson at common-lisp.net (mjonsson)
Date: Thu, 28 Jun 2007 08:58:17 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070628125817.902531A0A2@common-lisp.net>

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

Modified Files:
	play.lisp 
Log Message:
Fixed redundancies in play.lisp pointed out by Stas Boukarev

--- /project/gsharp/cvsroot/gsharp/play.lisp	2007/06/19 10:01:37	1.8
+++ /project/gsharp/cvsroot/gsharp/play.lisp	2007/06/28 12:58:17	1.9
@@ -1,5 +1,9 @@
 (in-package :gsharp-play)
 
+(defparameter *midi-temp-file* "/tmp/timidity.mid")
+(defparameter *midi-player* "timidity")
+(defparameter *midi-player-arguments* '())
+
 (defvar *tuning*)
 (defvar *tempo*)
 
@@ -73,6 +77,28 @@
 		      (incf time (* *tempo* duration))))
 		  (bars slice) durations))))
 
+(defun play-tracks (tracks)
+  (let ((midifile (make-instance 'midifile
+		     :format 1
+		     :division 25
+		     :tracks tracks)))
+    (write-midi-file midifile *midi-temp-file*)
+    #+cmu
+    (ext:run-program *midi-player*
+                     (append *midi-player-arguments*
+                             (list *midi-temp-file*)))
+    #+sbcl
+    (sb-ext:run-program *midi-player*
+                        (append *midi-player-arguments*
+                                (list *midi-temp-file*))
+                        :search t)
+    #+clisp
+    (ext:run-program *midi-player*
+                     :arguments (append *midi-player-arguments*
+                                        (list *midi-temp-file*)))
+    #-(or cmu sbcl clisp)
+    (error "write compatibility layer for RUN-PROGRAM")))
+
 (defun play-segment (segment)
   (let* ((slices (mapcar #'body (layers segment)))
 	 (durations (measure-durations slices))
@@ -80,31 +106,13 @@
          (*tuning* (gsharp-buffer:tuning segment))
 	 (tracks (loop for slice in slices
 		       for i from 0
-		       collect (track-from-slice slice i durations)))
-	 (midifile (make-instance 'midifile
-		     :format 1
-		     :division 25
-		     :tracks tracks)))
-    (write-midi-file midifile "/tmp/test.mid")
-    #+cmu
-    (ext:run-program "timidity" '("/tmp/test.mid"))
-    #+sbcl
-    (sb-ext:run-program "timidity" '("/tmp/test.mid") :search t)
-    #-(or cmu sbcl)
-    (error "write compatibility layer for RUN-PROGRAM")))
+		       collect (track-from-slice slice i durations))))
+    (play-tracks tracks)))
 
 (defun play-layer (layer)
   (let* ((slice (body layer))
 	 (durations (measure-durations (list slice)))
-	 (tracks (list (track-from-slice slice 0 durations)))
-	 (midifile (make-instance 'midifile
-		     :format 1
-		     :division 25
-		     :tracks tracks)))
-    (write-midi-file midifile "/tmp/test.mid")
-    #+cmu
-    (ext:run-program "timidity" '("/tmp/test.mid"))
-    #+sbcl
-    (sb-ext:run-program "timidity" '("/tmp/test.mid") :search t)
-    #-(or cmu sbcl)
-    (error "write compatibility layer for RUN-PROGRAM")))
+         (*tempo* (tempo (segment layer)))
+         (*tuning* (gsharp-buffer:tuning (segment layer)))
+	 (tracks (list (track-from-slice slice 0 durations))))
+    (play-tracks tracks)))
\ No newline at end of file



From mjonsson at common-lisp.net  Thu Jun 28 13:56:56 2007
From: mjonsson at common-lisp.net (mjonsson)
Date: Thu, 28 Jun 2007 09:56:56 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070628135656.D877343222@common-lisp.net>

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



From mjonsson at common-lisp.net  Thu Jun 28 14:36:14 2007
From: mjonsson at common-lisp.net (mjonsson)
Date: Thu, 28 Jun 2007 10:36:14 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp
Message-ID: <20070628143614.29E4F5903E@common-lisp.net>

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

Modified Files:
	modes.lisp 
Log Message:
mcclim bug workaround in key bindings for microsharper/microflatter

--- /project/gsharp/cvsroot/gsharp/modes.lisp	2007/06/28 13:56:53	1.25
+++ /project/gsharp/cvsroot/gsharp/modes.lisp	2007/06/28 14:36:14	1.26
@@ -84,8 +84,10 @@
 
 (set-key 'com-sharper 'cluster-table '((#\#)))
 (set-key 'com-flatter 'cluster-table '(#\@))
-(set-key 'com-microsharper 'cluster-table '((#\# :control :shift)))
-(set-key 'com-microflatter 'cluster-table '((#\@ :control :shift)))
+(set-key 'com-microsharper 'cluster-table '((#\# :control)))
+(set-key 'com-microsharper 'cluster-table '((#\# :control :shift))) ;; mcclim bug workaround
+(set-key 'com-microflatter 'cluster-table '((#\@ :control)))
+(set-key 'com-microflatter 'cluster-table '((#\@ :control :shift))) ;; mcclim bug workaround
 (set-key 'com-add-note-c 'cluster-table '(#\C))
 (set-key 'com-add-note-d 'cluster-table '(#\D))
 (set-key 'com-add-note-e 'cluster-table '(#\E))



From rstrandh at common-lisp.net  Sat Jun 30 14:15:26 2007
From: rstrandh at common-lisp.net (rstrandh)
Date: Sat, 30 Jun 2007 10:15:26 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp/Doc
Message-ID: <20070630141526.72C3D4B022@common-lisp.net>

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

Modified Files:
	accidentals.tex 
Log Message:
Fixed some unfortunate choice of wording.


--- /project/gsharp/cvsroot/gsharp/Doc/accidentals.tex	2004/02/16 15:46:22	1.1.1.1
+++ /project/gsharp/cvsroot/gsharp/Doc/accidentals.tex	2007/06/30 14:15:26	1.2
@@ -3,14 +3,14 @@
 The rules of Ross essentially boil down to the following: 
 
 \begin{itemize}
-\item If there are no suspended notes with accidentals on the right
-  side of the stem, place all the accidentals in the order of the
+\item If there are no suspended notes on the right side of the stem
+  that have accidentals, place all the accidentals in the order of the
   topmost one that can be placed closest to the stem.
-\item If there are suspended notes with accidentals on the right side
-  of the stem (stem is up and there is an interval of a second), start
-  by placing the accidental of the topmost suspended note with an
-  accidental as close as possible to the stem, then place the other
-  notes according to the previous rule.
+\item If there is at least one suspended note on the right side of the
+  stem (stem is up and there is an interval of a second) with an
+  accidental, start by placing the accidental of the topmost suspended
+  note with an accidental as close as possible to the stem, then place
+  the other notes according to the previous rule.
 \end{itemize}
 
 To implement this algorithm, we keep a table of smallest distances



From mjonsson at common-lisp.net  Sat Jun 30 16:50:34 2007
From: mjonsson at common-lisp.net (mjonsson)
Date: Sat, 30 Jun 2007 12:50:34 -0400 (EDT)
Subject: [gsharp-cvs] CVS gsharp/Doc
Message-ID: <20070630165034.840342D168@common-lisp.net>

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

Modified Files:
	linebreak.tex plans.tex 
Log Message:
Fixed a few typos.

--- /project/gsharp/cvsroot/gsharp/Doc/linebreak.tex	2004/02/16 15:46:28	1.1.1.1
+++ /project/gsharp/cvsroot/gsharp/Doc/linebreak.tex	2007/06/30 16:50:34	1.2
@@ -85,7 +85,7 @@
 Recomputing the measures of a segment is a complicated operation.
 First music events that occur simultaneously must be grouped together
 into \emph{timelines}.  Then the spacing between timelines must be
-computed.  Such spacing is a monotonically increason function of the
+computed.  Such spacing is a monotonically increasing function of the
 temporal distance, but the function is usually not linear. 
 
 Based on the spacing between timelines, measures are then grouped into
@@ -134,10 +134,10 @@
 The \emph{natural width} of a timeline with temporal distance $d$ to
 the next timeline (or to the end of the measure) in a line on which
 the smallest temporal distance is $d_{min}$ is defined as 
-$s_{min} (d / d_min) ^ k$.
+$s_{min} (d / d_{min}) ^ k$.
 
 The \emph{natural width} of a measure is the sum of the natural widths
-of each timeline of the measure plus $s_min$.  The reason for the
+of each timeline of the measure plus $s_{min}$.  The reason for the
 additional term is that this much space must be inserted before the
 first timeline of the measure.
 
@@ -178,7 +178,7 @@
 
 The advantage of using normalized widths is twofold.  First, the
 normalized with of a measure is independent of $d_{min}$, so it is a
-property intrinsic to the measure and not dependendt on the line on
+property intrinsic to the measure and not dependent on the line on
 which it is located.  This information can be computed once and for
 all when a measure is recomputed by redisplay.  Second, as redisplay
 accumulates measures into potential lines, the sum of the normalized
@@ -191,7 +191,7 @@
 If modification information is kept on a segment by segment basis,
 we typically only have to recompute the measures within a segment at
 each invocation of redisplay.  Thus, even for arbitrarily large
-scores, we are able to obtain a sequence of mesures each with its
+scores, we are able to obtain a sequence of measures each with its
 normalized width and its $d_{min}$ in a time proportional to the
 size of a segment. 
 
@@ -212,7 +212,7 @@
 available for music material and compute the penalty as the maximum of
 the compression factor and the stretch factor. 
 
-To compute the natural hieght of a page, several methods can be used.
+To compute the natural height of a page, several methods can be used.
 The simplest is to consider a line to take up space proportional to
 the number of staves, lyric lines and other components, and to add the
 space taken up by each line to obtain the natural height of the page. 
@@ -350,7 +350,7 @@
 operations.  For all simple operations such as insertion or deletion
 of a single note, our computation is very fast.
 
-\section{Conclusions and Futur Work}
+\section{Conclusions and Future Work}
 
 We have described an incremental method for computing optimal line
 breaks in an interactive editor for musical scores.  While it should
--- /project/gsharp/cvsroot/gsharp/Doc/plans.tex	2006/08/02 02:47:17	1.4
+++ /project/gsharp/cvsroot/gsharp/Doc/plans.tex	2007/06/30 16:50:34	1.5
@@ -60,7 +60,7 @@
 upper voice and (say) the lower staff line for the lower voice rather
 than, as now, having all rests inserted by default on the middle staff
 line.  It would be nice if a layer had a default staff line for rests
-so that changing hte layer automatically changes the default staff
+so that changing the layer automatically changes the default staff
 line for rests.  
 
 \subsection{Default stem direction for a layer}
@@ -249,4 +249,4 @@
 \item remove dead code
 \item remove reasons for remarks such as XXX:, FIXME, etc, or at least
   put a name in their place
-\end{itemize}
\ No newline at end of file
+\end{itemize}