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

[Robert Strandh]

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

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

Date: Mon Nov 28 05:25:35 2005
Author: rstrandh

Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.34 gsharp/drawing.lisp:1.35
--- gsharp/drawing.lisp:1.34	Mon Nov 21 23:40:48 2005
+++ gsharp/drawing.lisp	Mon Nov 28 05:25:34 2005
@@ -96,6 +96,41 @@
 	  collect (/ (nat-width method (measure-coeff measure) min-dist)
 		     compress))))
 
+(defun compute-elasticities (measures method)
+  (loop for measure in measures
+	do (loop with timelines = (timelines measure)
+		 for i from 0 below (flexichain:nb-elements timelines)
+		 for timeline = (flexichain:element* timelines i)
+		 do (setf (elasticity timeline)
+			  (expt (duration timeline) (spacing-style method))))))
+
+(defgeneric left-bulge (element pane))
+(defgeneric right-bulge (element pane))
+
+(defmethod left-bulge ((element element) pane)
+  0)  
+
+(defmethod right-bulge ((element element) pane)
+  0)  
+
+(defun compute-gaps (measures method pane)
+  (declare (ignore method))
+  (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))))))))))			  
+
 (defun draw-measure (pane measure min-dist compress x method draw-cursor)
   (let* ((width (/ (nat-width method (measure-coeff measure) min-dist)
 		   compress))
@@ -154,6 +189,8 @@
       (let ((yy y))
 	(gsharp-measure::new-map-over-obseq-subsequences
 	 (lambda (measures)
+	   (compute-elasticities measures method)
+	   (compute-gaps measures method pane)
 	   (let ((widths (compute-widths measures method)))
 	     (score-pane:with-vertical-score-position (pane yy)
 	       (draw-system pane measures (+ x (left-offset buffer) timesig-offset)


Index: gsharp/measure.lisp
diff -u gsharp/measure.lisp:1.15 gsharp/measure.lisp:1.16
--- gsharp/measure.lisp:1.15	Mon Nov 28 03:32:06 2005
+++ gsharp/measure.lisp	Mon Nov 28 05:25:34 2005
@@ -48,7 +48,7 @@
 
 (defrclass relement element
   ((duration :initform nil)
-   (timeline :accessor timeline)))
+   (timeline :accessor timeline)))   
 
 (defmethod duration :around ((element relement))
   (with-slots (duration) element
@@ -393,7 +393,10 @@
   ((start-time :initarg :start-time :reader start-time)
    (elements :initform '() :accessor elements)
    (duration :initarg :duration :reader duration)
-   (elasticity :accessor elasticity)))
+   (elasticity :accessor elasticity)
+   ;; the minimum x offset from this timeline to the next, or, if this
+   ;; is the last timeline, from this one to the end of the measure
+   (smallest-gap :initform 0 :accessor smallest-gap)))
 
 (defclass ranked-flexichain (flexichain:standard-flexichain flexichain:flexirank-mixin)
   ())
@@ -464,7 +467,7 @@
 (defmethod measures :before ((segment rsegment))
   (when (modified-p segment)
     (compute-measures segment (spacing-style (buffer-cost-method (buffer segment))))
-    (mapc #'compute-timelines (measures segment))
+    (mapc #'compute-timelines (slot-value segment 'measures))
     (setf (modified-p segment) nil)))
 
 (defmethod nb-measures ((segment rsegment))


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.34 gsharp/packages.lisp:1.35
--- gsharp/packages.lisp:1.34	Mon Nov 21 23:40:48 2005
+++ gsharp/packages.lisp	Mon Nov 28 05:25:34 2005
@@ -133,7 +133,9 @@
 	   #:top-note #:bot-note #:top-note-pos #:bot-note-pos
 	   #:beam-groups #:final-stem-direction
 	   #:group-notes-by-staff #:final-relative-note-xoffset
-	   #:final-accidental #:final-relative-accidental-xoffset))
+	   #:final-accidental #:final-relative-accidental-xoffset
+	   #:timeline #:timelines #:elasticity
+	   #:smallest-gap))
 
 (defpackage :gsharp-postscript
   (:use :clim :clim-lisp)