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