Add bezier oval for harp pedal diagrams

diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps
index aa8cfa6527d4396669062d47b59efd31ae6024c5..c6f4423615f8f4ea1715b3400e9f1695c3594f28 100644 (file)
--- 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 9a5bed1a9e990e44dabd2efd2c6938a8ef867844..132686ce47243588f0917d268243931a361fc937 100644 (file)
--- 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 fef1760db592d6675cb54ab5eab2274de5c8db81..9af6e04dd2f98c4781574281e2a9a9a18878eb03 100644 (file)
--- 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 aef4802eb71d8b6e41391055a10640dcdf17fe48..9274279a2cf732f61d2db234c88b5d9c586e7bfe 100644 (file)
--- 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 93b27a68b11dddfecc1514a0fb666487cc2bde19..f1af2a927485f246f4374390e5f53fd41d53a3bb 100644 (file)
--- 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 e698fa8896e50abe74abb2ceb4cf9cdc076c0d28..c0e56cd86e8d4613ab63d34856430aec6307962f 100644 (file)
--- 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."