X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fstencil.scm;h=94332b31b4895d22257022c3b79f000568b8b443;hb=b3f0c2f6c352a850f03dc44a947776199eb3fa0b;hp=047c0d0bb9622a2d514da8360bcca871e14f636b;hpb=a6a4b3fc2009f17a1a48cca0c11bfd3f38645937;p=lilypond.git

diff --git a/scm/stencil.scm b/scm/stencil.scm
index 047c0d0bb9..94332b31b4 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 2003--2008 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; (c) 2003--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 (define-public (stack-stencils axis dir padding stils)
   "Stack stencils STILS in direction AXIS, DIR, using PADDING."
@@ -81,6 +81,7 @@
       (interval-widen xext (/ width 2))
       (interval-widen yext (/ width 2)))))
 
+
 (define-public (make-filled-box-stencil xext yext)
   "Make a filled box."
   
@@ -260,12 +261,15 @@ encloses the contents.
      stencil)
     ))
 
-(define-public (dimension-arrows destination) 
+(define-public (dimension-arrows destination max-size) 
   "Draw twosided arrow from here to @var{destination}"
   
   (let*
       ((e_x 1+0i)
        (e_y 0+1i)
+       (distance (sqrt (+ (* (car destination) (car destination))
+			  (* (cdr destination) (cdr destination)))))
+       (size (min max-size (/ distance 3)))
        (rotate (lambda (z ang)
 		 (* (make-polar 1 ang)
 		    z)))
@@ -274,9 +278,10 @@ encloses the contents.
        
        (z-dest (+ (* e_x (car destination)) (* e_y (cdr destination))))
        (e_z (/ z-dest (magnitude z-dest)))
-       (triangle-points '(-1+0.25i
-			  0
-			  -1-0.25i))
+       (triangle-points (list
+			 (* size -1+0.25i)
+			 0
+			 (* size -1-0.25i)))
        (p1s (map (lambda (z)
 		   (+ z-dest (rotate z (angle z-dest))))
 		 triangle-points))
@@ -294,8 +299,8 @@ encloses the contents.
 	 `(polygon (quote ,(concatenate (map complex-to-offset p2s)))
 		   0.0
 		   #t) null null ) )
-       (thickness 0.1)
-       (shorten-line 0.5)
+       (thickness (min (/ distance 12) 0.1))
+       (shorten-line (min (/ distance 3) 0.5))
        (start (complex-to-offset (/ (* e_z shorten-line) 2)))
        (end (complex-to-offset (- z-dest (/ (* e_z shorten-line) 2))))
        
@@ -351,7 +356,7 @@ encloses the contents.
                                                (ly:format "(~$,~$)"
                                                        (car extent) (cdr extent)))))))
 	      (arrows (ly:stencil-translate-axis 
-		       (dimension-arrows (cons 0 (interval-length extent)))
+		       (dimension-arrows (cons 0 (interval-length extent)) 1.0)
 		       (interval-start extent) Y)))
 	  (set! annotation
                 (center-stencil-on-extent text-stencil))
@@ -368,6 +373,38 @@ encloses the contents.
     annotation))
 
 
+(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset prev-system-end
+				      #:key (base-color blue))
+  (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0)))
+	 (space (get-spacing-var 'space))
+	 (padding (get-spacing-var 'padding))
+	 (min-dist (get-spacing-var 'minimum-distance))
+	 (contrast-color (append (cdr base-color) (list (car base-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))))))
+
+
 (define-public (eps-file->stencil axis size file-name)
   (let*
       ((contents (ly:gulp-file file-name))
@@ -381,6 +418,9 @@ encloses the contents.
 		   0))
        (scaled-bbox
 	(map (lambda (x) (* factor x)) bbox))
+       ; We need to shift the whole eps to (0,0), otherwise it will appear 
+       ; displaced in lilypond (displacement will depend on the scaling!)
+       (translate-string (ly:format "~a ~a translate" (- (list-ref bbox 0)) (- (list-ref bbox 1))))
        (clip-rect-string (ly:format
 			  "~a ~a ~a ~a rectclip"
 			  (list-ref bbox 0) 
@@ -401,8 +441,9 @@ currentpoint translate
 BeginEPSF
 ~a dup scale
 ~a 
+~a
 %%BeginDocument: ~a
-" 	   factor clip-rect-string
+"         factor translate-string  clip-rect-string
 
 	   file-name
 	   )
@@ -411,9 +452,10 @@ BeginEPSF
 EndEPSF
 grestore
 "))
-	
-	 (cons (list-ref scaled-bbox 0) (list-ref scaled-bbox 2))
-	 (cons (list-ref scaled-bbox 1) (list-ref scaled-bbox 3)))
+	 ; Stencil starts at (0,0), since we have shifted the eps, and its 
+         ; size is exactly the size of the scaled bounding box
+	 (cons 0 (- (list-ref scaled-bbox 2) (list-ref scaled-bbox 0)))
+	 (cons 0 (- (list-ref scaled-bbox 3) (list-ref scaled-bbox 1))))
 	
 	(ly:make-stencil "" '(0 . 0) '(0 . 0)))
     ))