[gsharp-cvs] CVS gsharp

[crhodes]

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