[gsharp-cvs] CVS update: gsharp/drawing.lisp
Robert Strandh
rstrandh at common-lisp.net
Fri Feb 20 08:39:04 UTC 2004
Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv21473
Modified Files:
drawing.lisp
Log Message:
Introduced new function `compute-min-dist' in order to factor previously
duplicated code.
Date: Fri Feb 20 03:39:03 2004
Author: rstrandh
Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.3 gsharp/drawing.lisp:1.4
--- gsharp/drawing.lisp:1.3 Mon Feb 16 12:38:10 2004
+++ gsharp/drawing.lisp Fri Feb 20 03:39:03 2004
@@ -49,13 +49,16 @@
(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-dists (mapcar (lambda (measure)
- (reduce #'min (gsharp-measure::abs-rel
- (measure-start-times measure))))
- measures))
- (min-dist (reduce #'min min-dists)))
+ (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))))
@@ -81,12 +84,8 @@
(with-light-glyphs pane (draw-bar pane bar x width time-alist draw-cursor))))))
(defun draw-system (pane measures x widths method staves draw-cursor)
- (let* ((compress (compute-compress-factor measures method))
- (min-dists (mapcar (lambda (measure)
- (reduce #'min (gsharp-measure::abs-rel
- (measure-start-times measure))))
- measures))
- (min-dist (reduce #'min min-dists)))
+ (let ((compress (compute-compress-factor measures method))
+ (min-dist (compute-min-dist measures)))
(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