Color and/or parenthesize single dots in fret-diagrams

Issue 2752

Makes it possible to color and/or parenthesize single dots in
fret-diagram-verbose

Introducing two properties for use in fret-diagram-details
 - fret-label-horizontal-offset
    affecting the fret-label-indication, like the existing
    `fret-label-vertical-offset'
 - paren-padding
    affecting the padding of the parenthesis

Extending relevant reg-tests.

Documenting it in NR, fretted-strings.itely

6 files changed, 236 insertions, 54 deletions

diff --git a/Documentation/notation/fretted-strings.itely b/Documentation/notation/fretted-strings.itely
index f8461b4ada..76d8f5d375 100644
--- a/Documentation/notation/fretted-strings.itely
+++ b/Documentation/notation/fretted-strings.itely
@@ -998,12 +998,15 @@ can be placed on the fret diagram.  The capo indication is
 a thick bar that covers all strings.  The fret with the
 capo will be the lowest fret in the fret diagram.
 
+Fingering indication dots can be colored as well as parenthesized;
+the parenthesis's color can also be altered independently.
+
 @c \override is necessary to make fingering visible
 @lilypond[quote, verbatim]
 <<
     \new ChordNames {
       \chordmode {
-        f1 g c
+        f1 g c c
       }
     }
   \new Staff {
@@ -1039,6 +1042,17 @@ capo will be the lowest fret in the fret diagram.
         (place-fret 2 5 3)
       )
     }
+    \override Voice.TextScript.size = 1.5
+    <c g c' e' g'>1^\markup {
+      \fret-diagram-verbose #'(
+        (place-fret 6 3 1 red parenthesized default-paren-color)
+        (place-fret 5 3 1 inverted)
+        (place-fret 4 5 2 blue parenthesized)
+        (place-fret 3 5 3 blue)
+        (place-fret 2 5 4 blue)
+        (place-fret 1 3 1 inverted)
+      )
+    }
   }
 >>
 @end lilypond
diff --git a/input/regression/fret-diagrams-dots.ly b/input/regression/fret-diagrams-dots.ly
index 1189c0b82c..e765d8e5ce 100644
--- a/input/regression/fret-diagrams-dots.ly
+++ b/input/regression/fret-diagrams-dots.ly
@@ -1,9 +1,14 @@
-\version "2.17.6"
+\version "2.19.8"
 
 \header {
   texidoc="
 Dots indicating fingerings can be changed in location,
 size, and coloring.
+It is possible to parenthesize a single dot.  The color
+of the paranthesis may be taken from dot or default.
+A possible collision between parathesis and fret-label-
+indication can be resolved by an override for
+@code{fret-label-horizontal-offset} in @code{fret-diagram-details}.
 
 "
 }
@@ -15,6 +20,8 @@ size, and coloring.
     c1 |
     c1 |
     c1 |
+    c1 |
+    c1 |
     c1
   }
 
@@ -65,7 +72,34 @@ size, and coloring.
                                      (place-fret 1 3 1)
                                      (barre 5 1 3))}
 
- }
->>
+     %% C major for guitar,  verbose style
+    \once \override TextScript.size = #1.4
+    c'1 ^\markup {
+            \fret-diagram-verbose #'((mute 6)
+                                     (place-fret 5 3 1 blue)
+                                     (place-fret 4 5 2 red parenthesized)
+                                     (place-fret 3 5 3)
+                                     (place-fret 2 5 4 red)
+                                     (place-fret 1 3 1 blue parenthesized)
+                                     (barre 5 1 3))}
 
+     %% C major for guitar,  verbose style
+     %% larger size and dot-radius
+     %% different dot-colors
+     %% parenthesizing single dots, with different paren-color
+     %% horizontal moving fret-label-indication
+    \once \override TextScript.size = #1.5
+    \once \override TextScript.fret-diagram-details.dot-radius = #0.4
+    \once \override TextScript.fret-diagram-details.fret-label-horizontal-offset = #0.2
+    c'1 ^\markup {
+            \fret-diagram-verbose
+              #'((mute 6)
+                 (place-fret 5 3 1 blue)
+                 (place-fret 4 5 2 red parenthesized default-paren-color)
+                 (place-fret 3 5 3)
+                 (place-fret 2 5 4 red)
+                 (place-fret 1 3 1 blue parenthesized)
+                 (barre 5 1 3))}
 
+ }
+>>
diff --git a/input/regression/fret-diagrams-fingering.ly b/input/regression/fret-diagrams-fingering.ly
index 786d34110c..81575a50c8 100644
--- a/input/regression/fret-diagrams-fingering.ly
+++ b/input/regression/fret-diagrams-fingering.ly
@@ -1,4 +1,4 @@
-\version "2.17.6"
+\version "2.19.8"
 
 \header {
   texidoc="
@@ -19,6 +19,7 @@ and fingering label font size can be adjusted.
     c1 |
     c1 |
     c1 |
+    c1 |
     c1
   }
 
@@ -78,7 +79,8 @@ and fingering label font size can be adjusted.
                                      (place-fret 2 5 4)
                                      (place-fret 1 3 1)
                                      (barre 5 1 3))}
-    %% dot color inversion, white on black
+     %% C major for guitar, verbose style
+     %% dot color inversion, white on black
     \once \override TextScript.fret-diagram-details.dot-color = #'black
     c' ^\markup {
             \fret-diagram-verbose #'((mute 6)
@@ -88,7 +90,8 @@ and fingering label font size can be adjusted.
                                      (place-fret 2 5 4)
                                      (place-fret 1 3 1)
                                      (barre 5 1 3))}
-    %% dot color inversion, black on white
+     %% C major for guitar, verbose style
+     %% dot color inversion, black on white
     \once \override TextScript.fret-diagram-details.dot-color = #'white
     c' ^\markup {
             \fret-diagram-verbose #'((mute 6)
@@ -98,7 +101,17 @@ and fingering label font size can be adjusted.
                                      (place-fret 2 5 4)
                                      (place-fret 1 3 1)
                                      (barre 5 1 3))}
+     %% C major for guitar, verbose style
+     %% dot color inversion, global setting and per-dot
+    \once \override TextScript.fret-diagram-details.dot-color = #'grey
+    \once \override TextScript.size = #1.4
+    c' ^\markup {
+            \fret-diagram-verbose #'((mute 6)
+                                     (place-fret 5 3 1 inverted)
+                                     (place-fret 4 5 2 red)
+                                     (place-fret 3 5 3 inverted)
+                                     (place-fret 2 5 4 red inverted)
+                                     (place-fret 1 3 1)
+                                     (barre 5 1 3))}
  }
 >>
-
-
diff --git a/input/regression/fret-diagrams-fret-label.ly b/input/regression/fret-diagrams-fret-label.ly
index 6ae0e392b1..495562dc28 100644
--- a/input/regression/fret-diagrams-fret-label.ly
+++ b/input/regression/fret-diagrams-fret-label.ly
@@ -1,4 +1,4 @@
-\version "2.17.6"
+\version "2.19.8"
 
 \header {
   texidoc="
@@ -32,8 +32,8 @@ size, and number type.
                                      (barre 5 1 3))}
 
      %% C major for guitar, verbose style
-    \override TextScript.fret-diagram-details.label-dir = #LEFT 
-    \override TextScript.fret-diagram-details.number-type = #'roman-upper 
+    \override TextScript.fret-diagram-details.label-dir = #LEFT
+    \override TextScript.fret-diagram-details.number-type = #'roman-upper
     c' ^\markup {
             \fret-diagram-verbose #'((mute 6)
                                      (place-fret 5 3 1)
@@ -45,8 +45,8 @@ size, and number type.
 
      %% C major for guitar, verbose style
     \revert TextScript.fret-diagram-details.label-dir
-    \override TextScript.fret-diagram-details.fret-label-font-mag = #0.4 
-    \override TextScript.fret-diagram-details.number-type = #'arabic 
+    \override TextScript.fret-diagram-details.fret-label-font-mag = #0.4
+    \override TextScript.fret-diagram-details.number-type = #'arabic
     \once \override TextScript.fret-diagram-details.fret-label-vertical-offset = #0.25
     c' ^\markup {
             \fret-diagram-verbose #'((mute 6)
@@ -60,6 +60,7 @@ size, and number type.
      %% C major for guitar, verbose style
     \revert TextScript.fret-diagram-details.label-dir
     \once \override TextScript.fret-diagram-details.number-type = #'custom
+    \once \override TextScript.fret-diagram-details.fret-label-horizontal-offset = #0.5
     \once \override TextScript.fret-diagram-details.fret-label-custom-format = #"~d°"
     c' ^\markup {
             \fret-diagram-verbose #'((mute 6)
@@ -72,5 +73,3 @@ size, and number type.
 
  }
 >>
-
-
diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm
index 6f080aeb2d..24e8e3298a 100644
--- a/scm/define-grob-properties.scm
+++ b/scm/define-grob-properties.scm
@@ -371,6 +371,13 @@ label the lowest fret number.  Default@tie{}0.5.
 the center of the fret in direction parallel to strings.
 Default@tie{}0.
 @item
+@code{fret-label-horizontal-offset} -- The offset of the fret label from
+the center of the fret in direction orthogonal to strings.
+Default@tie{}0.
+@item
+@code{paren-padding} -- The padding for the parenthesis.
+Default@tie{}0.05.
+@item
 @code{label-dir} -- Side to which the fret label is attached.
 @w{@code{-1}}, @code{LEFT}, or @code{DOWN} for left or down; @code{1},
 @code{RIGHT}, or @code{UP} for right or up.  Default @code{RIGHT}.
diff --git a/scm/fret-diagrams.scm b/scm/fret-diagrams.scm
index 69a8ba7821..e60c0dca35 100644
--- a/scm/fret-diagrams.scm
+++ b/scm/fret-diagrams.scm
@@ -64,6 +64,41 @@ to end-point."
   "Calculate the fret count for the diagram given the range of frets in the diagram."
   (1+ (- (cdr fret-range) (car fret-range))))
 
+(define (dot-has-color dot-settings)
+  "Return a color-name as symbol, if found in @var{dot-settings} otherwise @code{#f}"
+  (cond ((null? dot-settings)
+         #f)
+        ;; Don't bother the user with quote/unquote.
+        ;; We use the name-symbol for the color, looking up in 'x11-color-list'
+        ((member (car dot-settings) (map car x11-color-list))
+         (car dot-settings))
+        (else (dot-has-color (cdr dot-settings)))))
+
+(define (dot-is-inverted dot-settings)
+  "Return @code{'inverted}, if found in @var{dot-settings} otherwise @code{'()}"
+  (let ((inverted (member 'inverted dot-settings)))
+    (if inverted
+        (car inverted)
+        '())))
+
+(define (dot-is-parenthesized dot-settings)
+  "Return @code{'parenthesized}, if found in @var{dot-settings} otherwise @code{'()}"
+  (let ((parenthesized (member 'parenthesized dot-settings)))
+    (if parenthesized
+        (car parenthesized)
+        '())))
+
+;; If @code{'default-paren-color} is not set, the parenthesis will take their
+;; color from the dot.
+;; Setting @code{'default-paren-color} will result in taking the color from
+;; `what-color', see below.
+(define (default-paren-color dot-settings)
+  "Return @code{'default-paren-color}, if found in @var{dot-settings} otherwise @code{'()}"
+  (let ((default-color (member 'default-paren-color dot-settings)))
+    (if default-color
+        (car default-color)
+        '())))
+
 (define (subtract-base-fret base-fret dot-list)
   "Subtract @var{base-fret} from every fret in @var{dot-list}"
   (if (null? dot-list)
@@ -71,18 +106,26 @@ to end-point."
       (let ((this-list (car dot-list)))
         (cons* (list
                 ;; string
-                (car this-list)
+                  (car this-list)
                 ;; fret
-                (- (second this-list) base-fret)
+                  (- (second this-list) base-fret)
                 ;; finger
-                (if (null? (cddr this-list))
-                    '()
-                    (third this-list))
-                ;; color modifier
-                (if (or (null? (cddr this-list))
-                        (null? (cdddr this-list)))
-                    '()
-                    (fourth this-list)))
+                  (if (or (null? (cddr this-list))
+                        (not (number? (caddr this-list))))
+                      '()
+                      (third this-list))
+                ;; inverted
+                  (dot-is-inverted this-list)
+                ;; parenthesis
+                  (dot-is-parenthesized this-list)
+                ;; color modifiers
+                  ;; parenthesis
+                  (default-paren-color this-list)
+                  ;; dots
+                  (let ((colored (dot-has-color this-list)))
+                    (if colored
+                        colored
+                        '())))
                (subtract-base-fret base-fret (cdr dot-list))))))
 
 (define (drop-paren item-list)
@@ -271,6 +314,7 @@ with magnification @var{mag} of the string @var{text}."
          ;; needed for draw-frets and draw-strings
          (sth (* size th))
          (thickness-factor (assoc-get 'string-thickness-factor details 0))
+         (paren-padding (assoc-get 'paren-padding details 0.05))
          (alignment
           (chain-assoc-get 'align-dir props -0.4)) ;; needed only here
          (xo-padding (assoc-get 'xo-padding details 0.2)) ;; needed only here
@@ -370,7 +414,7 @@ Line thickness is given by @var{th}, fret & string spacing by
              (string-stencil (car x))
              (helper (cdr x)))))
 
-      (let* ( (string-list (map 1+ (iota string-count))))
+      (let* ((string-list (map 1+ (iota string-count))))
         (helper string-list)))
 
     (define (string-stencil string)
@@ -528,7 +572,7 @@ fret-diagram overall parameters."
 
       (let* ( (scale-dot-radius (* size dot-radius))
               (scale-dot-thick (* size th))
-              (default-dot-color (assoc-get 'dot-color details 'black))
+              (default-dot-color (assoc-get 'dot-color details))
               (finger-label-padding 0.3)
               (dot-label-font-mag
                (* scale-dot-radius
@@ -552,24 +596,73 @@ fret-diagram overall parameters."
               (extent (cons (- scale-dot-radius) scale-dot-radius))
               (finger (caddr mypair))
               (finger (if (number? finger) (number->string finger) finger))
-              (inverted-color (eq? 'inverted (cadddr mypair)))
-              (dot-color (if (or (and (eq? default-dot-color 'black) inverted-color)
-                                 (and (eq? default-dot-color 'white) (not inverted-color)))
-                             'white
-                             'black))
-              (dot-stencil (if (eq? dot-color 'white)
-                               (ly:stencil-add
-                                (make-circle-stencil
-                                 scale-dot-radius scale-dot-thick #t)
-                                (ly:stencil-in-color
-                                 (make-circle-stencil
-                                  (- scale-dot-radius (* 0.5 scale-dot-thick))
-                                  0  #t)
-                                 1 1 1))
-                               (make-circle-stencil
-                                scale-dot-radius scale-dot-thick #t)))
+              (parenthesized
+                (if (not (null? (dot-is-parenthesized mypair)))
+                    (dot-is-parenthesized mypair)
+                    #f))
+              (parenthesis-color
+                (if (not (null? (default-paren-color mypair)))
+                    (default-paren-color mypair)
+                    #f))
+              (inverted
+                (if (not (null? (dot-is-inverted mypair)))
+                    (dot-is-inverted mypair)
+                    #f))
+              (dot-color-is-white?
+                (or inverted
+                    (and (eq? default-dot-color 'white) (not inverted))))
+              (what-color
+                (x11-color
+                  (cond ((and inverted
+                              (not (dot-has-color mypair))
+                              (not (eq? default-dot-color 'white)))
+                          (or default-dot-color 'black))
+                        (dot-color-is-white?
+                          (or (dot-has-color mypair) 'black))
+                        (else
+                          (or (dot-has-color mypair)
+                              default-dot-color
+                              'black)))))
+              (inverted-stil
+                (lambda (color)
+                  (ly:stencil-add
+                    (stencil-with-color
+                      (make-circle-stencil
+                        scale-dot-radius scale-dot-thick #t)
+                      color)
+                    (stencil-with-color
+                      (make-circle-stencil
+                        (- scale-dot-radius (* 0.5 scale-dot-thick))
+                        0  #t)
+                      (x11-color 'white)))))
+              (dot-stencil
+                (if dot-color-is-white?
+                    (inverted-stil what-color)
+                    (stencil-with-color
+                      (make-circle-stencil
+                         scale-dot-radius scale-dot-thick #t)
+                      what-color)))
+              (par-dot-stencil
+                (let ((paren-color
+                        (if (and parenthesis-color
+                                 (not (eq? default-dot-color 'white)))
+                            (x11-color (or default-dot-color 'black))
+                            what-color)))
+                 (stencil-with-color
+                   (parenthesize-stencil
+                     dot-stencil      ;; stencil
+                     (* size th 0.75) ;; half-thickness
+                     (* 0.15 size)    ;;width
+                     0                ;; angularity
+                     paren-padding    ;; padding
+                     )
+                   paren-color)))
+              (final-dot-stencil
+                  (if parenthesized
+                      par-dot-stencil
+                      dot-stencil))
               (positioned-dot
-               (ly:stencil-translate dot-stencil dot-coordinates))
+               (ly:stencil-translate final-dot-stencil dot-coordinates))
               (labeled-dot-stencil
                (cond
                 ((or (eq? finger '())(eq? finger-code 'none))
@@ -581,10 +674,12 @@ fret-diagram overall parameters."
                           layout props dot-label-font-mag finger))))
                    (ly:stencil-translate
                     (ly:stencil-add
-                     dot-stencil
-                     (if (eq? dot-color 'white)
-                         finger-label
-                         (ly:stencil-in-color finger-label 1 1 1)))
+                     final-dot-stencil
+                     (if dot-color-is-white?
+                         (stencil-with-color
+                            finger-label
+                            what-color)
+                         (stencil-with-color finger-label white)))
                     dot-coordinates)))
                 ((eq? finger-code 'below-string)
                  (let* ((label-stencil
@@ -701,6 +796,8 @@ at @var{fret}."
              (label-dir (assoc-get 'label-dir details RIGHT))
              (label-vertical-offset
               (assoc-get 'fret-label-vertical-offset details 0))
+             (label-horizontal-offset
+              (assoc-get 'fret-label-horizontal-offset details 0))
              (number-type
               (assoc-get 'number-type details 'roman-lower))
              (label-text
@@ -726,7 +823,10 @@ at @var{fret}."
                label-stencil
                'string
                orientation))
-             (label-outside-diagram (+ label-space label-half-width)))
+             (label-outside-diagram
+               (+ label-space
+                  (* size label-horizontal-offset)
+                  label-half-width)))
         (ly:stencil-translate
          label-stencil
          (stencil-coordinates
@@ -972,15 +1072,30 @@ to string @var{end-string} at fret @var{fret-number}.
 Place a capo indicator (a large solid bar) across the entire fretboard
 at fret location @var{fret-number}.  Also, set fret @var{fret-number}
 to be the lowest fret on the fret diagram.
-
-@item (place-fret @var{string-number} @var{fret-number} [@var{finger-value} [@var{color-modifier}]])
+@item
+(place-fret @var{string-number}
+            @var{fret-number}
+            [@var{finger-value}]
+            [@var{color-modifier}]
+            [@var{color}]
+            [@code{'parenthesized} [@code{'default-paren-color}]])
 Place a fret playing indication on string @var{string-number} at fret
 @var{fret-number} with an optional fingering label @var{finger-value},
-and an optional color modifier @var{color-modifier}.
+an optional color modifier @var{color-modifier}, an optional color
+@var{color}, an optional parenthesis @code{'parenthesized} and an
+optional paranthesis color @code{'default-paren-color}.
 By default, the fret playing indicator is a solid dot.  This can be
-globally changed by setting the value of the variable @var{dot-color}.
+globally changed by setting the value of the variable @var{dot-color}
+or for a single dot by setting the value of @var{color}.  The dot can
+be parenthesized by adding @code{'parenthesized}.  By default the
+color for the parenthesis is taken from the dot.  Adding
+@code{'default-paren-color} will take the parenthesis-color from the
+global @var{dot-color}, as a fall-back black will be used.
 Setting @var{color-modifier} to @code{inverted} inverts the dot color
 for a specific fingering.
+The values for @var{string-number}, @var{fret-number}, and the optional
+@var{finger} should be entered first in that order.
+The order of the other optional arguments does not matter.
 If the @var{finger} part of the @code{place-fret} element is present,
 @var{finger-value} will be displayed according to the setting of the
 variable @var{finger-code}.  There is no limit to the number of fret