Modify chord handling to handle guitar capos

chord-name-engraver now calls a shim between it and the chord formatter
in order to print capo chords

chord-name-scm has had capo-handler added. If requested it prints both
the original chord, and the transposed chord.

define-context-properties adds the properties capoPitch to declare the
capo transposition, and capoVertical to make the chords print in column
rather than row form.

diff --git a/Documentation/notation/chords.itely b/Documentation/notation/chords.itely
index 50ac2bf9ed2277191bae3c5a9a8be1c3670f74c9..baa216b0052d85b0d8557850acabeac00f1860c0 100644 (file)
--- a/Documentation/notation/chords.itely
+++ b/Documentation/notation/chords.itely
@@ -506,6 +506,56 @@ Rests passed to a @code{ChordNames} context will cause the
 }
 @end lilypond
 
+@cindex Transposing guitar chords for capo
+
+If the @code{capoPitch} property is set, then the chords will additionally be printed
+transposed for a guitar with the capo set appropriately. By default the chords are
+printed on one line, but if the @code{capoVertical} property is set, the chords will be
+printed one above the other.
+
+In make-pitch, leave the first argument at 0, the second argument is the
+interval (-2 is a third), and the third argument adjusts it up or down a
+semitone.
+
+@lilypond[verbatim,quote,ragged-right]
+<<
+  \new ChordNames \chordmode {
+    c1
+    r1
+    g1
+    c1
+    \break
+    c1
+    r1
+    g1
+    c1
+    \break
+    c1
+    r1
+    g1
+    c1
+  }
+  \chordmode {
+    c1
+    r1
+    g1
+    c1
+    \break
+    \set ChordNames.capoPitch = #(ly:make-pitch 0 -2 -1/2)
+    c1
+    r1
+    g1
+    c1
+    \break
+    \set ChordNames.capoVertical = ##t
+    c1
+    r1
+    g1
+    c1
+  }
+>>
+@end lilypond
+
 @snippets
 
 @c Keep index entries with following snippet

diff --git a/input/regression/chord-capo.ly b/input/regression/chord-capo.ly
new file mode 100644 (file)
index 0000000..48bb6de
--- /dev/null
+++ b/input/regression/chord-capo.ly
@@ -0,0 +1,28 @@
+\version "2.14.0"
+
+\header{
+  texidoc="Properties capoPitch, capoVertical: display chordnames, suitably
+transposed for a guitar capo, either in a line or one above the other.
+"
+}
+
+<<
+  \new ChordNames \chordmode {
+    c1
+    g1
+    c1
+    g1
+    c1
+    g1
+  }
+  \chordmode {
+    c1
+    g1
+    \set ChordNames.capoPitch = #(ly:make-pitch 0 -2 -1/2)
+    c1
+    g1
+    \set ChordNames.capoVertical = ##t
+    c1
+    g1
+  }
+>>

diff --git a/lily/chord-name-engraver.cc b/lily/chord-name-engraver.cc
index e2281400d01007ac9f14173a51dad0f9c9515b4b..b55668bec8e7d6fadb466d7bc950779b2df1a476 100644 (file)
--- a/lily/chord-name-engraver.cc
+++ b/lily/chord-name-engraver.cc
@@ -124,8 +124,8 @@ Chord_name_engraver::process_music ()
 
       pitches = scm_sort_list (pitches, Pitch::less_p_proc);
 
-      SCM name_proc = get_property ("chordNameFunction");
-      markup = scm_call_4 (name_proc, pitches, bass, inversion,
+      SCM capo_proc = ly_lily_module_constant ("capo-handler");
+      markup = scm_call_4 (capo_proc, pitches, bass, inversion,
                            context ()->self_scm ());
     }
   /*

diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index e3447eba2778aee22b26d941df17dae55d9eff36..0542893cc02726e42a400f494d861d8dec90ce66 100644 (file)
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -170,3 +170,31 @@ FOOBAR-MARKUP) if OMIT-ROOT is given and non-false.
         (alist (map chord-to-exception-entry elts)))
     (filter (lambda (x) (cdr x)) alist)))
 
+(define-public (capo-handler pitches bass inversion context)
+  (let ((chord-function
+          (ly:context-property context 'chordNameFunction 'jazz-chord-names))
+        (capo-pitch (ly:context-property context 'capoPitch #f)))
+    (if (not capo-pitch)
+        (chord-function pitches bass inversion context)  ;; call the chordNameFunction as of old
+        (let* ((new-pitches   ;; else transpose the pitches and do the chord twice
+               (map (lambda (p)
+                       (ly:pitch-transpose p capo-pitch))
+                    pitches))
+               (new-bass
+                 (if (ly:pitch? bass)
+                     (ly:pitch-transpose bass capo-pitch)
+                     '()))
+               (new-inversion
+                 (if (ly:pitch? inversion)
+                     (ly:pitch-transpose inversion capo-pitch)
+                     '()))
+               (capo-markup
+                 (make-parenthesize-markup
+                   (chord-function new-pitches new-bass new-inversion context)))
+               (name-markup (chord-function pitches bass  inversion context))
+               (capo-vertical (ly:context-property context 'capoVertical #f)))
+          (if capo-vertical
+              (make-column-markup (list name-markup capo-markup))
+              (make-line-markup (list name-markup
+                                      (make-hspace-markup 1)
+                                      capo-markup)))))))

diff --git a/scm/define-context-properties.scm b/scm/define-context-properties.scm
index e9acd9690713e8924844cda7d0ff90f3f565a16c..a238998d033cc77fc841b48ceb4e4b66ec5cc8aa 100644 (file)
--- a/scm/define-context-properties.scm
+++ b/scm/define-context-properties.scm
@@ -135,6 +135,8 @@ that normally end on beats.")
      (beatStructure ,list? "List of @code{baseMoment}s that are combined
 to make beats.")
 
+     (capoPitch ,ly:pitch? "The pitch to transpose chords down by when using the capo.")
+     (capoVertical ,boolean? "Whether to display actual and transposed pitches above each other or not.")
      (chordChanges ,boolean? "Only show changes in chords scheme?")
      (chordNameExceptions ,list? "An alist of chord exceptions.
 Contains @code{(@var{chord} . @var{markup})} entries.")