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.