[gsharp-cvs] CVS gsharp

[rstrandh]

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp:/tmp/cvs-serv15314

Modified Files:
	drawing.lisp packages.lisp score-pane.lisp 
Log Message:
The code for drawing ties is almost finished.  However, since I don't
have my copy of Ross handy, I don't know the rules for the placement
of ties, so for now, only a blue line between the tied notes is drawn. 
This is obviously wrong, but makes it possible to verify that the code
works. 

Also, we don't draw a tie if the tied notes are on different lines.



--- /project/gsharp/cvsroot/gsharp/drawing.lisp	2006/02/09 03:17:25	1.61
+++ /project/gsharp/cvsroot/gsharp/drawing.lisp	2006/02/14 03:00:52	1.62
@@ -321,9 +321,37 @@
 	do (compute-measure-coordinates measure x y force)
 	do (incf x (size-at-force (elasticity-function measure) force))))
 
+;;; draw the ties in BARS starting at BAR and at most LENGTH bars
+(defun draw-ties (pane bars bar length)
+  (loop until (eq bar (car bars))
+	do (pop bars))
+  (score-pane:with-vertical-score-position
+      (pane (system-y-position (car bars)))
+    (loop with elements = (mapcan (lambda (bar) (copy-seq (elements bar)))
+				  (loop for bar in bars
+					repeat length
+					collect bar))
+	  for (e1 e2) on elements
+	  do (when (and (typep e1 'cluster) (typep e2 'cluster) (not (null e2)))
+	       (loop for n1 in (notes e1)
+		     do (when (tie-right n1)
+			  (loop for n2 in (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))
+					   (x2 (final-absolute-note-xoffset n2))
+					   (y (- (score-pane:staff-step (note-position n1)))))
+				       (score-pane:with-vertical-score-position (pane (staff-yoffset (staff n1)))
+					 (score-pane:draw-tie pane x1 x2 y)))))))))))
+
 (defun draw-system (pane measures)
   (loop for measure in measures do
-	(draw-measure pane measure)))
+	(draw-measure pane measure))
+  (loop with length = (length measures)
+	for bar in (measure-bars (car measures))
+	do (draw-ties pane (bars (slice bar)) bar length)))
 
 (defmethod draw-buffer (pane (buffer buffer) *cursor* x y)
   (score-pane:with-staff-size 6
--- /project/gsharp/cvsroot/gsharp/packages.lisp	2006/02/13 23:51:34	1.43
+++ /project/gsharp/cvsroot/gsharp/packages.lisp	2006/02/14 03:00:52	1.44
@@ -55,6 +55,7 @@
 	   #:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step
 	   #:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot
 	   #:draw-flags-up #:draw-flags-down
+	   #:draw-tie
 	   #:with-score-pane #:with-vertical-score-position
 	   #:with-staff-size #:with-notehead-right-offsets
 	   #:with-suspended-note-offset
--- /project/gsharp/cvsroot/gsharp/score-pane.lisp	2006/01/04 19:08:12	1.19
+++ /project/gsharp/cvsroot/gsharp/score-pane.lisp	2006/02/14 03:00:52	1.20
@@ -627,6 +627,10 @@
 	      (draw-horizontal-beam pane xx1 y1 xx2)
 	      (draw-sloped-beam medium xx1 y1 xx2 y2))))))
 
+;;; FIXME obviously
+(defun draw-tie (pane x1 x2 y)
+  (draw-rectangle* pane x1 (1- y) x2 (1+ y) :ink +blue+))  
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; convenience macros