Re: polychords: what's the current state-of-the-art?

[Thomas Morley]

Am Mo., 8. Aug. 2022 um 22:07 Uhr schrieb Kieren MacMillan
<kieren@kierenmacmillan.info>:
>
> Hi all,
>
> What's the current best snippet for rendering polychords? I know the GSoC 
> chord stuff is still in air traffic control, but the snippet found at 
> <https://lists.gnu.org/archive/html/lilypond-user/2012-02/txtmAr2kxZ1Uy.txt> 
> definitely doesn't work, and is likely far from optimal given the decade-plus 
> of advances in the codebase.
>
> Thanks!
> Kieren.

I have some general concerns about the sense of polychords. Imho, it
is a very, very rare case that you _hear_ two chords with it roots at
the same time. Almost always it's one chord with one root and
(probably numerous) extensions. Interestingly the german wikipedia
entry talks about this topic the english one is silent about it:
https://de.wikipedia.org/wiki/Polychord_(Harmonielehre)
https://en.wikipedia.org/wiki/Polychord

That said, I have to admit writing polychords is quite common.
Thus here my new take (iirc the code you linked to was from me too,
more than a decade old...)
NB
 - this a proof of concept, don't use it for serious work without
thorough testings
 - you need a pretty new devel-version

\version "2.23.11"

#(define (insert-elt ls element)
 "Inserts @var{element} between every element of list @var{ls}"
  (define (helper l1 l2 elt)
    (cond ((and (null? l1) (null? l2)) l2)
          ((null? l1) (reverse (cdr l2)))
          (else
            (helper (cdr l1) (append (list elt (car l1)) l2) elt))))
  (helper ls '() element))

#(define-markup-command (dir-column-line layout props direction args)
  (number? markup-list?)
  #:properties ((baseline-skip))
  (let* ((args-length-ls
           (sort
             (map
               (lambda (x)
                 (interval-length
                   (ly:stencil-extent
                      (interpret-markup layout props x)
                    X)))
                args)
             <))
         (ln-mrkp
           #{
             \markup {
               \draw-line #(cons (car args-length-ls) 0)
               \vcenter
               \vspace #0.2
             }
           #})
         (new-args (insert-elt args ln-mrkp)))
    (stack-lines
      (if (number? direction) direction -1)
      0.0
      baseline-skip
      (interpret-markup-list layout props new-args))))

#(define Poly_chord_engraver
  (let* ((chords '()))
    (lambda (ctx)
      (make-engraver
        (acknowledgers
          ((chord-name-interface this-engraver grob source-engraver)
            (set! chords (cons grob chords))))
         ((stop-translation-timestep this-engraver)
           (when (> (length chords) 1)
             (let* ((texts
                     (map
                       (lambda (chrd) (ly:grob-property chrd 'text))
                       chords)))
               (ly:grob-set-property! (car chords) 'text
                 (make-dir-column-line-markup -1 texts))
               (for-each
                 (lambda (c)
                   (ly:grob-set-property! c 'text ""))
                 (cdr chords))))
           (set! chords '()))))))

\layout {
  \context {
    \ChordNames
    \accepts ChordVoice
    \remove Current_chord_text_engraver
    \remove Chord_name_engraver
    \consists \Poly_chord_engraver
    \override ChordName.baseline-skip = 0.2
  }
  \context {
    \type Engraver_group
    \name ChordVoice
    \alias Voice
    \consists Current_chord_text_engraver
    \consists Chord_name_engraver
  }
}

mus = \chordmode {
  des1:m << c \\ e:7 >> ees:7 << c, \\ e:7 \\ f':7+ >>
}

<<
  \new ChordNames \mus
  \new Staff \mus
>>

Cheers,
  Harm