* The grand 2005-2006 replace.

[lilypond.git] / scm / stencil.scm

diff --git a/scm/stencil.scm b/scm/stencil.scm
index 8b193ce15d290c043f78d99006179ff3f5ca6185..1aff0c12ff09ef8cd8b65fb0c650f2597eadd7c4 100644 (file)
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 2003--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2003--2006 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 (define-public (stack-stencils axis dir padding stils)
   "Stack stencils STILS in direction AXIS, DIR, using PADDING."
@@ -53,14 +53,14 @@
   "Make a filled box."
   
   (ly:make-stencil
-      (list 'filledbox (- (car xext)) (cdr xext)
-                       (- (car yext)) (cdr yext))
+      (list 'round-filled-box (- (car xext)) (cdr xext)
+                       (- (car yext)) (cdr yext) 0.0)
       xext yext))
 
-(define-public (make-circle-stencil radius thickness)
+(define-public (make-circle-stencil radius thickness fill)
   "Make a circle of radius @var{radius} and thickness @var{thickness}"
   (ly:make-stencil
-   (list 'circle radius thickness)
+   (list 'circle radius thickness fill) 
    (cons (- radius) radius)
    (cons (- radius) radius)))
 
@@ -100,7 +100,7 @@ encloses the contents.
                        (- (cdr y-ext) (car y-ext))))
         (radius (+ (/ diameter 2) padding thickness)))
     (ly:stencil-add
-     (centered-stencil stencil) (make-circle-stencil radius thickness))))
+     (centered-stencil stencil) (make-circle-stencil radius thickness #f))))
 
 (define-public (fontify-text font-metric text)
   "Set TEXT with font FONT-METRIC, returning a stencil."
@@ -115,3 +115,57 @@ encloses the contents.
          (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 (dimension-arrows destination) 
+  "Draw twosided arrow from here to @var{destination}"
+  
+  (let*
+      ((e_x 1+0i)
+       (e_y 0+1i)
+       (rotate (lambda (z ang)
+                (* (make-polar 1 ang)
+                   z)))
+       (complex-to-offset (lambda (z)
+                           (list (real-part z) (imag-part z))))
+       
+       (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))
+       (p1s (map (lambda (z)
+                  (+ z-dest (rotate z (angle z-dest))))
+                triangle-points))
+       (p2s (map (lambda (z)
+                  (rotate z (angle (- z-dest))))
+                  triangle-points))
+       (null (cons 0 0)) 
+       (arrow-1  
+       (ly:make-stencil
+        `(polygon (quote ,(concatenate (map complex-to-offset p1s)))
+                  0.0
+                  #t) null null))
+       (arrow-2
+       (ly:make-stencil
+        `(polygon (quote ,(concatenate (map complex-to-offset p2s)))
+                  0.0
+                  #t) null null ) )
+       (thickness 0.1)
+       (shorten-line 0.5)
+       (start (complex-to-offset (/ (* e_z shorten-line) 2)))
+       (end (complex-to-offset (- z-dest (/ (* e_z shorten-line) 2))))
+       
+       (line (ly:make-stencil
+             `(draw-line ,thickness
+                         ,(car start) ,(cadr start)
+                         ,(car end) ,(cadr end)
+                         )
+             (cons (min 0 (car destination))
+                   (min 0 (cdr destination)))
+             (cons (max 0 (car destination))
+                   (max 0 (cdr destination)))))
+                   
+       (result (ly:stencil-add arrow-2 arrow-1 line)))
+
+
+    result))