Merge branch 'lilypond/translation' of ssh://git.sv.gnu.org/srv/git/lilypond into...

[lilypond.git] / scm / paper-system.scm

diff --git a/scm/paper-system.scm b/scm/paper-system.scm
index eec080e253d8b4521aa63be7d69f59ecd6e6e1aa..d7436a224fef055c6ce80953e55eede70d064f1c 100644 (file)
--- a/scm/paper-system.scm
+++ b/scm/paper-system.scm
@@ -17,11 +17,22 @@
 (define-public (paper-system-stencil system)
   (ly:prob-property system 'stencil))
 
+(define-public (paper-system-layout system)
+  (let*
+      ((g (paper-system-system-grob system)))
+
+    (if (ly:grob? g)
+       (ly:grob-layout  g)
+       #f)))
+
+(define-public (paper-system-system-grob paper-system)
+  (ly:prob-property paper-system 'system-grob))
+
 (define-public (paper-system-extent system axis)
   (ly:stencil-extent (paper-system-stencil system) axis))
 
 (define-public (paper-system-staff-extents ps)
-  (ly:prob-property ps 'refpoint-Y-extent '(0 . 0)))
+  (ly:prob-property ps 'staff-refpoint-extent '(0 . 0)))
 
 (define-public (paper-system-annotate-last system layout)
   (let*
@@ -45,60 +56,45 @@
     (set! (ly:prob-property system 'stencil)
          stencil)
   ))
-  
-(define-public (paper-system-annotate system layout)
-  "Add arrows and texts to indicate which lengths are set."
-  (let*
-      ((annotations (ly:make-stencil '() (cons 0 2) (cons 0 0)))
-       (append-stencil
-       (lambda (a b)
-         (ly:stencil-combine-at-edge a X RIGHT b 0.5 0)))
-
-       (annotate-property
-       (lambda (name extent is-length?)
-         (set! annotations
-               (append-stencil annotations
-                               (annotate-y-interval layout
-                                                    name extent is-length?)))))
 
-       (bbox-extent (paper-system-extent system Y))
-       (refp-extent (ly:prob-property system 'refpoint-Y-extent))
-       (next-space (ly:prob-property system 'next-space
-                                            (ly:output-def-lookup layout 'between-system-space)
-                                            ))
-       (next-padding (ly:prob-property system 'next-padding
-                                              (ly:output-def-lookup layout 'between-system-padding)
-                                              ))
-                    
-       )
-
-    (if (number-pair? bbox-extent)
-       (begin
-         (annotate-property  "Y-extent"
-                              bbox-extent #f)
-         (annotate-property  "next-padding"
-                            (interval-translate (cons (- next-padding) 0) (car bbox-extent))
-                            #t)))
-    
-    ;; titles don't have a refpoint-Y-extent.
-    (if (number-pair? refp-extent)
-       (begin
-         (annotate-property "refpoint-Y-extent"
-                            refp-extent #f)
-       
-         (annotate-property "next-space"
-                            (interval-translate (cons (- next-space) 0) (car refp-extent))
-                      #t)))
-       
-    
+; TODO: annotate the spacing for every spaceable staff within the system.
+(define-public (paper-system-annotate system next-system layout)
+  "Add arrows and texts to indicate which lengths are set."
+  (let* ((annotations (list))
+        (grob (ly:prob-property system 'system-grob))
+        (estimate-extent (if (ly:grob? grob)
+                             (annotate-y-interval layout
+                                                  "extent-estimate"
+                                                  (ly:grob-property grob 'pure-Y-extent)
+                                                  #f)
+                             #f)))
+    (let* ((spacing-spec (cond ((and next-system
+                                    (paper-system-title? system)
+                                    (paper-system-title? next-system))
+                               (ly:output-def-lookup layout 'between-title-spacing))
+                              ((paper-system-title? system)
+                               (ly:output-def-lookup layout 'after-title-spacing))
+                              ((and next-system
+                                    (paper-system-title? next-system))
+                               (ly:output-def-lookup layout 'before-title-spacing))
+                              (else
+                               (ly:output-def-lookup layout 'between-system-spacing))))
+          (last-staff-Y (car (paper-system-staff-extents system))))
 
-    (set! (ly:prob-property system 'stencil)
-         (ly:stencil-add
-          (ly:prob-property system 'stencil)
-          (ly:make-stencil
-           (ly:stencil-expr annotations)
-           (ly:stencil-extent empty-stencil X)
-           (ly:stencil-extent empty-stencil Y)
-           )))
-    
-    ))
+      (set! annotations
+           (annotate-spacing-spec layout spacing-spec last-staff-Y (car (paper-system-extent system Y)))))
+    (if estimate-extent
+       (set! annotations
+             (stack-stencils X RIGHT 0.5
+                             (list annotations
+                                   estimate-extent))))
+                               
+    (if (not (null? annotations))
+       (set! (ly:prob-property system 'stencil)
+             (ly:stencil-add
+              (ly:prob-property system 'stencil)
+              (ly:make-stencil
+               (ly:stencil-expr annotations)
+               (ly:stencil-extent empty-stencil X)
+               (ly:stencil-extent empty-stencil Y)))))
+    (ly:prob-property system 'stencil)))