Gets rid of oval stencil command

[lilypond.git] / scm / stencil.scm

diff --git a/scm/stencil.scm b/scm/stencil.scm
index 2f31d343f5d020b6e46cff7039123a2917a070f3..21d7bb86f9924f697df71b92e7d5cc3553ea53cc 100644 (file)
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2003--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2003--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -197,12 +197,20 @@ y@tie{}radius @code{y-radius}, and thickness @var{thickness} with fill
 defined by @code{fill}."
   (let*
       ((x-out-radius (+ x-radius (/ thickness 2.0)))
-       (y-out-radius (+ y-radius (/ thickness 2.0))) )
-
+       (y-out-radius (+ y-radius (/ thickness 2.0)))
+       (x-max x-radius)
+       (x-min (- x-radius))
+       (y-max y-radius)
+       (y-min (- y-radius))
+       (commands `(,(list 'moveto x-max 0)
+                   ,(list 'curveto x-max y-max x-min y-max x-min 0)
+                   ,(list 'curveto x-min y-min x-max y-min x-max 0)
+                   ,(list 'closepath)))
+       (command-list (fold-right append '() commands)))
   (ly:make-stencil
-   (list 'oval x-radius y-radius thickness fill)
-   (cons (- x-out-radius) x-out-radius)
-   (cons (- y-out-radius) y-out-radius))))
+    `(path ,thickness `(,@',command-list) 'round 'round ,fill)
+    (cons (- x-out-radius) x-out-radius)
+    (cons (- y-out-radius) y-out-radius))))
 
 (define-public
   (make-partial-ellipse-stencil
@@ -394,7 +402,6 @@ respectively."
                         (append prepend-origin (list 'closepath))
                         prepend-origin))
         (command-list (fold-right append '() final-path)))
-
   (ly:make-stencil
     `(path ,thickness
           `(,@',command-list)
@@ -658,43 +665,43 @@ with optional arrows of @code{max-size} on start and end controlled by
                                             (center-stencil-on-extent dim-stencil)
                                             0.5))
          (set! annotation
-               (ly:make-stencil (list 'color color (ly:stencil-expr annotation))
-                                (ly:stencil-extent annotation X)
-                                (cons 10000 -10000)))))
+               (stencil-with-color annotation color))))
     annotation))
 
 
-(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset prev-system-end
+;; TODO: figure out how to annotate padding nicely
+;; TODO: emphasize either padding or min-dist depending on which constraint was active
+(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset next-staff-Y
                                      #:key (base-color blue))
-  (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0)))
-        (space (get-spacing-var 'space))
+   (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0)))
+        (space (get-spacing-var 'basic-distance))
         (padding (get-spacing-var 'padding))
         (min-dist (get-spacing-var 'minimum-distance))
-        (contrast-color (append (cdr base-color) (list (car base-color)))))
+        (contrast-color (append (cdr base-color) (list (car base-color))))
+        (min-dist-blocks (<= (- start-Y-offset min-dist) next-staff-Y))
+        (min-dist-color (if min-dist-blocks contrast-color base-color))
+        (basic-annotation (annotate-y-interval layout
+                                               "basic-dist"
+                                               (cons (- start-Y-offset space) start-Y-offset)
+                                               #t
+                                               #:color (map (lambda (x) (* x 0.25)) base-color)))
+        (min-annotation (annotate-y-interval layout
+                                             "min-dist"
+                                             (cons (- start-Y-offset min-dist) start-Y-offset)
+                                             #t
+                                             #:color min-dist-color))
+        (extra-annotation (annotate-y-interval layout
+                                               "extra dist"
+                                               (cons next-staff-Y (- start-Y-offset min-dist))
+                                               #t
+                                               #:color (map (lambda (x) (* x 0.5)) min-dist-color))))
+
     (stack-stencils X RIGHT 0.0
                    (list
-                    (annotate-y-interval layout
-                                         "space"
-                                         (cons (- start-Y-offset space) start-Y-offset)
-                                         #t
-                                         #:color (map (lambda (x) (* x 0.25)) base-color))
-                    (annotate-y-interval layout
-                                         "min-dist"
-                                         (cons (- start-Y-offset min-dist) start-Y-offset)
-                                         #t
-                                         #:color (map (lambda (x) (* x 0.5)) base-color))
-                    (ly:stencil-add
-                     (annotate-y-interval layout
-                                          "bottom-of-extent"
-                                          (cons prev-system-end start-Y-offset)
-                                          #t
-                                          #:color base-color)
-                     (annotate-y-interval layout
-                                          "padding"
-                                          (cons (- prev-system-end padding) prev-system-end)
-                                          #t
-                                          #:color contrast-color))))))
-
+                    basic-annotation
+                    (if min-dist-blocks
+                        min-annotation
+                        (ly:stencil-add min-annotation extra-annotation))))))
 
 (define-public (eps-file->stencil axis size file-name)
   (let*