[gsharp-cvs] CVS gsharp

[crhodes]

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

Modified Files:
	drawing.lisp 
Log Message:
Better tie drawing:

Tie direction is taken from the final stem direction of the first note.  
This is not actually right, but it's incrementally better than ignoring 
the stem directions completely.

Draw a stub tie forward if no matching note is found.  (This needs to 
happen for unpaired backwards ties too, but the way DRAW-TIES is 
currently structured makes that mildly tricky.)


--- /project/gsharp/cvsroot/gsharp/drawing.lisp	2007/07/27 16:47:50	1.80
+++ /project/gsharp/cvsroot/gsharp/drawing.lisp	2007/07/27 22:31:04	1.81
@@ -361,6 +361,30 @@
 	do (compute-measure-coordinates measure x y force)
 	do (incf x (size-at-force (elasticity-function measure) force))))
 
+(defun draw-tie (pane bars n1 n2)
+  ;; FIXME: we'll want to draw ties between (nothing) and n2 eventually
+  (declare (type note n1) (type (or note null) n2))
+  (let ((x1 (+ (final-absolute-note-xoffset n1) (score-pane:staff-step 1.5)))
+	(x2 (if (typep n2 'note)
+		(- (final-absolute-note-xoffset n2) (score-pane:staff-step 1.5))
+		(+ (final-absolute-note-xoffset n1) (score-pane:staff-step 4.5))))
+	(pos (note-position n1)))
+    (if (eq (final-stem-direction (cluster n1)) :up)
+	(score-pane:with-vertical-score-position (pane (staff-yoffset (staff n1)))
+	  (if (gsharp-cursor::cursors (slice (car bars)))
+	      (score-pane:draw-tie-down pane x1 x2 (if (oddp pos) (1- pos) pos))
+	      (score-pane:with-light-glyphs pane
+		(score-pane:draw-tie-down pane x1 x2 (if (oddp pos) (1- pos) pos)))))
+	(score-pane:with-vertical-score-position (pane (staff-yoffset (staff n1)))
+	  (if (gsharp-cursor::cursors (slice (car bars)))
+	      (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos))
+	      (score-pane:with-light-glyphs pane
+		(score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos))))))))
+
+(defun notes-tieable (n1 n2)
+  (and (= (pitch n1) (pitch n2))
+       (eq (staff n1) (staff n2))
+       (eq (accidentals n1) (accidentals n2))))
 
 ;;; draw the ties in BARS starting at BAR and at most LENGTH bars
 (defun draw-ties (pane bars bar length)
@@ -373,22 +397,15 @@
 					repeat length
 					collect bar))
 	  for (e1 e2) on elements
-	  do (when (and (typep e1 'cluster) (typep e2 'cluster) (not (null e2)))
+	  do (when (typep e1 'cluster)
 	       (loop for n1 in (notes e1)
 		     do (when (tie-right n1)
-			  (loop for n2 in (notes e2)
+			  (loop for n2 in (and (typep e2 'cluster) (notes e2))
 				do (when (and (tie-left n2)
-					      (= (pitch n1) (pitch n2))
-					      (eq (staff n1) (staff n2))
-					      (accidentals n1) (accidentals n2))
-				     (let ((x1 (+ (final-absolute-note-xoffset n1) (score-pane:staff-step 1.5)))
-					   (x2 (- (final-absolute-note-xoffset n2) (score-pane:staff-step 1.5)))
-					   (pos (note-position n1)))
-				       (score-pane:with-vertical-score-position (pane (staff-yoffset (staff n1)))
-					 (if (gsharp-cursor::cursors (slice (car bars)))
-					     (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos))
-					     (score-pane:with-light-glyphs pane
-					       (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos))))))))))))))
+					      (notes-tieable n1 n2))
+				     (draw-tie pane bars n1 n2)
+				     (return))
+				finally (draw-tie pane bars n1 nil))))))))
 
 (defun draw-system (pane measures)
   (with-new-output-record (pane)