fix dashed-slur, and test for it in backend-exercise.ly

[lilypond.git] / scm / stencil.scm

diff --git a/scm/stencil.scm b/scm/stencil.scm
index 567e0a3099a9c1bbb63a129b48793834ca7bf73c..463a082fd337e63e25230fc4fe89f70c3091206f 100644 (file)
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 2003--2006 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2003--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 (define-public (stack-stencils axis dir padding stils)
   "Stack stencils STILS in direction AXIS, DIR, using PADDING."
@@ -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."
@@ -100,9 +119,16 @@ encloses the contents.
         (y-ext (ly:stencil-extent stencil 1))
         (diameter (max (- (cdr x-ext) (car x-ext))
                        (- (cdr y-ext) (car y-ext))))
-        (radius (+ (/ diameter 2) padding thickness)))
+        (radius (+ (/ diameter 2) padding thickness))
+        (circle (make-circle-stencil radius thickness #f)))
+
     (ly:stencil-add
-     (centered-stencil stencil) (make-circle-stencil radius thickness #f))))
+     stencil
+     (ly:stencil-translate circle
+                          (cons
+                           (interval-center x-ext)
+                           (interval-center y-ext))))))
+
 
 (define-public (fontify-text font-metric text)
   "Set TEXT with font FONT-METRIC, returning a stencil."
@@ -111,13 +137,32 @@ encloses the contents.
      `(text ,font-metric ,text) (car b) (cdr b))))
      
 (define-public (fontify-text-white scale font-metric text)
-  "Set TEXT with scale factor s"
+  "Set TEXT with scale factor SCALE"
   (let* ((b (ly:text-dimension font-metric text))
         ;;urg -- workaround for using ps font
          (c `(white-text ,(* 2 scale) ,text)))
     ;;urg -- extent is not from ps font, but we hope it's close
     (ly:make-stencil c (car b) (cdr b))))
 
+(define-public (stencil-with-color stencil color)
+  (ly:make-stencil
+   (list 'color color (ly:stencil-expr stencil))
+   (ly:stencil-extent stencil X)
+   (ly:stencil-extent stencil Y)))
+  
+(define-public (stencil-whiteout stencil)
+  (let*
+      ((x-ext (ly:stencil-extent stencil X))
+       (y-ext (ly:stencil-extent stencil Y))
+
+       )
+    
+    (ly:stencil-add
+     (stencil-with-color (ly:round-filled-box x-ext y-ext 0.0)
+                        white)
+     stencil)
+    ))
+
 (define-public (dimension-arrows destination) 
   "Draw twosided arrow from here to @var{destination}"
   
@@ -214,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)