X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fstencil.scm;h=047c0d0bb9622a2d514da8360bcca871e14f636b;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=fb46ef7251cf7eef4733eeff09711ced4da1b44a;hpb=d461778d6fd14bf62f726fe795e2ef542e2133c1;p=lilypond.git

diff --git a/scm/stencil.scm b/scm/stencil.scm
index fb46ef7251..047c0d0bb9 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 2003--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; (c) 2003--2008 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."
   
@@ -88,14 +99,39 @@
    (cons (- out-radius) out-radius)
    (cons (- out-radius) out-radius))))
 
+(define-public (make-oval-stencil x-radius y-radius thickness fill)
+  "Make an oval from two Bezier curves, of x radius @var{x-radius}, 
+    y 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))) )
+    
+  (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))))
+
+(define-public (make-ellipse-stencil x-radius y-radius thickness fill)
+  "Make an ellipse of x radius @var{x-radius}, y 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))) )
+    
+  (ly:make-stencil
+   (list 'ellipse x-radius y-radius thickness fill) 
+   (cons (- x-out-radius) x-out-radius)
+   (cons (- y-out-radius) y-out-radius))))
+
 (define-public (box-grob-stencil grob)
   "Make a box of exactly the extents of the grob.  The box precisely
 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)))
@@ -118,10 +154,10 @@ encloses the contents.
 
 (define-public (circle-stencil stencil thickness padding)
   "Add a circle around STENCIL, producing a new stencil."
-  (let* ((x-ext (ly:stencil-extent stencil 0))
-	 (y-ext (ly:stencil-extent stencil 1))
-	 (diameter (max (- (cdr x-ext) (car x-ext))
-			(- (cdr y-ext) (car y-ext))))
+  (let* ((x-ext (ly:stencil-extent stencil X))
+	 (y-ext (ly:stencil-extent stencil Y))
+	 (diameter (max (interval-length x-ext)
+                        (interval-length y-ext))) 
 	 (radius (+ (/ diameter 2) padding thickness))
 	 (circle (make-circle-stencil radius thickness #f)))
 
@@ -132,6 +168,46 @@ encloses the contents.
 			    (interval-center x-ext)
 			    (interval-center y-ext))))))
 
+(define-public (oval-stencil stencil thickness x-padding y-padding)
+  "Add an oval around @code{stencil}, padded by the padding pair, 
+   producing a new stencil."
+  (let* ((x-ext (ly:stencil-extent stencil X))
+	 (y-ext (ly:stencil-extent stencil Y))
+         (x-length (+ (interval-length x-ext) x-padding thickness))
+         (y-length (+ (interval-length y-ext) y-padding thickness))
+         (x-radius (* 0.707 x-length) )
+         (y-radius (* 0.707 y-length) )
+	 (oval (make-oval-stencil x-radius y-radius thickness #f)))
+
+    (ly:stencil-add
+     stencil
+     (ly:stencil-translate oval
+			   (cons
+			    (interval-center x-ext)
+			    (interval-center y-ext))))))
+
+(define-public (ellipse-stencil stencil thickness x-padding y-padding)
+  "Add an ellipse around STENCIL, padded by the padding pair, 
+   producing a new stencil."
+  (let* ((x-ext (ly:stencil-extent stencil X))
+	 (y-ext (ly:stencil-extent stencil Y))
+         (x-length (+ (interval-length x-ext) x-padding thickness))
+         (y-length (+ (interval-length y-ext) y-padding thickness))
+         ;(aspect-ratio (/ x-length y-length))
+         (x-radius (* 0.707 x-length) )
+         (y-radius (* 0.707 y-length) )
+	 ;(diameter (max (- (cdr x-ext) (car x-ext))
+	 ;		(- (cdr y-ext) (car y-ext))))
+	 ;(radius (+ (/ diameter 2) padding thickness))
+	 (ellipse (make-ellipse-stencil x-radius y-radius thickness #f)))
+
+    (ly:stencil-add
+     stencil
+     (ly:stencil-translate ellipse
+			   (cons
+			    (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."