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

Modified Files: drawing.lisp measure.lisp packages.lisp Log Message: Dots!

Specifically, augmentation dots. Get their x- and y- positions more right, which sometimes entails not drawing a dot at all, sometimes adjusting the position for a dot downwards, and (when a flag is drawn or there is a suspended note in a flag-up situation) involves shifting the entire column of dots rightwards.

Add an example score full of things we got wrong.

--- /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/06/19 17:40:34 1.71 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/06/21 16:31:54 1.72 @@ -76,6 +76,9 @@ (defun final-absolute-accidental-xoffset (note) (+ (final-absolute-element-xoffset (cluster note)) (final-relative-accidental-xoffset note)))

+(defun final-absolute-dot-xoffset (cluster) + (+ (final-absolute-element-xoffset cluster) (score-pane:staff-step (final-relative-dot-xoffset cluster)))) + (defvar *cursor* nil)

;;; Compute the elasticity of each timeline in each measure of the @@ -832,9 +835,13 @@ (loop for pos from -2 downto bot-note-pos by 2 do (score-pane:draw-ledger-line pane x pos)))))

-(defun draw-flags (pane element x direction pos) +(defun flags-drawn-p (element) (let ((nb (max (rbeams element) (lbeams element)))) - (when (and (> nb 0) (eq (notehead element) :filled)) + (and (> nb 0) (eq (notehead element) :filled) nb))) + +(defun draw-flags (pane element x direction pos) + (let ((nb (flags-drawn-p element))) + (when nb (if (eq direction :up) (score-pane:with-notehead-right-offsets (right up) (declare (ignore up)) @@ -843,23 +850,23 @@ (declare (ignore down)) (score-pane:draw-flags-up pane nb (+ x left) pos))))))

-(defun draw-dots (pane nb-dots x pos) - (let ((staff-step (score-pane:staff-step 1))) - (loop with dotpos = (if (evenp pos) (1+ pos) pos) - repeat nb-dots - for xx from (+ x (* 2 staff-step)) by staff-step do - (score-pane:draw-dot pane xx dotpos)))) +(defun draw-dots (pane nb-dots x dot-xoffset dot-pos) + (when dot-pos + (let ((staff-step (score-pane:staff-step 1))) + (loop repeat nb-dots + for xx from dot-xoffset by staff-step do + (score-pane:draw-dot pane xx dot-pos)))))

-(defun draw-note (pane note notehead nb-dots x pos) +(defun draw-note (pane note notehead nb-dots x pos dot-xoffset dot-pos) (score-pane:with-vertical-score-position (pane (staff-yoffset (staff note))) (score-pane:draw-notehead pane notehead x pos) (when (final-accidental note) (score-pane:draw-accidental pane (final-accidental note) (final-absolute-accidental-xoffset note) pos)) - (draw-dots pane nb-dots x pos))) + (draw-dots pane nb-dots x dot-xoffset dot-pos)))

-(defun draw-notes (pane notes dots notehead) +(defun draw-notes (pane notes dots notehead dot-xoffset) (loop for note in notes do - (draw-note pane note notehead dots (final-absolute-note-xoffset note) (note-position note)))) + (draw-note pane note notehead dots (final-absolute-note-xoffset note) (note-position note) dot-xoffset (final-absolute-dot-ypos note))))

