I have created a patch for LilyPond (following the guidelines in the
documentation). I enclose a file that creates a chord chart from this
version, though I realize that it is too verbose for use in documenting
the new functionality. 
I'll be happy to create something smaller if it looks like  the patch
will be welcomed. (This one gives an idea of the output).

Richard


>From 8a3569e75d1fdff5318497051bb840e330162e47 Mon Sep 17 00:00:00 2001
From: Richard Shann <[email protected]>
Date: Mon, 6 Oct 2014 18:09:51 +0100
Subject: [PATCH] Allow creation of compact chord symbols

Compact chord symbols have the elements of the chord
(the root name, quality and bass-inversion) packed
tightly together so as to allow the creation of fakebooks.
Nowadays these will often be stored on hand held devices.
This patch allows the default chord symbols to be drawn in
such a manner, by defining the context property chordCompactScale.
Where this is not defined, the default behavior is maintained.
---
 scm/chord-ignatzek-names.scm      | 125 ++++++++++++++++++++++++++++++--------
 scm/define-context-properties.scm |   1 +
 2 files changed, 100 insertions(+), 26 deletions(-)

diff --git a/scm/chord-ignatzek-names.scm b/scm/chord-ignatzek-names.scm
index 22f54fe..c7671cb 100644
--- a/scm/chord-ignatzek-names.scm
+++ b/scm/chord-ignatzek-names.scm
@@ -88,6 +88,46 @@
           (ly:context-property context 'chordRootNamer)
           ;; name-root
           nn)))
+  (define (compact-name-root pitch scale)
+      (let* ((alt (ly:pitch-alteration pitch)))
+      (make-line-markup
+        (list
+          (make-bold-markup
+            (make-scale-markup '(0.5 . 1)
+                (make-simple-markup
+                    (vector-ref #("C" "D" "E" "F" "G" "A" "B") (ly:pitch-notename
+                        pitch)))))
+                  (if (= alt 0)
+                    (make-hspace-markup 0.1)
+                        (make-line-markup
+                                (list
+                                  (make-hspace-markup 0.1)
+                                  (make-fontsize-markup -7 (make-raise-markup 1.2 ;(* 1 scale)
+                                     (alteration->text-accidental-markup alt)))
+                                  (make-hspace-markup -0.5))))))))
+  (define (name-inversion pitch scale)
+    (let* ((alt (ly:pitch-alteration pitch)))
+      (make-line-markup
+        (list
+           (make-raise-markup 1
+            (make-scale-markup '(0.75 . 0.5)
+                (make-bold-markup (make-simple-markup "/"))))
+          (make-bold-markup
+            (make-scale-markup '(0.5 . 0.75)
+                (make-simple-markup
+                    (vector-ref #("C" "D" "E" "F" "G" "A" "B") (ly:pitch-notename
+                        pitch)))))
+          (if (= alt NATURAL)
+            (make-hspace-markup 2)
+            (make-line-markup
+                (list
+                  (make-hspace-markup 0.1)
+                  (make-fontsize-markup -7
+                  (if (= alt SHARP)
+                    (make-raise-markup 0.1
+                            (alteration->text-accidental-markup alt))
+                    (make-raise-markup 0.2
+                            (alteration->text-accidental-markup alt)))))))))))
 
   (define (is-natural-alteration? p)
     (= (natural-chord-alteration p) (ly:pitch-alteration p)))
@@ -169,9 +209,42 @@ work than classifying the pitches."
 
         (make-line-markup total)))
 
