Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv20560

Modified Files: drawing.lisp Log Message: Fixed the annoying bug that sometimes made spacing completely wrong in the presence of dotted notes.

Had to fix it twice, though, because there is code duplication in there. Some factoring would be a good idea at some point.

Date: Mon Feb 16 12:38:11 2004 Author: rstrandh

Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.2 gsharp/drawing.lisp:1.3 --- gsharp/drawing.lisp:1.2 Mon Feb 16 11:08:00 2004 +++ gsharp/drawing.lisp Mon Feb 16 12:38:10 2004 @@ -51,11 +51,11 @@

(defun compute-widths (measures method) (let* ((compress (compute-compress-factor measures method)) - (start-times (sort (remove-duplicates - (apply #'append (mapcar #'measure-start-times - measures))) - #'<)) - (min-dist (reduce #'min (gsharp-measure::abs-rel start-times)))) + (min-dists (mapcar (lambda (measure) + (reduce #'min (gsharp-measure::abs-rel + (measure-start-times measure)))) + measures)) + (min-dist (reduce #'min min-dists))) (loop for measure in measures collect (/ (nat-width method (measure-coeff measure) min-dist) compress)))) @@ -82,11 +82,11 @@

(defun draw-system (pane measures x widths method staves draw-cursor) (let* ((compress (compute-compress-factor measures method)) - (start-times (sort (remove-duplicates - (apply #'append (mapcar #'measure-start-times - measures))) - #'<)) - (min-dist (reduce #'min (gsharp-measure::abs-rel start-times)))) + (min-dists (mapcar (lambda (measure) + (reduce #'min (gsharp-measure::abs-rel + (measure-start-times measure)))) + measures)) + (min-dist (reduce #'min min-dists))) (loop for measure in measures for width in widths do (draw-measure pane measure min-dist compress x method draw-cursor)