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