Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv25231

Modified Files: buffer.lisp cursor.lisp drawing.lisp gui.lisp melody.lisp packages.lisp score-pane.lisp Log Message: Basic time signature support. Only some sigs supported and spacing is basic. Key and time signatures now share a staffwise-elements slot in the stave.

--- /project/gsharp/cvsroot/gsharp/buffer.lisp 2008/02/09 16:58:35 1.59 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2009/04/20 15:04:47 1.60 @@ -208,8 +208,8 @@ ;; there might be more than one key signature in the bar, ;; and they might have changed their relative order as a ;; result of the edit. - (setf (key-signatures staff) - (sort (key-signatures staff) + (setf (staffwise-elements staff) + (sort (staffwise-elements staff) (lambda (x y) (gsharp::starts-before-p x (bar y) y))))))))))

(defmethod add-element :after ((element element) (bar bar) position) --- /project/gsharp/cvsroot/gsharp/cursor.lisp 2008/11/19 16:05:13 1.8 +++ /project/gsharp/cvsroot/gsharp/cursor.lisp 2009/04/20 15:04:47 1.9 @@ -166,10 +166,10 @@ (when (> (pos cursor) position) (incf (pos cursor)))))

-(defmethod add-element :after ((keysig key-signature) bar position) - (let ((staff (staff keysig))) - (setf (key-signatures staff) - (merge 'list (list keysig) (key-signatures staff) +(defmethod add-element :after ((element staffwise-element) bar position) + (let ((staff (staff element))) + (setf (staffwise-elements staff) + (merge 'list (list element) (staffwise-elements staff) (lambda (x y) (gsharp::starts-before-p x (bar y) y))))))

(defmethod remove-element :before ((element element) (bar cbar)) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/11/19 16:05:13 1.87 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2009/04/20 15:04:47 1.88 @@ -162,6 +162,13 @@ (score-pane:staff-step 5) (score-pane:staff-step 2)))

