Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv8113
Modified Files: drawing.lisp Log Message: continue the restructuring of drawing.lisp
Date: Fri Nov 18 03:49:43 2005 Author: rstrandh
Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.21 gsharp/drawing.lisp:1.22 --- gsharp/drawing.lisp:1.21 Fri Nov 18 02:59:27 2005 +++ gsharp/drawing.lisp Fri Nov 18 03:49:43 2005 @@ -217,7 +217,7 @@ (t n2))) notes))
-;;; compute and store several important pieces of information +;;; Compute and store several important pieces of information ;;; about an element: ;;; * the position, in staff steps of the top note. ;;; * the position, in staff steps of the bottom note. @@ -230,7 +230,7 @@ (setf (top-note-pos element) 4 (bot-note-pos element) 4)))
-;;; compute and store several important pieces of information +;;; Compute and store several important pieces of information ;;; about an element: ;;; * the y-offset of the staff containing the top note. ;;; * the y-offset of the staff containing the bottom note. @@ -244,6 +244,8 @@ (top-note-staff-yoffset element) 0 (bot-note-staff-yoffset element) 0)))
+;;; Compute and store the final stem direction of an element that is +;;; not beamed together with any other elements. (defun compute-stem-direction (element) (setf (final-stem-direction element) (if (or (eq (stem-direction element) :up) (eq (stem-direction element) :down)) @@ -304,11 +306,6 @@ (+ top-note-pos length) (- bot-note-pos length)))))
-(defun compute-appearance (element) - (when (typep element 'cluster) - (compute-stem-direction element) - (compute-stem-length element))) - (defun compute-element-x-positions (bar x time-alist) (let (;;(time-alist (time-alist bar)) (start-time 0)) @@ -320,12 +317,16 @@ (incf start-time (duration element))) (elements bar))))
+;;; Compute and store the final stem directions of all the elements of +;;; a beam group with at least two elements in it. (defun compute-stem-directions (elements) - (if (not (eq (stem-direction (car elements)) :auto)) - (stem-direction (car elements)) - (let ((top-note-pos (reduce #'max elements :key #'top-note-pos)) - (bot-note-pos (reduce #'min elements :key #'bot-note-pos))) - (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up)))) + (let ((stem-direction (if (not (eq (stem-direction (car elements)) :auto)) + (stem-direction (car elements)) + (let ((top-note-pos (reduce #'max elements :key #'top-note-pos)) + (bot-note-pos (reduce #'min elements :key #'bot-note-pos))) + (if (>= (- top-note-pos 4) (- 4 bot-note-pos)) :down :up))))) + (loop for element in elements + do (setf (final-stem-direction element) stem-direction))))
;;; the dominating note among a bunch of notes is the ;;; one that is closest to the beam, i.e. the one @@ -348,14 +349,28 @@ (if (< (pitch n1) (pitch n2)) n1 n2)))))) notes))
-(defun draw-beam-group (pane elements) +;;; Given a list of elements to be beamed together, for each element, +;;; compute the top and bottom note position, and the final stem +;;; direction. +(defun compute-positions-and-stem-direction (elements) (mapc #'compute-top-bot-pos elements) + (if (null (cdr elements)) + (let ((element (car elements))) + (when (or (typep element 'rest) (notes element)) + (when (typep element 'cluster) + (compute-stem-direction element)))) + (compute-stem-directions elements))) + +(defun draw-beam-group (pane elements) (mapc #'compute-top-bot-yoffset elements) (if (null (cdr elements)) - (when (or (typep (car elements) 'rest) (notes (car elements))) - (compute-appearance (car elements)) - (draw-element pane (car elements) (element-xpos (car elements)))) - (let* ((stem-direction (compute-stem-directions elements)) + (let ((element (car elements))) + (when (or (typep element 'rest) (notes element)) + (when (typep element 'cluster) + (compute-stem-direction element) + (compute-stem-length element)) + (draw-element pane element (element-xpos element)))) + (let* ((stem-direction (final-stem-direction (car elements))) (dominating-notes (mapcar (lambda (e) (dominating-note (notes e) stem-direction)) elements)) @@ -370,8 +385,6 @@ (/ (element-xpos element) (score-pane:staff-step 1))) elements)) (beaming (beaming-single (mapcar #'list positions x-positions) stem-direction))) - (loop for element in elements do - (setf (final-stem-direction element) stem-direction)) (destructuring-bind ((ss1 . offset1) (ss2 . offset2)) beaming (let* ((y1 (+ ss1 (* 1/2 offset1))) (y2 (+ ss2 (* 1/2 offset2))) @@ -424,7 +437,8 @@ (defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) (loop for group in (beam-groups (elements bar)) - do (draw-beam-group pane group)) + do (compute-positions-and-stem-direction group) + (draw-beam-group pane group)) (when (eq (cursor-bar *cursor*) bar) (let ((elements (elements bar))) (if (null (cursor-element *cursor*)) @@ -537,6 +551,9 @@ (when (= (abs (- pos old-pos)) 1) (setf note old-note))))))
+;;; Given a list of notes to be displayed on the same staff line, for +;;; each note, compute the accidental to be displayed as a function of +;;; the accidentals of the note and the key signature of the staff. (defun compute-final-accidentals (group) (loop for note in group do (setf (final-accidental note)