[gsharp-cvs] CVS update: gsharp/drawing.lisp
Robert Strandh
rstrandh at common-lisp.net
Mon Feb 16 17:38:11 UTC 2004
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)
More information about the Gsharp-cvs
mailing list