From: Carl Sorensen <c_sorensen@byu.edu>
Date: Thu, 11 Sep 2008 22:59:00 +0000 (-0600)
Subject: Add bezier oval for harp pedal diagrams
X-Git-Tag: release/2.11.59-1~25
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=e9d68c099f03166dbd3c82f753b314a25ddc40cf;p=lilypond.git

Add bezier oval for harp pedal diagrams
---

diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps
index aa8cfa6527..c6f4423615 100644
--- a/ps/music-drawing-routines.ps
+++ b/ps/music-drawing-routines.ps
@@ -165,6 +165,20 @@ bind def
 	ifelse
 } bind def
 
+/draw_oval % filled? x-radius y-radius thickness draw_ellipse
+{
+  setlinewidth % f? x-r y-r
+  /yrad exch def
+  /xrad exch def
+  xrad 0 rmoveto
+  0 yrad -2 xrad mul dup yrad exch 0 rcurveto
+  0 yrad neg dup 2 xrad mul dup 3 1 roll 0 rcurveto
+  closepath
+      { stroke_and_fill}
+      { stroke }
+  ifelse
+} bind def
+
 /draw_ellipse % filled? x-radius y-radius thickness draw_ellipse
 {
   setlinewidth % f? x-r y-r
diff --git a/scm/define-stencil-commands.scm b/scm/define-stencil-commands.scm
index 9a5bed1a9e..132686ce47 100644
--- a/scm/define-stencil-commands.scm
+++ b/scm/define-stencil-commands.scm
@@ -21,6 +21,7 @@
        embedded-ps
        glyph-string
        named-glyph
+       oval
        path
        polygon
        repeat-slash
diff --git a/scm/harp-pedals.scm b/scm/harp-pedals.scm
index fef1760db5..9af6e04dd2 100644
--- a/scm/harp-pedals.scm
+++ b/scm/harp-pedals.scm
@@ -157,7 +157,7 @@ divider) and @code{space-after-divider} (box spacing after the divider).
                                    (box-y-dimensions prev-x p space)))
                         (pedal-stencil 
                           (if circled 
-                              (ellipse-stencil stencil circle-thickness 
+                              (oval-stencil stencil circle-thickness 
                                             circle-x-padding circle-y-padding)
                               stencil))
                         (new-prev-x (+ prev-x space box-width)))
diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index aef4802eb7..9274279a2c 100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -30,6 +30,7 @@
 	    embedded-ps
 	    named-glyph
 	    no-origin
+            oval
 	    placebox
 	    polygon
 	    repeat-slash
@@ -198,6 +199,14 @@
 (define (no-origin)
   "")
 
+(define (oval x-radius y-radius thick fill)
+  (ly:format
+   "~a ~4f ~4f ~4f draw_oval"
+   (if fill
+     "true"
+     "false")
+   x-radius y-radius thick))
+
 (define (placebox x y s) 
   (ly:format
 "~4f ~4f moveto
diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index 93b27a68b1..f1af2a9274 100644
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -347,6 +347,26 @@
    `(rx . ,x-radius)
    `(ry . ,y-radius)))
 
+(define (oval x-radius y-radius thick is-filled)
+  (let ((x-max x-radius)
+        (x-min (- x-radius))
+        (y-max y-radius)
+        (y-min (- y-radius)))
+    (entity
+     'path ""
+     '(stroke-linejoin . "round")
+     '(stroke-linecap . "round")
+     `(fill . ,(if is-filled "currentColor" "none"))
+     `(stroke . "currentColor")
+     `(stroke-width . ,thick)
+     `(d . ,(ly:format "M~4f,~4f C~4f,~4f  ~4f,~4f ~4f,~4f S~4f,~4f ~4f,~4f" 
+               x-max 0
+               x-max y-max
+               x-min y-max
+               x-min 0
+               x-max y-min
+               x-max 0)))))
+
 (define (text font string)
   (dispatch `(fontify ,font ,(entity 'tspan (string->entities string)))))
 
diff --git a/scm/stencil.scm b/scm/stencil.scm
index e698fa8896..c0e56cd86e 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -99,6 +99,19 @@
    (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}."
@@ -155,6 +168,24 @@ 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."