Merge branch 'master' into lilypond/translation

[lilypond.git] / scm / stencil.scm

diff --git a/scm/stencil.scm b/scm/stencil.scm
index db35a5ecc54af4228b43c2bcb2b5b72ef8f86603..19303ae691bc85d1499de93ae24b19dc01161244 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@xs4all.nl>
+;;;; (c) 2003--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 (define-public (stack-stencils axis dir padding stils)
   "Stack stencils STILS in direction AXIS, DIR, using PADDING."
@@ -70,6 +70,17 @@
          (ly:stencil-combine-at-edge stil (other-axis axis) -1 rb padding))
     stil))
 
+(define-public (make-line-stencil width startx starty endx endy)
+  "Make a line stencil of given linewidth and set its extents accordingly"
+  (let ((xext (cons (min startx endx) (max startx endx)))
+        (yext (cons (min starty endy) (max starty endy))))
+    (ly:make-stencil
+      (list 'draw-line width startx starty endx endy)
+      ; Since the line has rounded edges, we have to / can safely add half the 
+      ; width to all coordinates!
+      (interval-widen xext (/ width 2))
+      (interval-widen yext (/ width 2)))))
+
 (define-public (make-filled-box-stencil xext yext)
   "Make a filled box."
   
@@ -80,10 +91,13 @@
 
 (define-public (make-circle-stencil radius thickness fill)
   "Make a circle of radius @var{radius} and thickness @var{thickness}"
+  (let*
+      ((out-radius (+ radius (/ thickness 2.0))))
+    
   (ly:make-stencil
    (list 'circle radius thickness fill) 
-   (cons (- radius) radius)
-   (cons (- radius) radius)))
+   (cons (- out-radius) out-radius)
+   (cons (- out-radius) out-radius))))
 
 (define-public (box-grob-stencil grob)
   "Make a box of exactly the extents of the grob.  The box precisely
@@ -91,8 +105,8 @@ encloses the contents.
 "
   (let* ((xext (ly:grob-extent grob grob 0))
         (yext (ly:grob-extent grob grob 1))
-        (thick 0.1))
-    
+        (thick 0.01))
+
     (ly:stencil-add
      (make-filled-box-stencil xext (cons (- (car yext) thick) (car yext)))
      (make-filled-box-stencil xext (cons (cdr yext) (+ (cdr yext) thick)))
@@ -129,6 +143,24 @@ encloses the contents.
                            (interval-center x-ext)
                            (interval-center y-ext))))))
 
+(define-public (rounded-box-stencil stencil thickness padding blot)
+   "Add a rounded box around STENCIL, producing a new stencil."  
+
+  (let* ((xext (interval-widen (ly:stencil-extent stencil 0) padding))
+        (yext (interval-widen (ly:stencil-extent stencil 1) padding))
+   (min-ext (min (-(cdr xext) (car xext)) (-(cdr yext) (car yext))))
+   (ideal-blot (min blot (/ min-ext 2)))
+   (ideal-thickness (min thickness (/ min-ext 2)))
+        (outer (ly:round-filled-box
+            (interval-widen xext ideal-thickness) 
+            (interval-widen yext ideal-thickness) 
+               ideal-blot))
+        (inner (ly:make-stencil (list 'color (x11-color 'white) 
+            (ly:stencil-expr (ly:round-filled-box 
+               xext yext (- ideal-blot ideal-thickness)))))))
+    (set! stencil (ly:stencil-add outer inner))
+    stencil))
+
 
 (define-public (fontify-text font-metric text)
   "Set TEXT with font FONT-METRIC, returning a stencil."
@@ -279,7 +311,9 @@ encloses the contents.
                      (- (list-ref bbox 2) (list-ref bbox 0))
                      (- (list-ref bbox 3) (list-ref bbox 1))
                      ))
-       (factor (exact->inexact (/ size bbox-size)))
+       (factor (if (< 0 bbox-size)
+                  (exact->inexact (/ size bbox-size))
+                  0))
        (scaled-bbox
        (map (lambda (x) (* factor x)) bbox))
        (clip-rect-string (ly:format