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

Modified Files: buffer.lisp cursor.lisp drawing.lisp gui.lisp measure.lisp modes.lisp Log Message: Merge keysigN patch, with all its attendant horribleness.

--- /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/03/02 09:29:44 1.37 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/06/19 17:40:34 1.38 @@ -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)) --- /project/gsharp/cvsroot/gsharp/cursor.lisp 2004/07/23 16:51:16 1.2 +++ /project/gsharp/cvsroot/gsharp/cursor.lisp 2006/06/19 17:40:34 1.3 @@ -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 --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/06/14 05:03:14 1.70 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/06/19 17:40:34 1.71 @@ -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 +521,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 +537,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 +627,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 +917,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))))))) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/06/17 19:15:02 1.68 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/06/19 17:40:34 1.69 @@ -591,7 +591,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 +858,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 +1274,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))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/gsharp/cvsroot/gsharp/measure.lisp 2006/06/13 01:18:10 1.30 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2006/06/19 17:40:34 1.31 @@ -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)))))

--- /project/gsharp/cvsroot/gsharp/modes.lisp 2006/06/14 19:20:41 1.18 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2006/06/19 17:40:34 1.19 @@ -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)))