[gsharp-cvs] CVS update: gsharp/drawing.lisp
Robert Strandh
rstrandh at common-lisp.net
Fri Nov 18 17:53:41 UTC 2005
Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv11018
Modified Files:
drawing.lisp
Log Message:
Accidentals are now placed relative to the cluster.
Also, more renaming to improve maintainability.
Date: Fri Nov 18 18:53:41 2005
Author: rstrandh
Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.24 gsharp/drawing.lisp:1.25
--- gsharp/drawing.lisp:1.24 Fri Nov 18 18:36:36 2005
+++ gsharp/drawing.lisp Fri Nov 18 18:53:40 2005
@@ -5,10 +5,13 @@
(define-added-mixin dnote () note
(;; the relative x offset of the note with respect to the cluster
- (final-relative-xoffset :accessor final-relative-xoffset)
+ (final-relative-note-xoffset :accessor final-relative-note-xoffset)
(final-accidental :initform nil :accessor final-accidental)
- ;; nil indicates that accidental has not been placed yet
- (accidental-position :initform nil :accessor accidental-position)))
+ ;; The relative x offset of the accidental of the note with respect
+ ;; to the cluster. A value of nil indicates that accidental has
+ ;; not been placed yet
+ (final-relative-accidental-xoffset :initform nil
+ :accessor final-relative-accidental-xoffset)))
(define-presentation-method present
(object (type score-pane:clef) stream (view textual-view) &key)
@@ -59,18 +62,18 @@
:x1 ,x1 :x2 ,x2)
:stream pane))
-;;; Return the final x offset of a note. This value is computed from
-;;; the x offset of the cluster of the note and the relative x offset
-;;; of the note with respect to the cluster.
-(defun final-note-xoffset (note)
- (+ (element-xpos (cluster note)) (final-relative-xoffset note)))
-
-;;; Return the final x offset of the accidental of a note. This value
-;;; is computed from the x offset of the cluster of the note and the
-;;; relative x offset of the accidental of the note with respect to
-;;; the cluster.
-(defun final-accidental-xoffset (note)
- (+ (element-xpos (cluster note)) (accidental-position note)))
+;;; Return the final absolute x offset of a note. This value is
+;;; computed from the x offset of the cluster of the note and the
+;;; relative x offset of the note with respect to the cluster.
+(defun final-absolute-note-xoffset (note)
+ (+ (element-xpos (cluster note)) (final-relative-note-xoffset note)))
+
+;;; Return the final absolute x offset of the accidental of a note.
+;;; This value is computed from the x offset of the cluster of the
+;;; note and the relative x offset of the accidental of the note with
+;;; respect to the cluster.
+(defun final-absolute-accidental-xoffset (note)
+ (+ (element-xpos (cluster note)) (final-relative-accidental-xoffset note)))
(defun line-cost (measures method)
(reduce (lambda (x y) (combine-cost method x y)) measures :initial-value nil))
@@ -528,12 +531,12 @@
(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) (accidental-position note) pos))
+ (score-pane:draw-accidental pane (final-accidental note) (final-absolute-accidental-xoffset note) pos))
(draw-dots pane nb-dots x pos)))
(defun draw-notes (pane notes dots notehead)
(loop for note in notes do
- (draw-note pane note notehead dots (final-note-xoffset note) (note-position note))))
+ (draw-note pane note notehead dots (final-absolute-note-xoffset note) (note-position note))))
;;; given a group of notes (i.e. a list of notes, all displayed on the
;;; same staff, compute their final x offsets. This is a question of
@@ -541,14 +544,14 @@
;;; the stem. The head-note of the stem goes to the left of an
;;; up-stem and to the right of a down-stem. The x offset of a cluster
;;; gives the x position of the head-note.
-(defun compute-final-relative-xoffsets (group direction)
+(defun compute-final-relative-note-xoffsets (group direction)
(setf group (sort (copy-list group)
(if (eq direction :up)
(lambda (x y) (< (note-position x) (note-position y)))
(lambda (x y) (> (note-position x) (note-position y))))))
(score-pane:with-suspended-note-offset offset
;; the first element of the group is the head-note
- (setf (final-relative-xoffset (car group)) 0)
+ (setf (final-relative-note-xoffset (car group)) 0)
;; OFFSET is a positive quantity that determines the
;; absolute difference between the x offset of a suspended
;; note and that of a normally positioned note.
@@ -560,7 +563,7 @@
;; if adjacent notes are just one staff step apart,
;; then one must be suspended.
(dx (if (= (abs (- pos old-pos)) 1) offset 0)))
- (setf (final-relative-xoffset note) dx)
+ (setf (final-relative-note-xoffset note) dx)
;; go back to ordinary offset
(when (= (abs (- pos old-pos)) 1)
(setf note old-note))))))
@@ -577,7 +580,7 @@
(accidentals note)))))
(defun element-has-suspended-notes (element)
- (not (apply #'= (mapcar #'final-relative-xoffset (notes element)))))
+ (not (apply #'= (mapcar #'final-relative-note-xoffset (notes element)))))
;;; table of x offsets (in staff steps) of accendentals.
;;; The first index represents a notehead or a type of accidental.
@@ -653,16 +656,16 @@
;;; of the accidental of the first note. If the second note has
;;; an accidental, but that has not been given a final x offset, then
;;; use the x offset of the notehead instead.
-(defun accidental-xoffset (note1 note2 staff-step)
+(defun accidental-relative-xoffset (note1 note2 staff-step)
(let* ((acc1 (final-accidental note1))
(pos1 (note-position note1))
(acc2 (if (and (final-accidental note2)
- (accidental-position note2))
+ (final-relative-accidental-xoffset note2))
(final-accidental note2)
:notehead))
(pos2 (note-position note2))
- (xpos2 (or (accidental-position note2)
- (final-note-xoffset note2))))
+ (xpos2 (or (final-relative-accidental-xoffset note2)
+ (final-relative-note-xoffset note2))))
(- xpos2 (* staff-step (accidental-distance acc1 pos1 acc2 pos2)))))
;;; given a note and a list of notes, compute x offset of the accidental
@@ -670,7 +673,7 @@
;;; for the accidental of the note not to overlap any of the others,
;;; we must use the minimum of all the x offsets thus computed.
(defun accidental-min-xoffset (note1 notes staff-step)
- (reduce #'min notes :key (lambda (note) (accidental-xoffset note1 note staff-step))))
+ (reduce #'min notes :key (lambda (note) (accidental-relative-xoffset note1 note staff-step))))
;;; given a list of notes that have accidentals to place, and a list of
;;; notes that either have no accidentals or with already-placed accidentals,
@@ -684,32 +687,32 @@
notes-with-accidentals))
;;; for each note in a list of notes, if it has an accidental, compute
-;;; the position of that accidental and store it in the note.
-(defun compute-final-accidental-positions (notes x final-stem-direction)
+;;; the final relative x offset of that accidental and store it in the note.
+(defun compute-final-relative-accidental-xoffset (notes x final-stem-direction)
(let* ((staff-step (score-pane:staff-step 1))
;; sort the notes from top to bottom
(notes (sort (copy-list notes)
(lambda (x y) (> (note-position x) (note-position y)))))
(notes-with-accidentals (remove-if-not #'final-accidental notes)))
;; initially, no accidental has been placed
- (loop for note in notes do (setf (accidental-position note) nil))
+ (loop for note in notes do (setf (final-relative-accidental-xoffset note) nil))
(when (eq final-stem-direction :up)
;; when the stem direction is :up and there is a suspended note
;; i.e., one to the right of the stem, then the accidental of the topmost
;; suspended note is placed first.
(let ((first-suspended-note
- (find x notes-with-accidentals :test #'/= :key #'final-relative-xoffset)))
+ (find x notes-with-accidentals :test #'/= :key #'final-relative-note-xoffset)))
(when first-suspended-note
(setf notes-with-accidentals
(remove first-suspended-note notes-with-accidentals))
- (setf (accidental-position first-suspended-note)
+ (setf (final-relative-accidental-xoffset first-suspended-note)
(accidental-min-xoffset first-suspended-note notes staff-step)))))
;; place remaining accidentals
(loop while notes-with-accidentals
do (let ((choice (best-accidental notes-with-accidentals notes staff-step)))
(setf notes-with-accidentals
(remove choice notes-with-accidentals))
- (setf (accidental-position choice)
+ (setf (final-relative-accidental-xoffset choice)
(accidental-min-xoffset choice notes staff-step))))))
;;; given a list of notes, group them so that every note in the group
@@ -741,9 +744,9 @@
(score-pane:with-vertical-score-position (pane stem-yoffset)
(draw-flags pane element x direction stem-pos)))
(loop for group in groups do
- (compute-final-relative-xoffsets group direction)
+ (compute-final-relative-note-xoffsets group direction)
(compute-final-accidentals group)
- (compute-final-accidental-positions group x direction)
+ (compute-final-relative-accidental-xoffset group x direction)
(draw-notes pane group (dots element) (notehead element))
(draw-ledger-lines pane x group))
(unless (eq (notehead element) :whole)
More information about the Gsharp-cvs
mailing list