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

[Robert Strandh]

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

Modified Files:
	drawing.lisp elasticity.lisp 
Log Message:
Added comutation to determine what force needs to be applied to
a line to stretch it to the available line width.

Date: Wed Nov 30 03:37:06 2005
Author: rstrandh

Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.38 gsharp/drawing.lisp:1.39
--- gsharp/drawing.lisp:1.38	Wed Nov 30 01:22:54 2005
+++ gsharp/drawing.lisp	Wed Nov 30 03:37:05 2005
@@ -208,7 +208,8 @@
 			  (add-elasticities
 			   result
 			   (make-elementary-elasticity (smallest-gap timeline) (elasticity timeline))))
-		 finally (setf (elasticity-function measure) result))))
+		 finally (setf (elasticity-function measure) result)))
+  (reduce #'add-elasticities measures :key #'elasticity-function))
 
 (defun draw-measure (pane measure min-dist compress x method draw-cursor)
   (let* ((width (/ (nat-width method (measure-coeff measure) min-dist)
@@ -270,7 +271,11 @@
 	 (lambda (measures)
 	   (compute-elasticities measures method)
 	   (compute-gaps measures method pane)
-	   (compute-elasticity-functions measures method)
+	   (let* ((e-fun (compute-elasticity-functions measures method))
+		  (force (if (> (zero-force-size e-fun) (line-width method))
+			     0
+			     (force-at-size e-fun (line-width method)))))
+	     nil)
 	   (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/elasticity.lisp
diff -u gsharp/elasticity.lisp:1.2 gsharp/elasticity.lisp:1.3
--- gsharp/elasticity.lisp:1.2	Wed Nov 30 01:22:54 2005
+++ gsharp/elasticity.lisp	Wed Nov 30 03:37:05 2005
@@ -52,6 +52,9 @@
 required to obtain that size.  The size must be larger than the 
 size at zero force, as reported by zero-force-size"))
 
+(defgeneric size-at-force (elasticity force)
+  (:documentation "for a given force, return the size at that force"))
+
 (defclass elasticity ()
   ((zero-force-size :initarg :zero-force-size :reader zero-force-size)
    (elements :initform '() :initarg :elements :reader elements)))
@@ -124,10 +127,15 @@
 	    do (pop l))
       (+ current-force (/ (- size current-size) current-slope)))))
 
-
-
-	    
-	    
-    
-    
-    
+(defmethod size-at-force ((e elasticity) force)
+  (let ((l (elements e))
+	(current-size (zero-force-size e)))
+    (let ((current-force 0)
+	  (current-slope 0))
+      (loop until (or (null l)
+		      (>= (caar l) force))
+	    do (incf current-size (* current-slope (- (caar l) current-force)))
+	    do (setf current-force (caar l)
+		     current-slope (cdar l))
+	    do (pop l))
+      (+ current-size (* (- force current-force) current-slope)))))
\ No newline at end of file