Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv3504

Modified Files: drawing.lisp measure.lisp Log Message: Prepare for a separation of the functionality in drawing.lisp into two parts:

1. A part that computes stem directions and x offsets of notes and accidentals relative to the x offset of the element. These computations will be used to determine physical widths of elements.

2. A part that computes exact x and y positions, beam slants, etc. for the final drawing phase.

The first part will precede the line-breaking phase, so that the line-breaking algorithm can take physical widths into account.

Date: Fri Nov 18 02:59:27 2005 Author: rstrandh

Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.20 gsharp/drawing.lisp:1.21 --- gsharp/drawing.lisp:1.20 Tue Nov 15 19:49:52 2005 +++ gsharp/drawing.lisp Fri Nov 18 02:59:27 2005 @@ -221,19 +221,26 @@ ;;; about an element: ;;; * the position, in staff steps of the top note. ;;; * the position, in staff steps of the bottom note. +(defun compute-top-bot-pos (element) + (if (and (typep element 'cluster) (notes element)) + (let ((top-note (top-note (notes element))) + (bot-note (bot-note (notes element)))) + (setf (top-note-pos element) (note-position top-note) + (bot-note-pos element) (note-position bot-note))) + (setf (top-note-pos element) 4 + (bot-note-pos element) 4))) + +;;; 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. -(defun compute-top-bot-pos-yoffset (element) +(defun compute-top-bot-yoffset (element) (if (and (typep element 'cluster) (notes element)) (let ((top-note (top-note (notes element))) (bot-note (bot-note (notes element)))) - (setf (top-note-pos element) (note-position top-note) - (bot-note-pos element) (note-position bot-note) - (bot-note-staff-yoffset element) (staff-yoffset (staff bot-note)) + (setf (bot-note-staff-yoffset element) (staff-yoffset (staff bot-note)) (top-note-staff-yoffset element) (staff-yoffset (staff top-note)))) - (setf (top-note-pos element) 4 - (bot-note-pos element) 4 - ;; clearly wrong. should be taken from element or layer. + (setf ;; clearly wrong. should be taken from element or layer. (top-note-staff-yoffset element) 0 (bot-note-staff-yoffset element) 0)))

@@ -342,7 +349,8 @@ notes))

(defun draw-beam-group (pane elements) - (mapc #'compute-top-bot-pos-yoffset elements) + (mapc #'compute-top-bot-pos elements) + (mapc #'compute-top-bot-yoffset elements) (if (null (cdr elements)) (when (or (typep (car elements) 'rest) (notes (car elements))) (compute-appearance (car elements)) @@ -399,10 +407,11 @@ (defun draw-cursor (pane x) (draw-line* pane x (- (score-pane:staff-step -4)) x (- (score-pane:staff-step 12)) :ink +red+))

-(defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor) - (compute-element-x-positions bar x time-alist) - (let ((elements (elements bar)) - (group '())) +;;; Given a list of the elements of a bar, return a list of beam +;;; groups, where each beam group is a list of elements that are +;;; beamed together +(defun beam-groups (elements) + (let ((group '())) (loop while (not (null elements)) do (setf group '()) (push (pop elements) group) @@ -410,7 +419,12 @@ (> (rbeams (car group)) 0) (> (lbeams (car elements)) 0)) do (push (pop elements) group)) - (draw-beam-group pane (nreverse group)))) + collect (nreverse group)))) + +(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)) (when (eq (cursor-bar *cursor*) bar) (let ((elements (elements bar))) (if (null (cursor-element *cursor*))

Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.7 gsharp/measure.lisp:1.8 --- gsharp/measure.lisp:1.7 Thu Nov 17 01:42:42 2005 +++ gsharp/measure.lisp Fri Nov 18 02:59:27 2005 @@ -28,13 +28,13 @@

(defmethod duration :around ((element relement)) (with-slots (duration) element - (when (or (modified-p element) (null duration)) - (setf duration (call-next-method)) - (setf (modified-p element) nil)) + (when (null duration) + (setf duration (call-next-method))) duration))

(defmethod mark-modified ((element relement)) - (setf (modified-p element) t) + (setf (modified-p element) t + (slot-value element 'duration) nil) (when (bar element) (mark-modified (bar element))))