Feature: Add Harp pedal diagrams, i.e. a \harp-pedal markup function

Add a \harp-pedal markup function, which produces harp pedalling diagrams. The
syntax is
    \harp-pedal #"^-v|--ov^"
The contents of the string define the positions of the pedals (^/-/v for
up/neutral/down), | is the divider and o indicates that the next pedal
should be circled. It can be tweaked through the size and thickness props
and the harp-pedal-details property list of the TextScript grob. For this, I
had to add a harp-pedal-interface, too.

The only issue I'm still having is that lilypond does not have a function
to draw an ellipse, so all I can do for circled pedals is to draw a circle
rather than an ellipse... Also, using a rounded box does not work, as that
fills its contents, thus overdrawing the pedal box.

I've also added three regression test cases, namely
-) Basic functionality checks (including circled boxes and an empty definition
   string, as well as invalid characters in the string)
-) Sanity checks: Lilypond will check whether the diagram follows standard
   rules (7 pedals with one divider after the third). If not, it will print
   out a warning, but should still produce the diagram as given.
-) Tweaking: Most details of the diagram can be tweaked using size, thickness
   and harp-pedal-details.

8 files changed, 265 insertions, 0 deletions

diff --git a/Documentation/topdocs/NEWS.tely b/Documentation/topdocs/NEWS.tely
index cafa877cf1..a4c3c61694 100644
--- a/Documentation/topdocs/NEWS.tely
+++ b/Documentation/topdocs/NEWS.tely
@@ -328,6 +328,12 @@ indicate a raised 6th step.
 \new FiguredBass \figuremode { < 6\\ 5\\ > < 6/ > }
 @end lilypond
 
+@item Harp pedalling diagrams were added:
+
+@lilypond
+\markup \harp-pedal #"^v-|vv-o^"
+@end lilypond
+
 @end itemize
 
 
