Index: buffer.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/buffer.lisp,v
retrieving revision 1.37
diff -u -r1.37 buffer.lisp
--- buffer.lisp	2 Mar 2006 09:29:44 -0000	1.37
+++ buffer.lisp	19 Jun 2006 13:41:13 -0000
@@ -115,7 +115,8 @@
   ((print-character :allocation :class :initform #\=)
    (clef :accessor clef :initarg :clef :initform (make-clef :treble))
    (%keysig :accessor keysig :initarg :keysig
-	    :initform (make-array 7 :initial-element :natural))))
+	    :initform (make-array 7 :initial-element :natural))
+   (key-signatures :accessor key-signatures :initform nil)))
 	   
 (defmethod initialize-instance :after ((obj fiveline-staff) &rest args)
   (declare (ignore args))
Index: cursor.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/cursor.lisp,v
retrieving revision 1.2
diff -u -r1.2 cursor.lisp
--- cursor.lisp	23 Jul 2004 16:51:16 -0000	1.2
+++ cursor.lisp	19 Jun 2006 13:41:13 -0000
@@ -166,6 +166,12 @@
 	(when (> (pos cursor) position)
 	  (incf (pos cursor)))))
 
+(defmethod add-element :after 
+    ((keysig gsharp-buffer::key-signature) bar position)
+  (setf (gsharp-buffer::key-signatures (staff keysig))
+        ;; FIXME: unordered
+        (cons keysig (gsharp-buffer::key-signatures (staff keysig)))))
+
 (defmethod remove-element :before ((element element))
   (let ((elemno (number element)))
     (loop for cursor in (cursors (bar element)) do
Index: drawing.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/drawing.lisp,v
retrieving revision 1.70
diff -u -r1.70 drawing.lisp
--- drawing.lisp	14 Jun 2006 05:03:14 -0000	1.70
+++ drawing.lisp	19 Jun 2006 13:41:13 -0000
@@ -150,6 +150,31 @@
       (score-pane:staff-step 5)
       (score-pane:staff-step 2)))
 
+(defmethod right-bulge ((keysig gsharp-buffer::key-signature) pane)
+  ;; FIXME: shares much code with DRAW-ELEMENT (KEY-SIGNATURE).
+  (let ((old-keysig (keysig keysig)))
+    (let ((bulge 0))
+      (loop with advance = 0
+            for pitch in '(6 2 5 1 4 0 3)
+            when (and (eq (aref (alterations old-keysig) pitch) :flat)
+                      (not (eq (aref (alterations keysig) pitch) 
+                               :flat)))
+            do (incf advance (score-pane:staff-step 2))
+            finally (incf bulge (if (= advance 0) 0 (+ advance (score-pane:staff-step 2)))))
+      (loop with advance = 0
+            for pitch in '(3 0 4 1 5 2 6)
+            when (and (eq (aref (alterations old-keysig) pitch) :sharp)
+                      (not (eq (aref (alterations keysig) pitch) :sharp)))
+            do (incf advance (score-pane:staff-step 2))
+            finally (incf bulge (if (= advance 0) 0 (+ advance (score-pane:staff-step 2)))))
+      (loop for pitch in '(6 2 5 1 4 0 3)
+            while (eq (aref (alterations keysig) pitch) :flat)
+            do (incf bulge (score-pane:staff-step 2)))
+      (loop for pitch in '(3 0 4 1 5 2 6)
+            while (eq (aref (alterations keysig) pitch) :sharp)
+            do (incf bulge (score-pane:staff-step 2.5)))
+      bulge)))
+
 ;;; As it turns out, the spacing algorithm would be very complicated
 ;;; if we were to take into account exactly how elements with
 ;;; arbitrarily many timelines between them might influence the
@@ -496,6 +524,9 @@
 		     (incf yy (+ 20 (* 70 (length staves))))))))
 	 buffer)))))
 
+(define-added-mixin xelement () element
+  ((final-absolute-xoffset :accessor final-absolute-element-xoffset)))
+
 (define-added-mixin velement () melody-element
   (;; the position, in staff steps, of the end of the stem
    ;; that is not attached to a note, independent of the
@@ -509,11 +540,10 @@
    (top-note-staff-yoffset :accessor top-note-staff-yoffset)
    ;; the yoffset of the staff that contains the bottom note of
    ;; the element
-   (bot-note-staff-yoffset :accessor bot-note-staff-yoffset)
-   (final-absolute-xoffset :accessor final-absolute-element-xoffset)))
+   (bot-note-staff-yoffset :accessor bot-note-staff-yoffset)))
 
 (define-added-mixin welement () lyrics-element
-  ((final-absolute-xoffset :accessor final-absolute-element-xoffset)))
+  ())
 
 ;;; Compute and store several important pieces of information
 ;;; about an element:
