[gsharp-cvs] CVS gsharp
crhodes
crhodes at common-lisp.net
Wed Jun 21 16:31:54 UTC 2006
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))
More information about the Gsharp-cvs
mailing list