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

Modified Files: buffer.lisp drawing.lisp gui.lisp measure.lisp modes.lisp packages.lisp Log Message: Work-in-progress hooks for drawing routines, used for now for tenuto and staccato articulation marks.

The quality of the graphical rendering of the marks is not really up to scratch; horizontal placement seems to be off by somewhere between half and one pixel, and of course a note with both marks on at once gets an ugly graphical clash. As I say, "work in progress".

--- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/12/02 05:52:53 1.58 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2008/02/09 16:58:35 1.59 @@ -61,10 +61,11 @@

(defclass element (gsharp-object) ((bar :initform nil :initarg :bar :accessor bar) - (xoffset :initform 0 :initarg :xoffset :accessor xoffset))) + (xoffset :initform 0 :initarg :xoffset :accessor xoffset) + (annotations :initform nil :initarg :annotations :accessor annotations)))

(defmethod slots-to-be-saved append ((e element)) - '(xoffset)) + '(xoffset annotations))

(defmethod duration ((element element)) 0) (defmethod rbeams ((element element)) 0) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/09/18 21:19:03 1.84 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/02/09 16:58:35 1.85 @@ -909,6 +909,60 @@

(defgeneric draw-element (pane element &optional flags))

+(defmethod draw-element :around (pane element &optional flags) + (call-next-method) + (dolist (annotation (annotations element)) + (draw-element-annotation pane element annotation))) + +(defgeneric draw-element-annotation (pane element annotation) + (:method (pane element annotation) + (warn "unknown annotation ~S for ~S" annotation element))) + +;;; FIXME: these methods work and have the right vertical behaviour; +;;; the horizontal centering of the dot and the tenuto mark are all +;;; wrong, sadly. +(defmethod draw-element-annotation + (pane (element cluster) (annotation (eql :staccato))) + (let ((direction (final-stem-direction element)) + (x (final-absolute-element-xoffset element))) + (if (eq direction :up) + (score-pane:with-vertical-score-position (pane (bot-note-staff-yoffset element)) + (score-pane:with-notehead-right-offsets (dx dy) + (score-pane:with-notehead-left-offsets (ddx ddy) + (let ((pos (- (bot-note-pos element) 2))) + (when (and (<= 0 pos) (evenp pos)) + (setq pos (1- pos))) + (score-pane:draw-dot pane (+ x (/ (+ dx ddx) 2)) pos))))) + (score-pane:with-vertical-score-position (pane (top-note-staff-yoffset element)) + (score-pane:with-notehead-right-offsets (dx dy) + (score-pane:with-notehead-left-offsets (ddx ddy) + (let ((pos (+ (top-note-pos element) 2))) + (when (and (<= pos 8) (evenp pos)) + (setq pos (1+ pos))) + (score-pane:draw-dot pane (+ x (/ (+ dx ddx) 2)) pos)))))))) + +(defmethod draw-element-annotation + (pane (element cluster) (annotation (eql :tenuto))) + (let ((direction (final-stem-direction element)) + (x (final-absolute-element-xoffset element))) + (if (eq direction :up) + (score-pane:with-vertical-score-position (pane (bot-note-staff-yoffset element)) + (score-pane:with-notehead-right-offsets (dx dy) + (score-pane:with-notehead-left-offsets (ddx ddy) + (let ((pos (- (bot-note-pos element) 2))) + (when (and (<= 0 pos) (evenp pos)) + (setq pos (1- pos))) + (draw-rectangle* pane (+ x ddx) (1- (score-pane:staff-step (- pos))) + (+ x dx) (1+ (score-pane:staff-step (- pos)))))))) + (score-pane:with-vertical-score-position (pane (top-note-staff-yoffset element)) + (score-pane:with-notehead-right-offsets (dx dy) + (score-pane:with-notehead-left-offsets (ddx ddy) + (let ((pos (+ (bot-note-pos element) 2))) + (when (and (<= pos 8) (evenp pos)) + (setq pos (1+ pos))) + (draw-rectangle* pane (+ x ddx) (1- (score-pane:staff-step (- pos))) + (+ x dx) (1+ (score-pane:staff-step (- pos))))))))))) + (defmethod note-difference ((note1 note) (note2 note)) (- (pitch note1) (pitch note2)))

--- /project/gsharp/cvsroot/gsharp/gui.lisp 2008/01/30 09:59:25 1.93 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2008/02/09 16:58:35 1.94 @@ -754,6 +754,18 @@ (:up :down) (:down :auto))))

+(define-gsharp-command com-toggle-staccato () + (let ((cluster (cur-cluster))) + (if (member :staccato (annotations cluster)) + (setf (annotations cluster) (remove :staccato (annotations cluster))) + (push :staccato (annotations cluster))))) + +(define-gsharp-command com-toggle-tenuto () + (let ((cluster (cur-cluster))) + (if (member :tenuto (annotations cluster)) + (setf (annotations cluster) (remove :tenuto (annotations cluster))) + (push :tenuto (annotations cluster))))) + (define-gsharp-command com-down () (let ((element (cur-element))) (if (typep element 'cluster) --- /project/gsharp/cvsroot/gsharp/measure.lisp 2007/08/30 03:04:56 1.38 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2008/02/09 16:58:35 1.39 @@ -117,6 +117,10 @@ (declare (ignore direction)) (mark-modified element))

+(defmethod (setf annotations) :after (annotations (element relement)) + (declare (ignore annotations)) + (mark-modified element)) + (defmethod append-char :after ((element lyrics-element) char) (declare (ignore char)) (mark-modified element)) --- /project/gsharp/cvsroot/gsharp/modes.lisp 2007/07/06 14:16:20 1.27 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2008/02/09 16:58:35 1.28 @@ -103,6 +103,8 @@ (set-key 'com-untie-note-left 'cluster-table '((#\x) (#{))) (set-key 'com-untie-note-right 'cluster-table '((#\x) (#}))) (set-key 'com-rotate-stem-direction 'cluster-table '((#\s :meta))) +(set-key 'com-toggle-staccato 'cluster-table '(#\s)) +(set-key 'com-toggle-tenuto 'cluster-table '(#\t)) (set-key 'com-current-increment 'cluster-table '((#\p))) (set-key 'com-current-decrement 'cluster-table '((#\n))) (set-key 'com-octave-up 'cluster-table '((#\U :shift :meta))) --- /project/gsharp/cvsroot/gsharp/packages.lisp 2008/01/15 15:43:52 1.65 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2008/02/09 16:58:35 1.66 @@ -59,7 +59,7 @@ #:gsharp-condition #:pitch #:accidentals #:dots #:note #:make-note #:note-less #:note-equal #:bar - #:notehead #:rbeams #:lbeams #:dots #:element + #:notehead #:rbeams #:lbeams #:dots #:element #:annotations #:melody-element #:rhythmic-element #:notes #:add-note #:find-note #:remove-note #:cluster-upper-bound #:cluster-lower-bound