+    (define (markup-formatting sep root-markup prefixes to-be-raised-stuff bass-pitch)
+            (define bass-inv #f)
+            (define slashsep (ly:context-property context 'slashChordSeparator))
+            (define scale (ly:context-property context 'chordCompactScale))
+            (if (pair? scale)
+                (begin
+                    (set! bass-inv  (if (ly:pitch? bass-pitch)
+                                       (name-inversion bass-pitch scale)
+                                        empty-markup))
+                     (make-scale-markup scale (make-combine-markup
+                        (make-line-markup (list root-markup
+                            (make-scale-markup '(0.4 . 0.6)
+                                (make-bold-markup (conditional-kern-before (markup-join prefixes sep)
+                                                    (and (not (null? prefixes))
+                                                         (= (ly:pitch-alteration root) NATURAL))
+                                                    (ly:context-property context 'chordPrefixSpacer))))
+                            (make-scale-markup '(0.4 . 0.6) (make-bold-markup to-be-raised-stuff))))
+                        (make-raise-markup -2 bass-inv))))
+                (begin
+                    (set! bass-inv
+                        (if (ly:pitch? bass-pitch)
+                           (list slashsep (name-note bass-pitch #f))
+                           '()))
+                    (make-line-markup
+                           (append
+                             (list root-markup
+                                   (conditional-kern-before (markup-join prefixes sep)
+                                                            (and (not (null? prefixes))
+                                                                 (= (ly:pitch-alteration root) NATURAL))
+                                                            (ly:context-property context 'chordPrefixSpacer))
+                                   (make-super-markup to-be-raised-stuff))
+                             bass-inv)))))
     (let* ((sep (ly:context-property context 'chordNameSeparator))
            (slashsep (ly:context-property context 'slashChordSeparator))
-           (root-markup (name-root root lowercase-root?))
+           (scale (ly:context-property context 'chordCompactScale))
+           (root-markup (if (pair? scale) (compact-name-root root scale) (name-root root lowercase-root?)))
            (add-pitch-prefix (ly:context-property context 'additionalPitchPrefix))
            (add-markups (map (lambda (x) (glue-word-to-step add-pitch-prefix x))
                              addition-pitches))
@@ -185,37 +258,37 @@ work than classifying the pitches."
                                  main-markups
                                  alterations
                                  suffixes
-                                 add-markups) sep))
-           (base-stuff (if (ly:pitch? bass-pitch)
-                           (list slashsep (name-note bass-pitch #f))
-                           '())))
-
-      (set! base-stuff
-            (append
-             (list root-markup
-                   (conditional-kern-before (markup-join prefixes sep)
-                                            (and (not (null? prefixes))
-                                                 (= (ly:pitch-alteration root) NATURAL))
-                                            (ly:context-property context 'chordPrefixSpacer))
-                   (make-super-markup to-be-raised-stuff))
-             base-stuff))
-      (make-line-markup base-stuff)))
+                                 add-markups) sep)))
+      (markup-formatting sep root-markup prefixes to-be-raised-stuff bass-pitch)))
+
 
   (define (ignatzek-format-exception
            root
            exception-markup
            bass-pitch
            lowercase-root?)
-
-    (make-line-markup
-     `(
-       ,(name-root root lowercase-root?)
-       ,exception-markup
-       .
-       ,(if (ly:pitch? bass-pitch)
-            (list (ly:context-property context 'slashChordSeparator)
-                  (name-note bass-pitch #f))
-            '()))))
+    (define scale (ly:context-property context 'chordCompactScale))
+    (define bass-inv #f)
+     (if (pair? scale)
+;;;compact:
+      (begin
+            (set! bass-inv  (if (ly:pitch? bass-pitch)
+                               (name-inversion bass-pitch scale)
+                                empty-markup))
+             (make-scale-markup scale (make-combine-markup
+                (make-line-markup (list (compact-name-root root scale)
+                   exception-markup))
+                (make-raise-markup -2 bass-inv))))
+  ;;; non compact:
+        (make-line-markup
+         `(
+           ,(name-root root lowercase-root?)
+           ,exception-markup
+           .
+           ,(if (ly:pitch? bass-pitch)
+                    (list (ly:context-property context 'slashChordSeparator)
+                          (name-note bass-pitch #f))
+                '())))))
 
   (let* ((root (car in-pitches))
          (pitches (map (lambda (x) (ly:pitch-diff x root)) (cdr in-pitches)))
diff --git a/scm/define-context-properties.scm b/scm/define-context-properties.scm
index f694a67..0b787f9 100644
--- a/scm/define-context-properties.scm
+++ b/scm/define-context-properties.scm
@@ -197,6 +197,7 @@ exceptions.  Contains @code{(@var{chord} . (@var{prefix-markup}
      (chordNameFunction ,procedure? "The function that converts lists
 of pitches to chord names.")
      (chordNameLowercaseMinor ,boolean? "Downcase roots of minor chords?")
+     (chordCompactScale ,number-pair? "Draw chord symbols scaled by this amount")
      (chordNameSeparator ,markup? "The markup object used to
 separate parts of a chord name.")
      (slashChordSeparator ,markup? "The markup object used to separate
-- 
1.9.1

%% LilyPond file generated by Denemo version 1.1.9

%%http://www.gnu.org/software/denemo/

\version "2.18.0"

DenemoGlobalTranspose = #(define-music-function (parser location arg)(ly:music?) #{\transpose c c #arg #})
AutoBarline = {}
AutoEndMovementBarline = \bar "|."

\defineBarLine ":|]-RepeatEndFirstTime" #'(":|]" "" "")

\defineBarLine ":|]-RepeatEnd" #'(":|]" "|" "")

\defineBarLine "[|:-RepeatStart" #'("||" "[|:" "")

\defineBarLine "||-Double" #'("||" "|" "")

\defineBarLine "|-Single" #'("|" "|" "")

\defineBarLine "|" #'("|" "|" "|")
BarRepeatEndFirstTime = \bar ":|]-RepeatEndFirstTime"
BarRepeatEnd = \bar ":|]-RepeatEnd"
BarRepeatStart = \bar "[|:-RepeatStart"
BarDouble = \bar "||-Double"
BarSingle = \bar "|-Single"

       
#(define ((bars-per-line-engraver bar-list) context)
  (let* ((working-copy bar-list)
         (total (1+ (car working-copy))))
    `((acknowledgers
       (paper-column-interface
        . ,(lambda (engraver grob source-engraver)
             (let ((internal-bar (ly:context-property context 'internalBarNumber)))
               (if (and (pair? working-copy)
                        (= (remainder internal-bar total) 0)
                        (eq? #t (ly:grob-property grob 'non-musical)))
                   (begin
                     (set! (ly:grob-property grob 'line-break-permission) 'force)
                     (if (null? (cdr working-copy))
                         (set! working-copy bar-list)
                         (begin
                           (set! working-copy (cdr working-copy))))
                           (set! total (+ total (car working-copy))))))))))))
\layout {
   \context {
      \Score
      %use the line below to insist on your layout
      %\override NonMusicalPaperColumn.line-break-permission = ##f
      \consists #(bars-per-line-engraver '( 4))}}                             
                          
 CompactChordSymbols = {
        <c f bes d'>^\markup\scale #'(0.4 . 0.6) \bold {9 \scale #'(0.8 . 1) sus} 
        <c b>^\markup \bold\scale #'(.3 . .4) \override #'(thickness . 0.5)  {\triangle ##f} 
        <c d g>^\markup\scale #'(0.4 . 0.6) \bold { 9  \scale #'(0.8 . 1)  sus2 } 
        <c f g>^\markup\scale #'(0.4 . 0.6) \bold { 9  \scale #'(0.8 . 1)  sus4 } 
        <c ees bes>^\markup\scale #'(0.4 . 0.6) \bold {-7} 
        <c e gis>^\markup\scale #'(0.4 . 0.6) \bold {+} 
        %<c es ges bes>^\markup\scale #'(0.5 . 0.7) \bold {ø} 
        <c ees ges bes>^\markup\scale #'(0.5 . 0.7) \bold {ø} 

        <c ees ges>^\markup\scale #'(0.5 . 0.6) \bold {\hspace #0 o} 
        <c e g b>^\markup\scale #'(.3 . .4) \bold \override #'(thickness . .5)  { \triangle ##f } 
        <c b a'>^\markup \bold \override #'(thickness . .5)  { \scale #'(.3 . .4) \triangle ##f \scale #'(0.4 . 0.6) 13 } 
}

                         
                          
                          
                          

% The music follows

MvmntIVoiceI = {
         \time 4/4<>-\tweak #'extra-offset #'(-4.0 . -4.0) -\tweak baseline-skip #2.0   ^\markup\scale #'(1.5 . 1.8)\column{\line\large{\bold 4}\line\large{\bold 4}} \BarSingle c'1\AutoBarline
         <c' ees' g'>\AutoBarline
         <c' bes'>\AutoBarline
         <c' a'>\AutoBarline
%5
         <c' ees' bes'>\AutoBarline
         <c' ees' a'>\AutoBarline
         <c' ees' ges' bes'>\AutoBarline
         <c' f' bes' d''>\AutoBarline
         <c' b'>\AutoBarline
%10
         <c' d''>\AutoBarline
         <c' b' a''>\AutoBarline
         <c' f' g'>\AutoBarline
         <c' d' g'> \key d \major\AutoBarline
         cis'\AutoBarline
%15
         <cis' e' gis'>\AutoBarline
         <cis' b'>\AutoBarline
         <cis' ais'>\AutoBarline
         <cis' e' b'>\AutoBarline
         <cis' e' ais'>\AutoBarline
%20
         <cis' e' g' b'>\AutoBarline
         <cis' fis' b' dis''>\AutoBarline
         <cis' bis'>\AutoBarline
         <cis' dis''>\AutoBarline
         <cis' bis' ais''>\AutoBarline
%25
         <cis' fis' gis'>\AutoBarline
         <cis' dis' gis'> \key bes \major\AutoBarline
         bes\AutoBarline
         <bes des' f'>\AutoBarline
         <bes aes'>\AutoBarline
%30
         <bes g'>\AutoBarline
         <bes des' aes'>\AutoBarline
         <bes des' g'>\AutoBarline
         <bes des' fes' aes'>\AutoBarline
         <bes ees' aes' c''>\AutoBarline
%35
         <bes a'>\AutoBarline
         <bes c''>\AutoBarline
         <bes a' g''>\AutoBarline
         <bes ees' f'>\AutoBarline
         <bes c' f'> \AutoEndMovementBarline
}



\addQuote "Unnamed Mvmnt 1" \MvmntIVoiceI



%Default Score Layout
\header{DenemoLayoutName = "Default Score Layout"}

\header {
tagline = \markup {"/home/rshann/AllChords.denemo" on \simple #(strftime "%x" (localtime (current-time)))}

}
\layout {indent = 0}
#(set-default-paper-size "a4")
#(set-global-staff-size 7)
\paper {

#(set! paper-alist (cons '("custom-size" . (cons (* 5 cm) (* 8.1 cm))) paper-alist))
#(set-paper-size "custom-size")
system-system-spacing =
#'((basic-distance . 2)
(minimum-distance . 2)
(padding . 2))

page-limit-inter-system-space = ##t
page-limit-inter-system-space-factor = 1.2
}

\score { %Start of Movement
 <<

<< \set Score.proportionalNotationDuration = #(ly:make-moment 1/4)

<< 
<< \override Score.BarNumber.break-visibility = #end-of-line-invisible
                \set Score.barNumberVisibility = #(every-nth-bar-number-visible 10000) 
<<  \new ChordNames \with {chordNameExceptions = #(sequential-music-to-chord-exceptions CompactChordSymbols #t)                \consists "Bar_engraver"
                 \consists "Script_engraver"
                 \consists "Text_engraver"
                 \consists "Multi_measure_rest_engraver"
                 %\override ChordName.font-size=#12
                 \override ChordName.Y-extent = ##f
                 \override ChordName.extra-spacing-width=#'(+inf.0 . -inf.0)
                 \override ChordName.extra-offset = #'(0 . -2)
                 \override BarLine.bar-extent = #'(-3.5 . 3.5)
                 \override BarLine #'hair-thickness = #1.2     
                 \numericTimeSignature 
            }
                                 

 \MvmntIVoiceI
>>
>>
>>
>>
>>

\layout {

\context {
        \Score
        chordCompactScale = #'(2.5 . 2.0)
        } \set noChordSymbol = \markup \smaller \bold  "/"
}

} %End of Movement



_______________________________________________
lilypond-devel mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/lilypond-devel

Reply via email to