(defun element-has-suspended-notes (element) (not (apply #'= (mapcar #'final-relative-note-xoffset (notes element))))) @@ -873,17 +880,23 @@ (defmethod draw-element (pane (element cluster) &optional (flags t)) (with-new-output-record (pane) (unless (null (notes element)) - (let ((direction (final-stem-direction element)) - (stem-pos (final-stem-position element)) - (stem-yoffset (final-stem-yoffset element)) - (groups (group-notes-by-staff (notes element))) - (x (final-absolute-element-xoffset element))) + (let* ((direction (final-stem-direction element)) + (stem-pos (final-stem-position element)) + (stem-yoffset (final-stem-yoffset element)) + (groups (group-notes-by-staff (notes element))) + (x (final-absolute-element-xoffset element)) + (dot-xoffset + (let ((basic-xoffset (+ (score-pane:staff-step 2) + (reduce #'max (mapcar #'final-absolute-note-xoffset (notes element)))))) + (if (and flags (eq direction :up) (flags-drawn-p element)) + (max basic-xoffset (+ (score-pane:staff-step 4) x)) + basic-xoffset)))) (when flags (score-pane:with-vertical-score-position (pane stem-yoffset) (draw-flags pane element x direction stem-pos))) - (loop for group in groups do - (draw-notes pane group (dots element) (notehead element)) - (draw-ledger-lines pane x group)) + (loop for group in groups do + (draw-notes pane group (dots element) (notehead element) dot-xoffset) + (draw-ledger-lines pane x group)) (unless (eq (notehead element) :whole) (if (eq direction :up) (score-pane:draw-right-stem --- /project/gsharp/cvsroot/gsharp/measure.lisp 2006/06/19 17:40:34 1.31 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2006/06/21 16:31:54 1.32 @@ -56,7 +56,11 @@ :accessor final-relative-accidental-xoffset) (final-accidental :initform nil :accessor final-accidental) ;; the relative x offset of the note with respect to the cluster - (final-relative-note-xoffset :accessor final-relative-note-xoffset))) + (final-relative-note-xoffset :accessor final-relative-note-xoffset) + ;; the absolute y position of any dot, or NIL if dots should not be + ;; drawn + (final-absolute-dot-ypos :accessor final-absolute-dot-ypos :initform nil) +))

;;; given a list of notes, group them so that every note in the group ;;; is displayed on the same staff. Return the list of groups. @@ -158,7 +162,7 @@

(define-added-mixin rcluster () cluster ((final-stem-direction :accessor final-stem-direction) - ;; the position, in staff steps, of the top not in the element. + ;; the position, in staff steps, of the top note in the element. (top-note-pos :accessor top-note-pos) ;; the position, in staff steps, of the bottom note in the element. (bot-note-pos :accessor bot-note-pos))) @@ -217,6 +221,22 @@ when (non-empty-cluster-p element) do (setf (final-stem-direction element) stem-direction))))

+(defun compute-final-dot-positions (group) + (setf group (sort (copy-list group) #'> :key #'note-position)) + (let ((so-far nil)) + (dolist (note group) + (let* ((position (note-position note)) + (ideal (if (oddp position) position (1+ position)))) + (cond + ;; if there's no dot at our ideal position, use that + ((not (member ideal so-far)) (push (setf (final-absolute-dot-ypos note) ideal) so-far)) + ;; if the note in question is on a line and we haven't + ;; got a dot in the space underneath, use that + ((and (evenp position) (not (member (- ideal 2) so-far))) + (push (setf (final-absolute-dot-ypos note) (- ideal 2)) so-far)) + ;; otherwise, give up for this note + (t (setf (final-absolute-dot-ypos note) nil))))))) + ;;; 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. @@ -550,6 +570,7 @@

(defun compute-staff-group-parameters (staff-group stem-direction) (compute-final-relative-note-xoffsets staff-group stem-direction) + (compute-final-dot-positions staff-group) (compute-final-accidentals staff-group) (compute-final-relative-accidental-xoffset staff-group stem-direction))

@@ -622,7 +643,7 @@

(defmethod compute-bar-parameters ((bar melody-bar)) (loop for group in (beam-groups (elements bar)) - do (compute-beam-group-parameters group))) + do (compute-beam-group-parameters group)))

;;; From a list of simultaneous bars (and some other stuff), create a ;;; measure. The `other stuff' is the spacing style, which is needed --- /project/gsharp/cvsroot/gsharp/packages.lisp 2006/06/14 03:38:56 1.57 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2006/06/21 16:31:54 1.58 @@ -128,6 +128,7 @@ #:beam-groups #:final-stem-direction #:group-notes-by-staff #:final-relative-note-xoffset #:final-accidental #:final-relative-accidental-xoffset + #:final-relative-dot-xoffset #:final-absolute-dot-ypos #:timeline #:timelines #:elasticity #:smallest-gap #:elasticity-function))