@@ -600,6 +630,11 @@
 	  notes))
 
 (defun draw-beam-group (pane elements)
+  (let ((e (car elements)))
+    (when (typep e 'gsharp-buffer::key-signature)
+      (assert (null (cdr elements)))
+      (return-from draw-beam-group
+        (draw-element pane e (final-absolute-element-xoffset e)))))
   (mapc #'compute-top-bot-yoffset elements)
   (if (null (cdr elements))
       (let ((element (car elements)))
@@ -885,3 +920,46 @@
       (with-text-family (pane :serif)
 	(draw-text* pane (map 'string 'code-char (text element))
 		    x 0 :align-x :center)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Key signature element
+
+(defmethod draw-element (pane (keysig key-signature) &optional flags)
+  (let ((staff (staff keysig))
+        (old-keysig (keysig keysig))
+        (x (final-absolute-element-xoffset keysig)))
+    (score-pane:with-vertical-score-position (pane (staff-yoffset staff))
+      (let ((yoffset (b-position (clef staff))))
+        (loop with advance = 0
+              for pitch in '(6 2 5 1 4 0 3)
+              for line in '(0 3 -1 2 -2 1 -3)
+              when (and (eq (aref (alterations old-keysig) pitch) :flat)
+                        (not (eq (aref (alterations keysig) pitch) 
+                                 :flat)))
+              do (score-pane:draw-accidental 
+                  pane :natural (+ x advance) (+ line yoffset))
+              and do (incf advance (score-pane:staff-step 2))
+              finally (incf x (if (= advance 0) 0 (+ advance (score-pane:staff-step 2))))))
+      (let ((yoffset (f-position (clef staff))))
+        (loop with advance = 0
+              for pitch in '(3 0 4 1 5 2 6)
+              for line in '(0 -3 1 -2 -5 -1 -4)
+              when (and (eq (aref (alterations old-keysig) pitch) :sharp)
+                        (not (eq (aref (alterations keysig) pitch) :sharp)))
+              do (score-pane:draw-accidental pane :natural (+ x advance) (+ line yoffset))
+              and do (incf advance (score-pane:staff-step 2))
+              finally (incf x (if (= advance 0) 0 (+ advance (score-pane:staff-step 2))))))
+
+      (let ((yoffset (b-position (clef staff))))
+        (loop for pitch in '(6 2 5 1 4 0 3)
+              for line in '(0 3 -1 2 -2 1 -3)
+              for x from x by (score-pane:staff-step 2)
+              while (eq (aref (alterations keysig) pitch) :flat)
+              do (score-pane:draw-accidental pane :flat x (+ line yoffset))))
+      (let ((yoffset (f-position (clef staff))))
+        (loop for pitch in '(3 0 4 1 5 2 6)
+              for line in '(0 -3 1 -2 -5 -1 -4)
+              for x from x by (score-pane:staff-step 2.5)
+              while (eq (aref (alterations keysig) pitch) :sharp)
+              do (score-pane:draw-accidental pane :sharp x (+ line yoffset)))))))
Index: gui.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/gui.lisp,v
retrieving revision 1.68
diff -u -r1.68 gui.lisp
--- gui.lisp	17 Jun 2006 19:15:02 -0000	1.68
+++ gui.lisp	19 Jun 2006 13:41:13 -0000
@@ -591,7 +594,7 @@
 	 (staff (car (staves (layer (slice (bar cluster))))))
 	 (note (make-note pitch staff
 		 :head (notehead state)
-		 :accidentals (aref (alterations (keysig staff)) (mod pitch 7))
+		 :accidentals (aref (alterations (keysig (current-cursor))) (mod pitch 7))
 		 :dots (dots state))))
     (setf *current-cluster* cluster
 	  *current-note* note)
@@ -858,6 +861,92 @@
       (unless *current-note*
         (com-erase-element 1)))))
 
+(defun insert-keysig ()
+  (let* ((state (input-state *application-frame*))
+	 (cursor (current-cursor))
+         (staff (car (staves (layer cursor))))
+	 (keysig (if (keysig cursor)
+                     (gsharp-buffer::make-key-signature 
+                      staff :alterations (copy-seq (alterations (keysig cursor))))
+                     (gsharp-buffer::make-key-signature staff))))
+    ;; FIXME: should only invalidate elements temporally after the
+    ;; cursor.
+    (gsharp-measure::invalidate-everything-using-staff (current-buffer *application-frame*) staff)
+    (insert-element keysig cursor)
+    (forward-element cursor)
+    keysig))
+
+(define-gsharp-command com-insert-keysig ()
+  (insert-keysig))
+
+(defmethod remove-element :before ((keysig gsharp-buffer::key-signature))
+  (let ((staff (staff keysig)))
+    (setf (gsharp-buffer::key-signatures staff)
+          (remove keysig (gsharp-buffer::key-signatures staff)))
+    (gsharp-measure::invalidate-everything-using-staff (current-buffer *application-frame*) staff)))
+
+;;; FIXME: this function does not work for finding a key signature in
+;;; a different layer (but on the same staff).  This will bite in
+;;; polyphonic music with key signature changes (e.g. Piano music)
+(defun %keysig (staff key-signatures bar bars element-or-nil)
+  ;; common case
+  (when (null key-signatures)
+    (return-from %keysig (keysig staff)))
+  ;; earlier in the same bar?
+  (let ((k nil))
+    (dolist (e (elements bar) (when k (return-from %keysig k)))
+      (when (eq e element-or-nil)
+        (if k 
+            (return-from %keysig k)
+            (return nil)))
+      (when (and (typep e 'gsharp-buffer::key-signature)
+                 (eq (staff e) staff))
+        (setq k e))))
+  ;; must be an earlier bar.
+  (let ((bars (nreverse (loop for b in bars until (eq b bar) collect b))))
+    (dolist (b bars (keysig staff))
+      (when (find b key-signatures :key #'bar)
+        (dolist (e (reverse (elements b)) (error "inconsistency"))
+          (when (and (typep e 'key-signature)
+                     (eq (staff e) staff))
+            (return-from %keysig e)))))))
+
+(defmethod keysig ((cursor gsharp-cursor))
+  ;; FIXME: not just a cursor but _the_ cursor (i.e. in a given staff)
+  ;; otherwise the operation for getting the staff [(CAR (STAVES
+  ;; (LAYER CURSOR)))] need not return the staff that we're interested
+  ;; in.
+  (assert (eq cursor (current-cursor)))
+  (let* ((staff (car (staves (layer cursor))))
+         (key-signatures (gsharp-buffer::key-signatures staff))
+         (bar (bar cursor))
+         (slice (slice bar))
+         (bars (bars slice))
+         (element-or-nil (cursor-element cursor)))
+    (%keysig staff key-signatures bar bars element-or-nil)))
+
+(defmethod keysig ((note note))
+  (let* ((staff (staff note))
+         (key-signatures (gsharp-buffer::key-signatures staff))
+         (bar (bar (cluster note)))
+         (slice (slice bar))
+         (bars (bars slice))
+         (element-or-nil (cluster note)))
+    (%keysig staff key-signatures bar bars element-or-nil)))
+
+(defmethod keysig ((cluster cluster))
+  (error "Called ~S (a staff-scope operation) on an element with no ~
+          associated staff: ~S" 
+         'keysig cluster))
+
+(defmethod keysig ((element element))
+  (let* ((staff (staff element))
+         (key-signatures (gsharp-buffer::key-signatures staff))
+         (bar (bar element))
+         (slice (slice bar))
+         (bars (bars slice)))
+    (%keysig staff key-signatures bar bars element)))
+
 (define-gsharp-command com-tie-note-left ()
   (let ((note (cur-note)))
     (when note
@@ -1188,10 +1277,10 @@
     (remove-staff-from-layer staff layer)))
 
 (define-gsharp-command com-more-sharps ()
-  (more-sharps (keysig (car (staves (layer (current-cursor)))))))
+  (more-sharps (keysig (current-cursor))))
 
 (define-gsharp-command com-more-flats ()
-  (more-flats  (keysig (car (staves (layer (current-cursor)))))))
+  (more-flats (keysig (current-cursor))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
Index: measure.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/measure.lisp,v
retrieving revision 1.30
diff -u -r1.30 measure.lisp
--- measure.lisp	13 Jun 2006 01:18:10 -0000	1.30
+++ measure.lisp	19 Jun 2006 13:41:13 -0000
@@ -224,7 +224,7 @@
   (loop for note in group do
 	(setf (final-accidental note)
 	      (if (eq (accidentals note)
-		      (aref (alterations (keysig (staff note))) (mod (pitch note) 7)))
+		      (aref (alterations (keysig note)) (mod (pitch note) 7)))
 		  nil
 		  (accidentals note)))))
 
Index: modes.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/modes.lisp,v
retrieving revision 1.18
diff -u -r1.18 modes.lisp
--- modes.lisp	14 Jun 2006 19:20:41 -0000	1.18
+++ modes.lisp	19 Jun 2006 13:41:13 -0000
@@ -44,6 +44,8 @@
 (set-key 'com-insert-note-g 'melody-table '(#\g))
 (set-key 'com-insert-rest 'melody-table '((#\,)))
 (set-key 'com-insert-empty-cluster 'melody-table '((#\Space)))
+(set-key 'com-insert-keysig 'melody-table '(#\K))
+
 (set-key 'com-more-sharps 'melody-table '((#\# :meta)))
 (set-key 'com-more-sharps 'melody-table '((#\# :meta :shift)))
 (set-key 'com-more-flats 'melody-table '((#\@ :meta :shift)))
