Merge branch 'master' of ssh+git://hanwen@git.sv.gnu.org/srv/git/lilypond

[lilypond.git] / scm / stencil.scm

diff --git a/scm/stencil.scm b/scm/stencil.scm
index 62b43cebc260a13f4f2ec3402c99ba9475dbe4df..32a64fdedee300616c5cccca1490fe29beef80f4 100644 (file)
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -30,14 +30,33 @@
 
 (define-public (stack-lines dir padding baseline stils)
   "Stack vertically with a baseline-skip."
-  (if (null? stils)
-      empty-stencil
-      (if (null? (cdr stils))
-         (car stils)
-         (ly:stencil-combine-at-edge
-          (car stils) Y dir 
-          (stack-lines dir padding baseline (cdr stils))
-          padding baseline))))
+  (define result empty-stencil)
+  (define last-y #f)
+  (do
+      ((last-stencil #f (car p))
+       (p stils (cdr p)))
+      
+      ((null? p))
+
+    (if (number? last-y)
+       (begin
+         (let* ((dy (max (+ (* dir (interval-bound (ly:stencil-extent last-stencil Y) dir))
+                            padding
+                            (* (- dir) (interval-bound (ly:stencil-extent (car p) Y) (- dir))))
+                         baseline))
+                (y (+ last-y  (* dir dy))))
+           
+                         
+           
+           (set! result
+                 (ly:stencil-add result (ly:stencil-translate-axis (car p) y Y)))
+           (set! last-y y)))
+       (begin
+         (set! last-y 0)
+         (set! result (car p)))))
+
+  result)
+    
 
 (define-public (bracketify-stencil stil axis thick protusion padding)
   "Add brackets around STIL, producing a new stencil."
@@ -240,11 +259,11 @@ encloses the contents.
          (set! annotation
                 (center-stencil-on-extent text-stencil))
          (set! annotation
-               (ly:stencil-combine-at-edge arrows X RIGHT annotation 0.5 0))
+               (ly:stencil-combine-at-edge arrows X RIGHT annotation 0.5))
          (set! annotation
                (ly:stencil-combine-at-edge annotation X LEFT
                                             (center-stencil-on-extent dim-stencil)
-                                            0.5 0))
+                                            0.5))
          (set! annotation
                (ly:make-stencil (list 'color color (ly:stencil-expr annotation))
                                 (ly:stencil-extent annotation X)
@@ -255,14 +274,21 @@ encloses the contents.
 (define-public (eps-file->stencil axis size file-name)
   (let*
       ((contents (ly:gulp-file file-name))
-       (bbox (get-postscript-bbox contents))
+       (bbox (get-postscript-bbox (car (string-split contents #\nul))))
        (bbox-size (if (= axis X)
                      (- (list-ref bbox 2) (list-ref bbox 0))
                      (- (list-ref bbox 3) (list-ref bbox 1))
                      ))
        (factor (exact->inexact (/ size bbox-size)))
        (scaled-bbox
-       (map (lambda (x) (* factor x)) bbox)))
+       (map (lambda (x) (* factor x)) bbox))
+       (clip-rect-string (format
+                         "~a ~a ~a ~a rectclip"
+                         (list-ref bbox 0) 
+                         (list-ref bbox 1) 
+                         (- (list-ref bbox 2) (list-ref bbox 0))
+                         (- (list-ref bbox 3) (list-ref bbox 1)))))
+    
 
     (if bbox
        (ly:make-stencil
@@ -274,9 +300,11 @@ encloses the contents.
 gsave
 currentpoint translate
 BeginEPSF
-~a ~a scale
+~a dup scale
+~a 
 %%BeginDocument: ~a
-"         factor factor
+"         factor clip-rect-string
+
           file-name
           )
           contents
@@ -363,6 +391,7 @@ grestore
         (input (if (ly:stream-event? cause) (ly:event-property cause 'origin) #f))
         (location (if (ly:input-location? input) (ly:input-file-line-char-column input) '()))
 
+        ;; todo: use stencil extent if available.
         (x-ext (ly:grob-extent grob system-grob X))
         (y-ext (ly:grob-extent grob system-grob Y))
         )