diff --git a/input/regression/harp-pedals-sanity-checks.ly b/input/regression/harp-pedals-sanity-checks.ly
new file mode 100644
index 0000000000..c49d418ccf
--- /dev/null
+++ b/input/regression/harp-pedals-sanity-checks.ly
@@ -0,0 +1,16 @@
+\version "2.11.56"
+
+\header {
+  texidoc = "The harp-pedal markup function does some sanity checks. All 
+the diagrams here violate the standard (7 pedals with divider after third), so
+a warning is printed out, but they should still look okay."
+}
+
+\relative c'' {
+  % Sanity checks: #pedals != 7:
+  c1^\markup \harp-pedal #"^-v|--"
+  % Sanity checks: no divider, multiple dividers, divider on wrong position:
+  c1^\markup \harp-pedal #"^-v--v^"
+  c1^\markup \harp-pedal #"^|-v|--|v^"
+  c1^\markup \harp-pedal #"^-v-|-v^"
+}
diff --git a/input/regression/harp-pedals-tweaking.ly b/input/regression/harp-pedals-tweaking.ly
new file mode 100644
index 0000000000..a9f2bb900b
--- /dev/null
+++ b/input/regression/harp-pedals-tweaking.ly
@@ -0,0 +1,20 @@
+\version "2.11.56"
+
+\header {
+  texidoc = "Harp pedals can be tweaked through the size, thickness and 
+harp-pedal-details properties of TextScript."
+}
+
+\relative c'' {
+  \override Voice.TextScript #'harp-pedal-details #'box-width = #1
+  \once \override Voice.TextScript #'size = #1.5
+  \once \override Voice.TextScript #'thickness = #7
+  c1^\markup \harp-pedal #"o^ovo-|vovo-o^"
+  c1^\markup \override #'(harp-pedal-details . (
+                  (box-width . 0.6)
+                  (box-height . 0.3)
+                  (box-offset . 0.5)
+                  (space-before-divider . 0.1)
+                  (space-after-divider . 1.2))) {
+           \harp-pedal #"o^ovo-|vovo-o^"}
+}
diff --git a/input/regression/harp-pedals.ly b/input/regression/harp-pedals.ly
new file mode 100644
index 0000000000..d78c88be46
--- /dev/null
+++ b/input/regression/harp-pedals.ly
@@ -0,0 +1,16 @@
+\version "2.11.56"
+
+\header {
+  texidoc = "Basic harp diagram functionality, including circled pedal boxes. 
+The third diagram uses an empty string, the third contains invalid characters. 
+Both cases will create warnings, but should still not fail with an error."
+}
+
+\relative c'' {
+  c1^\markup \harp-pedal #"^v-|vv-^"
+  % circled boxes:
+  c1^\markup \harp-pedal #"o^ovo-|vovo-o^"
+  % invalid pedal specifications, which still should be handled gracefully:
+  c1^\markup \harp-pedal #""
+  c1^\markup \harp-pedal #"asfdvx" %\break
+}
diff --git a/scm/define-grob-interfaces.scm b/scm/define-grob-interfaces.scm
index 8b0dde24f8..54848be876 100644
--- a/scm/define-grob-interfaces.scm
+++ b/scm/define-grob-interfaces.scm
@@ -62,6 +62,11 @@ note)."
  '(columns common-shortest-duration))
 
 (ly:add-interface
+ 'harp-pedal-interface
+ "A harp pedal diagram"
+ '(harp-pedal-details size thickness))
+
+(ly:add-interface
  'key-cancellation-interface
  "A key cancellation."
  '())
diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm
index 9015764dc1..49916fa24e 100644
--- a/scm/define-grob-properties.scm
+++ b/scm/define-grob-properties.scm
@@ -320,6 +320,27 @@ property.")
 
      (hair-thickness ,number? "Thickness of the thin line in a bar
 line.")
+     (harp-pedal-details ,list? "An alist of detailed grob properties
+for harp pedal diagrams.  Each alist entry consists of a
+(@code{property} . @code{value}) pair.
+The properties which can be included in harp-pedal-details
+include the following:
+@itemize @bullet
+@item
+@code{box-offset} -- Vertical shift of the center of flat / sharp pedal 
+boxes above / below the horizontal line. Default value 0.8.
+@item
+@code{box-width} -- Width of each pedal box. Default value 0.4.
+@item
+@code{box-height} -- Height of each pedal box. Default value 1.0.
+@item
+@code{space-before-divider} -- Space between boxes before the first divider 
+(so that the diagram can be made symmetric). Default value 0.8.
+@item
+@code{space-after-divider} -- Space between boxes after the first divider. 
+Default value 0.8.
+@end itemize")
+
      (head-direction ,ly:dir? "Are the note heads left or right in a
 semitie?")
      (height ,ly:dimension? "Height of an object in
diff --git a/scm/harp-pedals.scm b/scm/harp-pedals.scm
new file mode 100644
index 0000000000..adb00b00ec
--- /dev/null
+++ b/scm/harp-pedals.scm
@@ -0,0 +1,180 @@
+;;;; harp-pedals.scm --
+;;;;
+;;;;  source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2008 Reinhold Kainhofer <reinhold@kainhofer.com>
+
+
+;;;; More verbose version, which takes a list of directions. It's commented
+;;;; out, because it has some issues (see below) and does not add any new
+;;;; functionality over \harp-pedal
+;; (define-builtin-markup-command (harp-pedal-verbose layout props pedal-list) (list?)
+;;   music ; markup type
+;;   ((size 1.0)
+;;    (harp-pedal-details)
+;;    (thickness 0.5))
+;;   "Make a harp pedal diagram containing the directions indicated in @var{pedal-list}.
+;;
+;;   For example,
+;;
+;; @example
+;; \\markup \\pedal-diagram-verbose #'(1 0 -1 #\\| 0 0 1 1)
+;; \\markup \\pedal-diagram-verbose #(list UP CENTER DOWN #\\| CENTER CENTER UP UP)
+;; @end example
+;; "
+;;   (make-harp-pedal layout props pedal-list))
+
+
+(define-builtin-markup-command (harp-pedal layout props definition-string) (string?)
+  music ; markup type for the documentation!
+  ((size 1.0)
+   (harp-pedal-details)
+   (thickness 0.5))
+  "Make a harp pedal diagram.
+
+Possible elements in @var{definition-string}:
+
+@table @code
+@item ^
+pedal is up
+@item -
+pedal is neutral
+@item v
+pedal is down
+@item |
+vertical divider line
+@item o
+the following pedal should be circled (indicating a change)
+@end table
+
+The function also checks if the string has the typical form of three
+pedals, then the divider and then the remaining four pedals. If not it
+prints out a warning. However, in any case, it will also print each symbol
+in the order as given. This means you can place the divider (even multiple
+dividers) anywhere you want, but you'll have to live with the warnings.
+
+The appearance of the diagram can be tweaked inter alia using the size property
+of the TextScript grob (@code{\\override Voice.TextScript #'size = #0.3}) for
+the overall, the thickness property
+(@code{\\override Voice.TextScript #'thickness = #3}) for the line thickness of
+the horizontal line and the divider. The remaining configuration (box sizes,
+offsets and spaces) is done by the harp-pedal-details  list of properties
+(@code{\\override Voice.TextScript #'harp-pedal-details #'box-width = #1}).
+It contains the following settings: @code{box-offset} (vertical shift of the
+box center for up/down pedals), @code{box-width}, @code{box-height},
+@code{space-before-divider} (the spacing between two boxes before the
+divider) and @code{space-after-divider} (box spacing after the divider).
+
+@lilypond[verbatim,quote]
+\\markup \\harp-pedal #\"^-v|--ov^\"
+@end lilypond
+"
+
+;; There is also a \harp-pedal-verbose version, which
+;; takes a list of -1/0/1 directions and a possible |. Unfortunately, it has some
+;; caveats:
+;;   1) the | cannot be given as a string "|" but as a character #\| and
+;;      the "o" has to be given as #\o.
+;;   2) if one wants to use directions like UP, CENTER or DOWN, one cannot use
+;;      '(UP DOWN CENTER #\| ....), because the contents of that list are
+;;      never evaluated to -1/0/1. Instead one has to explicitly create a
+;;      list like (list UP DOWN CENTER #\| ....)
+
+  (make-harp-pedal layout props (harp-pedals-parse-string definition-string)))
+
+
+(define (harp-pedals-parse-string definition-string)
+ "Parse a harp pedals diagram string and return a list containing 1, 0, -1, #\\o or #\\|"
+  (map (lambda (c)
+    (case c
+      ((#\^) 1)
+      ((#\v) -1)
+      ((#\-) 0)
+      ((#\| #\o) c)
+      (else c)))
+    (string->list definition-string)))
+
+(define (harp-pedal-info pedal-list)
+  (let check ((pedals pedal-list)
+              (pedalcount 0)
+              (dividerpositions '()))
+    (if (null? pedals)
+      (cons pedalcount (reverse dividerpositions))
+
+      (case (car pedals)
+        ((-1 0 1) (check (cdr pedals) (+ pedalcount 1) dividerpositions))
+        ((#\|)    (check (cdr pedals) pedalcount (cons pedalcount dividerpositions)))
+        (else     (check (cdr pedals) pedalcount dividerpositions))))))
+
+(define (harp-pedal-check pedal-list)
+  "Perform some sanity checks for harp pedals (7 pedals, divider after third)"
+  (let ((info (harp-pedal-info pedal-list)))
+    ; 7 pedals:
+    (if (not (equal? (car info) 7))
+      (ly:warning "Harp pedal diagram contains ~a pedals rather than the usual 7." (car info)))
+    ; One divider after third pedal:
+    (if (null? (cdr info))
+      (ly:warning "Harp pedal diagram does not contain a divider (usually after third pedal).")
+      (if (not (equal? (cdr info) '(3)))
+        (ly:warning "Harp pedal diagram contains dividers at positions ~a. Normally, there is only one divider after the third pedal." (cdr info))))))
+
+
+(define (make-harp-pedal layout props pedal-list)
+  "Make a harp pedals diagram markup"
+
+
+  ; FIXME the size variable should be defined by a prop. lookup
+  (harp-pedal-check pedal-list)
+
+  (let* ((size (chain-assoc-get 'size props 1.2))
+        (details (chain-assoc-get 'harp-pedal-details props '()))
+        (dy (* size (assoc-get 'box-offset details 0.8))) ; offset of the box center from the line
+        (line-width (* (ly:output-def-lookup layout 'line-thickness)
+                       (chain-assoc-get 'thickness props 0.5)))
+        (box-width (* size (assoc-get 'box-width details 0.4)))
+        (box-hheight (* size (/ (assoc-get 'box-height details 1.0) 2))) ; half the box-height, saves some divisions by 2
+        (spacebeforedivider (* size (assoc-get 'space-before-divider details 0.8))) ; full space between boxes before the first divider
+        (spaceafterdivider (* size (assoc-get 'space-after-divider details 0.8))) ; full space between boxes
+        ;(spacebeforedivider (/ (+ box-width (* 8 spaceafterdivider)) 8))
+        (box-x-dimensions (lambda (prev-x p space) (cons (+ prev-x space)
+                                                   (+ prev-x space box-width))))
+        (box-y-dimensions (lambda (prev-x p space) (cons (- (* p dy) box-hheight)
+                                                         (+ (* p dy) box-hheight))))
+        (divider-stencil (lambda (xpos) (make-line-stencil line-width xpos (- 0 dy box-hheight) xpos (+ dy box-hheight))))
+        (result (let process-pedal  ((remaining pedal-list)
+                                     (prev-x 0)
+                                     (stencils '())
+                                     (circled #f)
+                                     (space spacebeforedivider))
+          ; Terminal condition of the recursion, return (final-x . stencil-list)
+          (if (null? remaining)
+            (cons (+ prev-x space) stencils)
+
+            (case (car remaining)
+              ((1 0 -1)  ; Pedal up/neutral/down
+                  (let* ((p (car remaining))
+                        (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))
+                        (new-prev-x (+ prev-x space box-width)))
+                      (process-pedal (cdr remaining) new-prev-x (cons circle-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)))
+              ((#\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))))))
+        (final-x (car result))
+        (stencils (reverse (cdr result))))
+    ; Add the horizontal line and combine all stencils:
+    (apply ly:stencil-add
+      (cons
+        (make-line-stencil line-width 0 0 final-x 0)
+        stencils))))
+
diff --git a/scm/lily.scm b/scm/lily.scm
index 51038bcd29..e518ce2983 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -338,6 +338,7 @@ The syntax is the same as `define*-public'."
 	    "encoding.scm"
 	    
 	    "fret-diagrams.scm"
+	    "harp-pedals.scm"
 	    "predefined-fretboards.scm"
             "define-markup-commands.scm"
 	    "define-grob-properties.scm"