[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/drawing.lisp gsharp/measure.lisp
Robert Strandh
rstrandh at common-lisp.net
Sat Jan 21 23:39:16 UTC 2006
Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp:/tmp/cvs-serv5433
Modified Files:
buffer.lisp drawing.lisp measure.lisp
Log Message:
Removed some dead code.
Prepared Gsharp for handling timelines and measures of zero duration.
This conversion is not entirely finished yet, but there is not much
left.
Date: Sat Jan 21 17:39:16 2006
Author: rstrandh
Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.28 gsharp/buffer.lisp:1.29
--- gsharp/buffer.lisp:1.28 Thu Jan 5 13:14:45 2006
+++ gsharp/buffer.lisp Sat Jan 21 17:39:16 2006
@@ -495,6 +495,14 @@
(defmethod print-object :after ((b bar) stream)
(format stream ":elements ~W " (elements b)))
+;;; The duration of a bar is simply the sum of durations
+;;; of its elements. We might want to improve on the
+;;; implementation of this method so that it uses some
+;;; kind of cache, in order to avoid looping over each
+;;; element and computing the duration of each one each time.
+(defmethod duration ((bar bar))
+ (reduce #'+ (mapcar #'duration (elements bar))))
+
(defgeneric make-bar-for-staff (staff &rest args &key elements))
(defmethod nb-elements ((bar bar))
@@ -935,7 +943,7 @@
(staves :initform (list (make-fiveline-staff))
:initarg :staves :accessor staves)
;; the min width determines the preferred geographic distance after the
- ;; timetlime with the shortest duration on a line.
+ ;; timeline with the shortest duration on a line.
(min-width :initform *default-min-width* :initarg :min-width :accessor min-width)
;; the spacing style of the buffer determines the how geographic distance
;; between adjacent timelines is related to temporal distance.
Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.55 gsharp/drawing.lisp:1.56
--- gsharp/drawing.lisp:1.55 Tue Jan 3 08:25:46 2006
+++ gsharp/drawing.lisp Sat Jan 21 17:39:16 2006
@@ -82,37 +82,8 @@
(defun final-absolute-accidental-xoffset (note)
(+ (final-absolute-element-xoffset (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))
-
-(defun compute-compress-factor (measures method)
- (compress-factor method (line-cost measures method)))
-
-(defun red-width (method coeff min-dist)
- (* coeff (min-width method) (expt (/ min-dist) (spacing-style method))))
-
-(defun compute-reduced-width (method coeff min-dist)
- (if (zerop min-dist) 0 (red-width method coeff min-dist)))
-
-(defun nat-width (method coeff min-dist)
- (+ (red-width method coeff min-dist) (min-width method)))
-
(defvar *cursor* nil)
-(defun compute-min-dist (measures)
- (let ((min-dists (mapcar (lambda (measure)
- (reduce #'min (gsharp-measure::abs-rel
- (measure-start-times measure))))
- measures)))
- (reduce #'min min-dists)))
-
-(defun compute-widths (measures method)
- (let ((compress (compute-compress-factor measures method))
- (min-dist (compute-min-dist measures)))
- (loop for measure in measures
- collect (/ (nat-width method (measure-coeff measure) min-dist)
- compress))))
-
;;; Compute the elasticity of each timeline in each measure of the
;;; measures of a system (line) by taking its duration to the power of
;;; the spaceing style. This metric is arbitrarily normalized to the
@@ -316,9 +287,7 @@
finally (setf (elasticity-function measure) result)))
(reduce #'add-elasticities measures :key #'elasticity-function))
-;;; eventually replace the existing compute-measure-coordinates
-;;; by this one
-(defun new-compute-measure-coordinates (measure x y force)
+(defun compute-measure-coordinates (measure x y force)
(loop with timelines = (timelines measure)
for i from 0 below (flexichain:nb-elements timelines)
for timeline = (flexichain:element* timelines i)
@@ -330,28 +299,6 @@
(loop for bar in (measure-bars measure)
do (compute-bar-coordinates bar x y (size-at-force (elasticity-function measure) force))))
-(defun compute-measure-coordinates (measure min-dist compress x y method)
- (let* ((width (/ (nat-width method (measure-coeff measure) min-dist)
- compress))
- (time-alist (cons (cons 0 (/ (min-width method) compress))
- (loop for start-time in (measure-start-times measure)
- and old-start-time = 0 then start-time
- with coeff = 0
- do (incf coeff (expt (- start-time old-start-time)
- (spacing-style method)))
- collect (cons start-time
- (/ (+ (min-width method)
- (compute-reduced-width
- method
- coeff min-dist))
- compress))))))
-;; (setf (system-y-position measure) y
-;; (final-absolute-measure-xoffset measure) x
-;; (final-width measure) width)
- (loop for bar in (measure-bars measure) do
- (compute-bar-coordinates bar x y width)
- (compute-element-x-positions bar x time-alist))))
-
(defun draw-measure (pane measure)
(loop for bar in (measure-bars measure) do
(if (gsharp-cursor::cursors (slice bar))
@@ -366,21 +313,11 @@
(+ y (- (score-pane:staff-step 8)))
(+ y (staff-yoffset (car (last staves))))))))
-;;; eventually remove the existing compute-system-coordinates
-;;; and rename this one
-(defun new-compute-system-coordinates (measures x y force)
+(defun compute-system-coordinates (measures x y force)
(loop for measure in measures
- do (new-compute-measure-coordinates measure x y force)
+ do (compute-measure-coordinates measure x y force)
do (incf x (size-at-force (elasticity-function measure) force))))
-(defun compute-system-coordinates (measures x y widths method)
- (let ((compress (compute-compress-factor measures method))
- (min-dist (compute-min-dist measures)))
- (loop for measure in measures
- for width in widths do
- (compute-measure-coordinates measure min-dist compress x y method)
- (incf x width))))
-
(defun draw-system (pane measures)
(loop for measure in measures do
(draw-measure pane measure)))
@@ -407,7 +344,6 @@
(right-edge (right-edge buffer)))
(loop for staff in staves
for offset from 0 by 90 do
-;; for offset downfrom 0 by 90 do
(setf (staff-yoffset staff) offset))
(let ((yy y))
(gsharp-measure::new-map-over-obseq-subsequences
@@ -421,25 +357,20 @@
(force (if (> (zero-force-size e-fun) (line-width method))
0
(force-at-size e-fun (line-width method)))))
- (new-compute-system-coordinates measures
- (+ x (left-offset buffer) timesig-offset) yy
- force)
- )
- (let ((widths (compute-widths measures method)))
-;; (compute-system-coordinates measures
-;; (+ x (left-offset buffer) timesig-offset) yy
-;; widths method)
- (draw-system pane measures)
- (score-pane:draw-bar-line pane x
- (+ yy (- (score-pane:staff-step 8)))
- (+ yy (staff-yoffset (car (last staves)))))
- (loop for staff in staves do
- (score-pane:with-vertical-score-position (pane yy)
- (if (member staff (staves (layer (slice (bar *cursor*)))))
- (draw-staff-and-clef pane staff x right-edge)
- (score-pane:with-light-glyphs pane
- (draw-staff-and-clef pane staff x right-edge))))
- (incf yy 90))))
+ (compute-system-coordinates measures
+ (+ x (left-offset buffer) timesig-offset) yy
+ force))
+ (draw-system pane measures)
+ (score-pane:draw-bar-line pane x
+ (+ yy (- (score-pane:staff-step 8)))
+ (+ yy (staff-yoffset (car (last staves)))))
+ (loop for staff in staves do
+ (score-pane:with-vertical-score-position (pane yy)
+ (if (member staff (staves (layer (slice (bar *cursor*)))))
+ (draw-staff-and-clef pane staff x right-edge)
+ (score-pane:with-light-glyphs pane
+ (draw-staff-and-clef pane staff x right-edge))))
+ (incf yy 90)))
buffer)))))
(define-added-mixin velement () melody-element
Index: gsharp/measure.lisp
diff -u gsharp/measure.lisp:1.22 gsharp/measure.lisp:1.23
--- gsharp/measure.lisp:1.22 Thu Jan 5 13:14:45 2006
+++ gsharp/measure.lisp Sat Jan 21 17:39:16 2006
@@ -413,7 +413,7 @@
(defclass timeline (flexichain:element-rank-mixin)
((start-time :initarg :start-time :reader start-time)
(elements :initform '() :accessor elements)
- (duration :initarg :duration :reader duration)
+ (duration :initarg :duration :accessor duration)
(elasticity :accessor elasticity)
;; the minimum x offset from this timeline to the next, or, if this
;; is the last timeline, from this one to the end of the measure
@@ -433,9 +433,6 @@
;; the coefficient of a measure is the sum of d_i^k where d_i
;; is the duration of the i:th timeline, and k is the spacing style
(coeff :initarg :coeff :reader measure-coeff)
- ;; a list of unique rational numbers, sorted by increasing numeric value,
- ;; of the start time of the time lines of the measure
- (start-times :initarg :start-times :reader measure-start-times)
;; the position of a measure in the sequence of measures
;; of a buffer is indicated by two numbers, the position
;; of the segment to which the measure belongs within the
@@ -452,9 +449,8 @@
;; is applied to it
(elasticity-function :accessor elasticity-function)))
-(defun make-measure (min-dist coeff start-times seg-pos bar-pos bars)
+(defun make-measure (min-dist coeff seg-pos bar-pos bars)
(make-instance 'measure :min-dist min-dist :coeff coeff
- :start-times start-times
:seg-pos seg-pos :bar-pos bar-pos :bars bars))
(defmethod print-object ((obj measure) stream)
@@ -492,6 +488,7 @@
(defmethod measures :before ((segment rsegment))
(when (modified-p segment)
(compute-measures segment (spacing-style (buffer-cost-method (buffer segment))))
+ ;; avoid an infinite computation by using slot-value here
(mapc #'compute-timelines (slot-value segment 'measures))
(setf (modified-p segment) nil)))
@@ -536,17 +533,26 @@
(let ((elements (elements bar)))
(if elements
(rel-abs (mapcar #'duration elements))
- '(1))))
+ '(0))))
;;; Combine the list of start times of two bars into a single list
-;;; of start times. Don't worry about duplicated elements which will
-;;; be removed ultimately.
+;;; of start times. If any of the list contains duplicate start
+;;; times, then the resulting list will contain as many duplicates
+;;; as the maximum number of duplicates of the two lists.
;;; Treat the last start time (which is really the duration of the
;;; bar) specially and only keep the largest one
(defun combine-bars (bar1 bar2)
- (append (merge 'list (butlast bar1) (butlast bar2) #'<)
- (list (max (car (last bar1)) (car (last bar2))))))
-
+ (labels ((combine (l1 l2)
+ (cond ((null l1) l2)
+ ((null l2) l1)
+ ((< (car l1) (car l2))
+ (cons (car l1) (combine (cdr l1) l2)))
+ ((< (car l2) (car l1))
+ (cons (car l2) (combine (cdr l2) l1)))
+ (t (cons (car l1) (combine (cdr l1) (cdr l2)))))))
+ (append (combine (butlast bar1) (butlast bar2))
+ (list (max (car (last bar1)) (car (last bar2)))))))
+
;;; 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
;;; determining whether the note goes to the right or to the left of
@@ -654,7 +660,7 @@
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 neded
+;;; measure. The `other stuff' is the spacing style, which is needed
;;; in order to compute the coefficient of the measure, the position
;;; of the segment to which the bars belong in the sequence of
;;; segments of the buffer, and the position of the bars in the
@@ -667,38 +673,54 @@
do (when (modified-p bar)
(compute-bar-parameters bar)
(setf (modified-p bar) nil)))
- (let* ((start-times (remove-duplicates
- (reduce #'combine-bars
- (mapcar #'start-times bars))))
+ (let* ((start-times (reduce #'combine-bars
+ (mapcar #'start-times bars)))
(durations (abs-rel start-times))
- (min-dist (reduce #'min durations))
+ ;; elements with zero duration do not intervene
+ ;; in the computation of the min-dist.
+ ;; Choose a large default value for min-dist.
+ (min-dist (reduce #'min (remove 0 durations) :initial-value 10000))
(coeff (loop for duration in durations
sum (expt duration spacing-style))))
- (make-measure min-dist coeff start-times seg-pos bar-pos bars))))
+ (make-measure min-dist coeff seg-pos bar-pos bars))))
(defun compute-timelines (measure)
- (let ((timelines (timelines measure))
- (durations (abs-rel (measure-start-times measure))))
- ;; create a timeline for each start time of the measure
- (loop for duration in durations
- and start-time = 0 then (+ start-time duration)
- for i from 0
- do (let ((timeline (make-instance 'timeline
- :start-time start-time
- :duration duration)))
- (flexichain:insert* timelines i timeline)))
- ;; link each timeline to its elements and each element of a
- ;; timeline to the timeline
- (loop for bar in (measure-bars measure)
- do (loop with timeline-index = 0
- for element in (elements bar)
- and start-time = 0 then (+ start-time (duration element))
- do (loop while (< (start-time (flexichain:element* timelines timeline-index))
- start-time)
- do (incf timeline-index))
- do (let ((timeline (flexichain:element* timelines timeline-index)))
- (push element (elements timeline))
- (setf (timeline element) timeline))))))
+ (let ((timelines (timelines measure)))
+ (flet ((compute-bar-timelines (bar)
+ (loop with timeline-index = 0
+ for element in (elements bar)
+ and start-time = 0 then (+ start-time (duration element))
+ do (loop until (= timeline-index (flexichain:nb-elements timelines))
+ for timeline = (flexichain:element* timelines timeline-index)
+ until (or (> (start-time timeline) start-time)
+ (and (= (start-time timeline) start-time)
+ (or (zerop (duration element))
+ ;; either none or every element of a timline
+ ;; has zero duration, so we only have to test
+ ;; the first one.
+ (not (zerop (duration (car (elements timeline))))))))
+ do (incf timeline-index))
+ do (when (or (= timeline-index (flexichain:nb-elements timelines))
+ (> (start-time (flexichain:element* timelines timeline-index))
+ start-time))
+ (let ((timeline (make-instance 'timeline
+ :start-time start-time)))
+ (flexichain:insert* timelines timeline-index timeline)))
+ do (let ((timeline (flexichain:element* timelines timeline-index)))
+ (push element (elements timeline))
+ (setf (timeline element) timeline)))))
+ (loop for bar in (measure-bars measure)
+ do (compute-bar-timelines bar)))
+ ;; compute the duration of each timeline except the last one
+ (loop for i from 0 below (1- (flexichain:nb-elements timelines))
+ do (setf (duration (flexichain:element* timelines i))
+ (- (start-time (flexichain:element* timelines (1+ i)))
+ (start-time (flexichain:element* timelines i)))))
+ ;; compute the duration of the last timeline, if any
+ (unless (zerop (flexichain:nb-elements timelines))
+ (let ((measure-duration (reduce #'max (measure-bars measure) :key #'duration))
+ (last-timeline (flexichain:element* timelines (1- (flexichain:nb-elements timelines)))))
+ (setf (duration last-timeline) (- measure-duration (start-time last-timeline)))))))
;;; Compute all the measures of a segment by stepping through all the
;;; bars in parallel as long as there is at least one simultaneous bar.
More information about the Gsharp-cvs
mailing list