[gsharp-cvs] CVS update: gsharp/drawing.lisp

[Robert Strandh]

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)