+(defmethod right-bulge ((timesig time-signature) pane) + ;; FIXME: this is probably wrong; it should either compute the bulge + ;; properly, or else approximate using (length - 0.5) * + ;; typical-width-of-component + (* (length (time-signature-components timesig)) + (score-pane:staff-step 5))) + (defmethod right-bulge ((keysig key-signature) pane) ;; FIXME: shares much code with DRAW-ELEMENT (KEY-SIGNATURE). (let ((old-keysig (keysig keysig))) @@ -697,7 +704,7 @@

(defun draw-beam-group (pane elements) (let ((e (car elements))) - (when (typep e 'key-signature) + (when (typep e 'staffwise-element) (assert (null (cdr elements))) (return-from draw-beam-group (draw-element pane e (final-absolute-element-xoffset e))))) @@ -1115,3 +1122,15 @@ 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))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Time signature element + +(defmethod draw-element (pane (timesig time-signature) &optional (flags t)) + (declare (ignore flags)) + (let ((staff (staff timesig)) + (x (final-absolute-element-xoffset timesig))) + (score-pane:with-vertical-score-position (pane (staff-yoffset staff)) + (dolist (component (time-signature-components timesig)) + (score-pane:draw-time-signature-component pane component x))))) \ No newline at end of file --- /project/gsharp/cvsroot/gsharp/gui.lisp 2008/11/19 16:05:13 1.96 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2009/04/20 15:04:47 1.97 @@ -955,10 +955,28 @@ (define-gsharp-command com-insert-keysig () (insert-keysig))

-(defmethod remove-element :before ((keysig key-signature) (bar bar)) - (let ((staff (staff keysig))) - (setf (key-signatures staff) - (remove keysig (key-signatures staff))) +(defun insert-timesig (numerator denominator) + (let* ((cursor (current-cursor)) + (staff (car (staves (layer cursor)))) + (timesig (make-instance 'time-signature + :staff staff + :components + (list (if denominator + (cons numerator denominator) + numerator))))) + (insert-element timesig cursor) + (forward-element cursor) + timesig)) + +(define-gsharp-command (com-insert-timesig :name t) + ((numerator '(integer 1 8) :prompt "Numerator") + (denominator '(integer 1 8) :prompt "Denominator")) + (insert-timesig numerator denominator)) + +(defmethod remove-element :before ((element staffwise-element) (bar bar)) + (let ((staff (staff element))) + (setf (staffwise-elements staff) + (remove element (staffwise-elements staff))) (gsharp-measure::invalidate-everything-using-staff (current-buffer) staff)))

;;; FIXME: this isn't quite right (argh) for the case of two --- /project/gsharp/cvsroot/gsharp/melody.lisp 2007/10/22 11:45:37 1.1 +++ /project/gsharp/cvsroot/gsharp/melody.lisp 2009/04/20 15:04:47 1.2 @@ -78,8 +78,17 @@ ((clef :accessor clef :initarg :clef :initform (make-clef :treble)) (%keysig :accessor keysig :initarg :keysig :initform (make-array 7 :initial-element :natural)) - (key-signatures :accessor key-signatures :initform nil))) - + (staffwise-elements :accessor staffwise-elements :initform nil))) + +(defgeneric key-signatures (staff) + (:method ((s fiveline-staff)) + (remove-if #'(lambda (x) (not (typep x 'key-signature))) + (staffwise-elements s)))) +(defgeneric time-signatures (staff) + (:method ((s fiveline-staff)) + (remove-if #'(lambda (x) (not (typep x 'time-signature))) + (staffwise-elements s)))) + (defmethod initialize-instance :after ((obj fiveline-staff) &rest args) (declare (ignore args)) (with-slots (%keysig) obj @@ -309,9 +318,13 @@ (:documentation "make the key signature N alterations flatter by removing some sharps and/or adding some flats"))

-(defclass key-signature (element) - ((%staff :initarg :staff :reader staff) - (%alterations :initform (make-array 7 :initial-element :natural) +(defclass staffwise-element (element) + ((%staff :initarg :staff :reader staff))) +(defmethod slots-to-be-saved append ((s-e staffwise-element)) + '(%staff)) + +(defclass key-signature (staffwise-element) + ((%alterations :initform (make-array 7 :initial-element :natural) :initarg :alterations :reader alterations)))

(defun make-key-signature (staff &rest args &key alterations) @@ -320,7 +333,7 @@ (apply #'make-instance 'key-signature :staff staff args))

(defmethod slots-to-be-saved append ((k key-signature)) - '(%staff %alterations)) + '(%alterations))

(defmethod more-sharps ((sig key-signature) &optional (n 1)) (let ((alt (alterations sig))) @@ -357,6 +370,20 @@ ((eq (aref alt 4) :natural) (setf (aref alt 4) :flat)) ((eq (aref alt 0) :natural) (setf (aref alt 0) :flat)) ((eq (aref alt 3) :natural) (setf (aref alt 3) :flat)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Time signature +;; * no make function (no type checking) +;; * slots-to-be-saved only 'cos it's there +;; * What accessors do we need (if any)? +;; * Should I copy the (keysig) functionality from gui.lisp? + +(defclass time-signature (staffwise-element) + ((%components :initarg :components :reader time-signature-components + :initform nil))) +(defmethod slots-to-be-saved append ((t-s time-signature)) + '(%components))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/gsharp/cvsroot/gsharp/packages.lisp 2008/11/19 16:05:13 1.67 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2009/04/20 15:04:47 1.68 @@ -41,6 +41,7 @@ #:draw-stem #:draw-right-stem #:draw-left-stem #:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step #:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot + #:draw-time-signature-component #:draw-flags-up #:draw-flags-down #:draw-tie-up #:draw-tie-down #:with-score-pane #:with-vertical-score-position @@ -55,7 +56,8 @@ (:shadow #:rest) (:export #:clef #:name #:lineno #:make-clef #:staff #:fiveline-staff #:make-fiveline-staff - #:key-signatures + #:key-signatures #:time-signatures + #:staffwise-elements #:lyrics-staff #:make-lyrics-staff #:gsharp-condition #:pitch #:accidentals #:dots #:note #:make-note @@ -91,7 +93,9 @@ #:clef #:f-position #:b-position #:bottom-line #:keysig #:staff-pos #:xoffset #:read-everything #:read-buffer-from-stream + #:staffwise-element #:key-signature #:make-key-signature + #:time-signature #:time-signature-components #:alterations #:more-sharps #:more-flats #:line-width #:lines-per-page #:min-width #:spacing-style #:right-edge #:left-offset --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2007/09/18 21:19:03 1.39 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2009/04/20 15:04:47 1.40 @@ -170,6 +170,35 @@ (with-output-as-presentation (stream object 'clef) (draw-clef stream name x staff-step)))

+;;;;;;;;;;;;;;;;;; time signature + +(defun draw-time-signature-component (stream component x) + (flet ((component-name (c) + (ecase c + (1 :time-signature-1) + (2 :time-signature-2) + (3 :time-signature-3) + (4 :time-signature-4) + (5 :time-signature-5) + (6 :time-signature-6) + (7 :time-signature-7) + (8 :time-signature-8)))) + (etypecase component + ((integer 1 8) + (let* ((design (sdl::ensure-design *font* (component-name component)))) + (sdl::draw-shape stream *font* design x (staff-step -2)) + (bounding-rectangle-width design))) + ((cons (integer 1 8) (integer 1 8)) + (destructuring-bind (num . den) component + (let* ((num-name (component-name num)) + (den-name (component-name den)) + (ndesign (sdl::ensure-design *font* num-name)) + (ddesign (sdl::ensure-design *font* den-name))) + (sdl::draw-shape stream *font* num-name x (staff-step -4)) + (sdl::draw-shape stream *font* den-name x (staff-step 0)) + (max (bounding-rectangle-width ndesign) + (bounding-rectangle-width ddesign)))))))) + ;;;;;;;;;;;;;;;;;; rest

(defun draw-rest (stream duration x staff-step)