Fix some bugs in the dynamic engraver and PostScript backend

[lilypond.git] / scm / stencil.scm

diff --git a/scm/stencil.scm b/scm/stencil.scm
index 5f3413df8f64a24395a3334f207dd397446cd4c9..01694195714c8e3cbfbb3ac5c33f155b5c247971 100644 (file)
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -179,48 +179,52 @@ encloses the contents.
 ;; spacing variables 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define*-public (annotate-y-interval layout name extent is-length
-                                     #:key (color darkblue))
-  (let ((text-props (cons '((font-size . -3)
-                           (font-family . typewriter))
-                         (layout-extract-page-properties layout)))
-       (annotation #f))
-    (define (center-stencil-on-extent stil)
-      (ly:stencil-translate (ly:stencil-aligned-to stil Y CENTER)
-                            (cons 0 (interval-center extent))))
+(define-public (annotate-y-interval layout name extent is-length)
+  (let*
+      ((text-props (cons
+                   '((font-size . -3)
+                     (font-family . typewriter))
+                   (layout-extract-page-properties layout)))
+       (annotation #f)
+       )
+
     ;; do something sensible for 0,0 intervals. 
     (set! extent (interval-widen extent 0.001))
     (if (not (interval-sane? extent))
-       (set! annotation (interpret-markup
-                         layout text-props
-                         (make-simple-markup (format "~a: NaN/inf" name))))
-       (let ((text-stencil (interpret-markup
-                            layout text-props
-                             (markup #:whiteout #:simple name)))
-              (dim-stencil (interpret-markup
-                            layout text-props
-                            (markup #:whiteout
-                                    #:simple (cond
-                                              ((interval-empty? extent)
-                                               (format "empty"))
-                                              (is-length
-                                               (format "~$" (interval-length extent)))
-                                              (else
-                                               (format "(~$,~$)"
-                                                       (car extent) (cdr extent)))))))
-             (arrows (ly:stencil-translate-axis 
-                      (dimension-arrows (cons 0 (interval-length extent)))
-                      (interval-start extent) Y)))
+       (set! annotation (interpret-markup layout text-props
+                                          (make-simple-markup (format "~a: NaN/inf" name))))
+       (let*
+           ((text-stencil (interpret-markup
+                           layout text-props
+                           (make-column-markup
+                            (list
+                             (make-whiteout-markup (make-simple-markup name))
+                             (make-whiteout-markup
+                              (make-simple-markup
+                               (cond
+                                ((interval-empty? extent) "empty")
+                                (is-length (format "~$" (interval-length extent)))
+                                (else
+                                 (format "(~$,~$)" (car extent)
+                                         (cdr extent))))))))))
+            (arrows
+             (ly:stencil-translate-axis 
+              (dimension-arrows (cons 0 (interval-length extent)))
+              (interval-start extent) Y)))
+         
          (set! annotation
-                (center-stencil-on-extent text-stencil))
+               (ly:stencil-aligned-to text-stencil Y CENTER))
+         
+         (set! annotation (ly:stencil-translate
+                           annotation
+                           (cons 0 (interval-center extent))))
+         
+
          (set! annotation
                (ly:stencil-combine-at-edge arrows X RIGHT annotation 0.5 0))
+
          (set! annotation
-               (ly:stencil-combine-at-edge annotation X LEFT
-                                            (center-stencil-on-extent dim-stencil)
-                                            0.5 0))
-         (set! annotation
-               (ly:make-stencil (list 'color color (ly:stencil-expr annotation))
+               (ly:make-stencil (ly:stencil-expr annotation)
                                 (ly:stencil-extent annotation X)
                                 (cons 10000 -10000)))))
     annotation))
@@ -320,7 +324,7 @@ grestore
 
   (define (pythonic-string expr)
     "escape quotes and slashes for python consumption"
-    (regexp-substitute/global #f "([\n\\\\'\"])" (format "~a" expr) 'pre "\\" 1 'post))
+    (regexp-substitute/global #f "([\\\\'\"])" (format "~a" expr) 'pre "\\" 1 'post))
 
   (define (pythonic-pair expr)
     (format "(~a,~a)"
@@ -347,8 +351,8 @@ grestore
              "['~a', '~a', ~a, ~a, '~a'],\n"
              (cdr (assq 'name (ly:grob-property grob 'meta) ))
              (pythonic-string location)
-             (pythonic-pair (if (interval-empty? x-ext) '(1 . -1) x-ext))
-             (pythonic-pair (if (interval-empty? y-ext) '(1 . -1) y-ext))
+             (pythonic-pair (if (interval-empty? x-ext) '(0 . 0) x-ext))
+             (pythonic-pair (if (interval-empty? y-ext) '(0 . 0) y-ext))
              (pythonic-string collected))
       ))
 
@@ -379,8 +383,5 @@ grestore
                 output)
        (interpret-for-signature found-grob (lambda (x) #f)
                                 (ly:stencil-expr
-                                 (paper-system-stencil paper-system)))))
-
-  ;; should be superfluous, but leaking "too many open files"?
-  (close-port output))
+                                 (paper-system-stencil paper-system))))))