Change harp pedal outlines to ellipses

Add ellipse drawing routines to ps and svg output

Add ellipse stencil

Add ellipse-stencil routine to center stencil in ellipse

Modify scm/harp-pedals.scm to use ellipse routine

Reformat code to avoid long lines

diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps
index 713d997f37b739e7f71bdbe888c57ea860bee483..aa8cfa6527d4396669062d47b59efd31ae6024c5 100644 (file)
--- a/ps/music-drawing-routines.ps
+++ b/ps/music-drawing-routines.ps
@@ -128,7 +128,7 @@ bind def
        closepath fill
 } bind def
 
-% this is for drawing slurs.
+% this is for drawing slurs and barre-indicators.
 /draw_bezier_sandwich  % thickness controls
 {
        gsave
@@ -165,6 +165,19 @@ bind def
        ifelse
 } bind def
 
+/draw_ellipse % filled? x-radius y-radius thickness draw_ellipse
+{
+  setlinewidth % f? x-r y-r
+  /savematrix matrix currentmatrix def
+  scale % f?
+  currentpoint
+  1 0 rmoveto
+  1 0 360  arc closepath
+  savematrix setmatrix
+             { stroke_and_fill}
+             { stroke }
+  ifelse
+} bind def
 
 /draw_line % dx dy x1 y1 thickness draw_line
 {

diff --git a/scm/define-stencil-commands.scm b/scm/define-stencil-commands.scm
index fac14b3d6b8ac8bd413eabf29e815be191b3d33f..9a5bed1a9e990e44dabd2efd2c6938a8ef867844 100644 (file)
--- a/scm/define-stencil-commands.scm
+++ b/scm/define-stencil-commands.scm
@@ -17,6 +17,7 @@
        dashed-slur
        dot
        draw-line
+       ellipse
        embedded-ps
        glyph-string
        named-glyph

diff --git a/scm/harp-pedals.scm b/scm/harp-pedals.scm
index 8f7756acbafb3e7b34e6e6038a951c66c9ed379d..9fd4c84c9af909d4f3a82d0b77939df71932ebc6 100644 (file)
--- a/scm/harp-pedals.scm
+++ b/scm/harp-pedals.scm
@@ -150,20 +150,27 @@ divider) and @code{space-after-divider} (box spacing after the divider).
                         (stencil (make-filled-box-stencil
                                    (box-x-dimensions prev-x p space)
                                    (box-y-dimensions prev-x p space)))
-                                   ;(circle-stencil (if circled (rounded-box-stencil stencil 0.05 0.3 0.1 ) stencil))
-                                   (circle-stencil (if circled (circle-stencil stencil 0.05 0.2 ) stencil))
+                        (pedal-stencil 
+                          (if circled 
+                              (ellipse-stencil stencil 0.05 0.1 ) 
+                              stencil))
                         (new-prev-x (+ prev-x space box-width)))
-                      (process-pedal (cdr remaining) new-prev-x (cons circle-stencil stencils) #f space)))
+                    (process-pedal (cdr remaining) new-prev-x 
+                                   (cons pedal-stencil stencils) #f space)))
               ((#\|)  ; Divider line
                   (let* ((xpos (+ prev-x space))
                          (stencil (divider-stencil xpos))
                          (new-prev-x (+ prev-x space)))
-                    (process-pedal (cdr remaining) new-prev-x (cons stencil stencils) circled spaceafterdivider)))
+                    (process-pedal (cdr remaining) new-prev-x 
+                                   (cons stencil stencils) 
+                                   circled spaceafterdivider)))
               ((#\o)  ; Next pedal should be circled
                   (process-pedal (cdr remaining) prev-x stencils #t space))
               (else
-                  (ly:warning "Unhandled entry in harp-pedal: ~a" (car remaining))
-                  (process-pedal (cdr remaining) prev-x stencils circled space))))))
+                  (ly:warning "Unhandled entry in harp-pedal: ~a" 
+                              (car remaining))
+                  (process-pedal (cdr remaining) 
+                                 prev-x stencils circled space))))))
         (final-x (car result))
         (stencils (cdr result)))
     ; Add the horizontal line and combine all stencils:

diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index 5b5217868caf4bef7ca986f64df2fa622421ae9c..aef4802eb71d8b6e41391055a10640dcdf17fe48 100644 (file)
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -26,6 +26,7 @@
            dashed-slur
            dot
            draw-line
+            ellipse
            embedded-ps
            named-glyph
            no-origin
@@ -116,6 +117,14 @@
          (- x2 x1) (- y2 y1)
          x1 y1 thick))
 
+(define (ellipse x-radius y-radius thick fill)
+  (ly:format
+   "~a ~4f ~4f ~4f draw_ellipse"
+   (if fill
+     "true"
+     "false")
+   x-radius y-radius thick))
+
 (define (embedded-ps string)
   string)
 

diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index 8a8960e6d339b1fb04d9fa33a042f7d60e739af8..93b27a68b11dddfecc1514a0fb666487cc2bde19 100644 (file)
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -336,6 +336,17 @@
    `(stroke-width . ,thick)
    `(r . ,radius)))
 
+(define (ellipse x-radius y-radius thick is-filled)
+  (entity
+   'ellipse ""
+   '(stroke-linejoin . "round")
+   '(stroke-linecap . "round")
+   `(fill . ,(if is-filled "currentColor" "none"))
+   `(stroke . "currentColor")
+   `(stroke-width . ,thick)
+   `(rx . ,x-radius)
+   `(ry . ,y-radius)))
+
 (define (text font string)
   (dispatch `(fontify ,font ,(entity 'tspan (string->entities string)))))
 

diff --git a/scm/stencil.scm b/scm/stencil.scm
index 19303ae691bc85d1499de93ae24b19dc01161244..8ae5ffab066c549774445ff69b1505b9264ce9ae 100644 (file)
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -99,6 +99,18 @@
    (cons (- out-radius) out-radius)
    (cons (- out-radius) 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.
@@ -129,10 +141,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)))
 
@@ -143,6 +155,27 @@ encloses the contents.
                            (interval-center x-ext)
                            (interval-center y-ext))))))
 
+(define-public (ellipse-stencil stencil thickness padding)
+  "Add an ellipse around STENCIL, 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) padding thickness))
+         (y-length (+ (interval-length y-ext) 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."