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

[Robert Strandh]

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

Modified Files:
	drawing.lisp 
Log Message:
More code towards a better spacing algorithm.

Date: Tue Nov 29 04:05:25 2005
Author: rstrandh

Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.35 gsharp/drawing.lisp:1.36
--- gsharp/drawing.lisp:1.35	Mon Nov 28 05:25:34 2005
+++ gsharp/drawing.lisp	Tue Nov 29 04:05:24 2005
@@ -108,28 +108,87 @@
 (defgeneric right-bulge (element pane))
 
 (defmethod left-bulge ((element element) pane)
-  0)  
+  (score-pane:staff-step 1))
 
 (defmethod right-bulge ((element element) pane)
-  0)  
+  (score-pane:staff-step 1))
 
-(defun compute-gaps (measures method pane)
+(defun compute-gaps-adjacent-timelines (bars method pane)
+  (declare (ignore method))
+  (loop for bar in bars
+	do (loop for (e1 e2) on (elements bar)
+		 for t1 = (timeline e1)
+		 do (cond ((null e2)
+			   (when (flexichain:flexi-last-p t1)
+			     (setf (smallest-gap t1)
+				   (max (smallest-gap t1)
+					(right-bulge e1 pane)))))
+			  ((eq (flexichain:flexi-next t1)
+			       (timeline e2))
+			   (setf (smallest-gap t1)
+				 (max (smallest-gap t1)
+				      (+ (right-bulge e1 pane)
+					 (left-bulge e2 pane)))))))))
+
+(defun compute-gaps-separated-timelines (bars method pane)
   (declare (ignore method))
+  (flet ((handle-timelines (timelines element-gap)
+	   (let ((sum-gap (reduce #'+ timelines :key #'smallest-gap))
+		 (sum-elasticity (reduce #'+ timelines :key #'elasticity)))
+	     (unless (> sum-gap element-gap)
+	       (if (zerop sum-elasticity)
+		   (loop for timeline = (find (/ element-gap (length timelines))
+					      timelines
+					      :key #'smallest-gap
+					      :test #'<)
+			 until (null timeline)
+			 do (decf element-gap (smallest-gap timeline))
+			 do (setf timelines (remove timeline timelines :test #'eq))
+			 finally (let ((gap (/ element-gap (length timelines))))
+				   (loop for timeline in timelines
+					 do (setf (smallest-gap timeline) gap))))
+		   (loop for timeline = (let ((gap/elasticity (/ element-gap sum-elasticity)))
+					  (find-if (lambda (timeline)
+						     (> (smallest-gap timeline)
+							(* (elasticity timeline) gap/elasticity)))
+						   timelines))
+			 until (null timeline)
+			 do (decf element-gap (smallest-gap timeline))
+			 do (decf sum-elasticity (elasticity timeline))
+			 do (setf timelines (remove timeline timelines :test #'eq))
+			 finally (let ((gap/elasticity (/ element-gap sum-elasticity)))
+				   (loop for timeline in timelines
+					 do (setf (smallest-gap timeline)
+						  (* (elasticity timeline) gap/elasticity))))))))))
+    (loop for bar in bars
+	  do (loop for (e1 e2) on (elements bar)
+		   for t1 = (timeline e1)
+		   do (cond ((null e2)
+			     (unless (flexichain:flexi-last-p t1)
+			       (let ((timelines (loop for tl = t1 then (flexichain:flexi-next tl)
+						      collect tl
+						      until (flexichain:flexi-last-p tl))))
+				 (handle-timelines timelines (right-bulge e1 pane)))))
+			    ((not (eq (flexichain:flexi-next t1)
+				      (timeline e2)))
+			     (let ((timelines (loop for tl = t1 then (flexichain:flexi-next tl)
+						    until (eq tl (timeline e2))
+						    collect tl)))
+			       (handle-timelines timelines (+ (right-bulge e1 pane)
+							      (left-bulge e2 pane))))))))))
+
+(defun compute-gaps (measures method pane)
   (loop for measure in measures
-	do (loop for bar in (measure-bars measure)
-		 do (loop for (e1 e2) on (elements bar)
-			  for t1 = (timeline e1)
-			  do (cond ((null e2)
-				    (when (flexichain:flexi-last-p t1)
-				      (setf (smallest-gap t1)
-					    (max (smallest-gap t1)
-						 (right-bulge e1 pane)))))
-				   ((eq (flexichain:flexi-next t1)
-					(timeline e2))
-				    (setf (smallest-gap t1)
-					  (max (smallest-gap t1)
-					       (+ (right-bulge e1 pane)
-						  (left-bulge e2 pane))))))))))			  
+	;; initially, look only at adjacent elements whose
+	;; corrsponding timelines are also adjacent, and at the last
+	;; element of a bar, provided that its timeline is also the
+	;; last one in the measure
+	do (compute-gaps-adjacent-timelines (measure-bars measure) method pane)
+	
+	;; then look at adjacent elements whose corresponding
+	;; timelines are NOT adjacent, or the last element of a bar
+	;; whose corresponding timeline is not the last one in the meaure
+	do (compute-gaps-separated-timelines (measure-bars measure) method pane)))
 
 (defun draw-measure (pane measure min-dist compress x method draw-cursor)
   (let* ((width (/ (nat-width method (measure-coeff measure) min-dist)