+ (define (combine-penalties force user best-paths)
+ (let* ((prev-force (if (null? best-paths)
+ 0.0
+ (node-force (car best-paths))))
+ (prev-penalty (if (null? best-paths)
+ 0.0
+ (node-penalty (car best-paths))))
+ (inter-system-space (ly:output-def-lookup paper 'betweensystemspace))
+ (force-equalization-factor 0.3)
+ (relative-force (/ force inter-system-space))
+ (abs-relative-force (abs relative-force)))
+
+
+ (+ (* abs-relative-force (+ abs-relative-force 1))
+ prev-penalty
+ (* force-equalization-factor (/ (abs (- prev-force force)) inter-system-space))
+ user)))
+
+ (define (space-systems page-height lines ragged?)
+ (let* ((inter-system-space
+ (ly:output-def-lookup paper 'betweensystemspace))
+ (system-vector (list->vector
+ (append lines
+ (if (= (length lines) 1)
+ '(#f)
+ '()))))
+ (staff-extents
+ (list->vector
+ (append (map ly:paper-system-staff-extents lines)
+ (if (= (length lines) 1)
+ '((0 . 0))
+ '()))))
+ (real-extents
+ (list->vector
+ (append
+ (map
+ (lambda (sys) (ly:paper-system-extent sys Y)) lines)
+ (if (= (length lines) 1)
+ '((0 . 0))
+ '()))))
+ (no-systems (vector-length real-extents))
+ (topskip (interval-end (vector-ref real-extents 0)))
+ (space-left (- page-height
+ (apply + (map interval-length (vector->list real-extents)))))
+
+ (space (- page-height
+ topskip
+ (- (interval-start (vector-ref real-extents (1- no-systems))))))
+
+ (fixed-dist (ly:output-def-lookup paper 'betweensystempadding))
+ (calc-spring
+ (lambda (idx)
+ (let* ((this-system-ext (vector-ref staff-extents idx))
+ (next-system-ext (vector-ref staff-extents (1+ idx)))
+ (fixed (max 0 (- (+ (interval-end next-system-ext)
+ fixed-dist)
+ (interval-start this-system-ext))))
+ (title1? (and (vector-ref system-vector idx)
+ (ly:paper-system-title? (vector-ref system-vector idx))))
+ (title2? (and
+ (vector-ref system-vector (1+ idx))
+ (ly:paper-system-title? (vector-ref system-vector (1+ idx)))))
+ (ideal (+
+ (cond
+ ((and title2? title1?)
+ (ly:output-def-lookup paper 'betweentitlespace))
+ (title1?
+ (ly:output-def-lookup paper 'aftertitlespace))
+ (title2?
+ (ly:output-def-lookup paper 'beforetitlespace))
+ (else inter-system-space))
+ fixed))
+ (hooke (/ 1 (- ideal fixed))))
+ (list ideal hooke))))
+
+ (springs (map calc-spring (iota (1- no-systems))))
+ (calc-rod
+ (lambda (idx)
+ (let* ((this-system-ext (vector-ref real-extents idx))
+ (next-system-ext (vector-ref real-extents (1+ idx)))
+ (distance (max (- (+ (interval-end next-system-ext)
+ fixed-dist)
+ (interval-start this-system-ext)
+ ) 0))
+ (entry (list idx (1+ idx) distance)))
+ entry)))
+ (rods (map calc-rod (iota (1- no-systems))))
+
+ ;; we don't set ragged based on amount space left.
+ ;; raggedbottomlast = ##T is much more predictable
+ (result (ly:solve-spring-rod-problem
+ springs rods space
+ ragged?))
+
+ (force (car result))
+ (positions
+ (map (lambda (y)
+ (+ y topskip))
+ (cdr result))))
+
+ (if #f ;; debug.
+ (begin
+ (display (list "\n# systems: " no-systems
+ "\nreal-ext" real-extents "\nstaff-ext" staff-extents
+ "\ninterscore" inter-system-space
+ "\nspace-letf" space-left
+ "\nspring,rod" springs rods
+ "\ntopskip " topskip
+ " space " space
+ "\npage-height" page-height
+ "\nragged" ragged?
+ "\nforce" force
+ "\nres" (cdr result)
+ "\npositions" positions "\n"))))
+
+ (cons force positions)))