Instrument registrations (was: automatic partwriter)

[David Kastrup]

David Nalesnik <address@hidden> writes:

> Hi Kieren,
>
> On Wed, Sep 27, 2017 at 8:16 AM, Kieren MacMillan
> <address@hidden> wrote:
>> Hi David,
>>
>>> I wanted to share something which I think illustrates the power that
>>> Lily has over other popular notation software.
>>
>> o_O
>>
>> Amazing.
>>
>> 1. You are a force of nature.
>
> Well, diligent/obsessive in fits and starts :)

Here is an example file I wrote: unfortunately I had to leave out both
image file (you'll have to outcomment the \epsfile markup I guess) of
the bass buttons as well as the complete result because the list will
not allow such sizes.

It has to be said that the first version I wrote was not done using
Scheme but rather in Lua, writing out LilyPond source code.  I was more
comfortable hacking up something quick in that manner.

I think that this is something likely to haunt a lot of potential
applications: Scheme is not that well suited for
brainstorming/prototyping since it is sort of write-only for humans:
it's primarily readable for computers, and keeping stuff
semi-well-readable for humans requires discipline and effort.

On the other hand, the direct access to LilyPond internals has its
advantages.

\version "2.19.22"

\paper {
  ragged-last = ##f
}

#(define (number-or-pitch? a) (or (integer? a) (ly:pitch? a)))

bass-staff = "lo"
bass-clef = "bass"
bass-desc = \markuplist { }
bari-low-desc = \markuplist { (stem down, solid heads) }
bv-one = { \voiceOne \harmonicsOn }
bv-two = { \voiceTwo \harmonicsOn }
tv-one = { \voiceOne \harmonicsOn }
tv-two = \voiceTwo
sv-one = { \voiceOne \harmonicsOn }
sv-two = \voiceTwo
%%{
bass-staff = "hi"
bass-clef = "treble"
bass-desc = \markuplist { (stem down, diamond heads) }
bari-low-desc = \markuplist { (stem up, solid heads) }
bv-one = { \voiceFour \harmonicsOn }
bv-two = { \voiceTwo \harmonicsOn }
tv-one = { \voiceOne \harmonicsOn }
tv-two = \voiceThree
sv-one = { \voiceOne \harmonicsOn }
sv-two = \voiceTwo
%}

#(define stats (make-hash-table 20))

#(define (add-to-stats pitch chordname count)
   (let ((p (hashv-create-handle! stats count '()))
         (num (modulo (ly:pitch-semitones (ly:pitch-diff pitch #{ a #})) 12)))
     (set-cdr! p (cons (cons num chordname) (cdr p)))))

#(define (stats-list)
   (define (sort-pairs lst)
     (map cdr
          (sort-list lst car<)))
   (map (lambda (e)
        #{ \markuplist \override-lines #'(word-space . 1) \wordwrap-lines
           #(cons (format #f "~d reeds:" (car e))
             (fold-right
              (lambda (next lst)
               (cons (string-append next (if (null? lst) "." ",")) lst))
              '() (sort-pairs (reverse (cdr e))))) #})
        (sort-list (hash-table->alist stats) car<)))

chordmap =
#(define-music-function (start width music)
   (number-or-pitch? index? ly:music?)
   (if (ly:pitch? start) (set! start (ly:pitch-semitones start)))
   (map-some-music
    (lambda (m)
      (and
       (music-is-of-type? m 'event-chord)
       (begin
         (set! (ly:music-property m 'elements)
               (append-map
                (lambda (x)
                  (let ((p (ly:music-property x 'pitch)))
                    (if (ly:pitch? p)
                        (let loop ((n (ly:make-pitch
                                       (- (ly:pitch-octave p)
                                          (floor (/ (- (ly:pitch-semitones p) 
start)
                                                    12)))
                                       (ly:pitch-notename p)
                                       (ly:pitch-alteration p)))
                                   (l '()))
                          (if (< (ly:pitch-semitones n)
                                 (+ start width))
                              (loop (ly:pitch-transpose (ly:make-pitch 1 0 0) n)
                                    (cons (music-clone x 'pitch n) l))
                              l))
                        (list x))))
                (ly:music-property m 'elements)))
         m)))
    music))

#(define (conflate keys vals)
   (define (folder k v res)
     (if (or (null? res)
             (not (equal? v (cdar res))))
         (cons (cons (list k) v) res)
         (cons (cons (cons k (caar res)) (cdar res)) (cdr res))))
   (fold-right folder '() keys vals))

#(define (one-set start count music)
   (map (lambda (kv)
          (let ((keys (car kv)) (m (cdr kv)))
            (cons (if (null? (cdr keys))
                      (format "~d" (car keys))
                      (format "~d–~d" (car keys) (last keys)))
                  m)))
        (conflate (iota count 1)
                  (map
                   (lambda (i) #{ \chordmap #i #12 $music #})
                   (iota count (ly:pitch-semitones start))))))

#(define (bass-format-set pitch name)
   (let ((bass #{ \chordmap e,, 12 < $pitch >4 #})
         (accf #{ \chordmap a, 41 < $pitch >4 #})
         (accp (one-set #{ a, #} 20 #{ < $pitch >4 #})))
     (add-to-stats pitch (string-upcase name) (+ 2 (* 2 (length 
(ly:music-property accf ' elements)))))
     #{ << \context Staff = "hi"
           << \new Voice \with \tv-one
              { \tempo \markup \caps #name \transpose c c' $accf }
              \new Voice \with \tv-two { <>_"*" $accf } >>
           \context Staff = \bass-staff
           { \clef \bass-clef \key $pitch \major
             << \new Voice \with \bv-one \transpose c c' $bass
                \new Voice \with \bv-two { $bass } >>
           }
        >>
        $@(map (lambda (p)
                 (let ((idx (car p)) (m (cdr p)))
                   #{ << \context Staff = "hi"
                         << \new Voice \with \tv-one \transpose c c' $m
                            \new Voice \with \tv-two { <>_\markup #idx $m } >>
                         \context Staff = \bass-staff
                         << \new Voice \with \bv-one \transpose c c' $bass
                            \new Voice \with \bv-two { $bass }
                          >>
                      >> #}))
               accp)
        #}))

#(define (chord-format-set pitch chord name)
   (let ((accf #{ \chordmap a, 41 $chord #})
         (accp (one-set #{ a, #} 20 chord)))
     (add-to-stats pitch name (* 2 (length (ly:music-property accf 'elements))))
     #{ << \new Voice \with \sv-one { \tempo \markup #name \transpose c c' 
$accf }
           \new Voice \with \sv-two { <>_"*" $accf }
        >>
        $@(map (lambda (p)
                 (let ((idx (car p)) (m (cdr p)))
                   #{ << \new Voice \with \sv-one \transpose c c' $m
                         \new Voice \with \sv-two { <>_\markup #idx $m }
                      >>
                      #}))
               accp)
        #}))

#(define (score-format-set pitch name)
   #{ \score { \new Staff = "hi"
               { \key $pitch \major \cadenzaOn
                 $(bass-format-set pitch name) \bar "|"
                 $@(map
                    (lambda (c t)
                        #{  \once \accidentalStyle forget
                          $(chord-format-set pitch c (string-append name t))
                          \bar "|"
                          #})
                    (ly:music-property
                     (ly:music-property
                      (ly:music-property
                       #{ \transpose c $pitch
                          \chordmode { c4 c:m c:7^5 c:dim7^5 } #}
                       'element)
                      'element)
                     'elements)
                    '("" "m" "7" "°"))
               }
               \layout {
                 indent = 0
                 \context {
                   \Staff
                   \remove "Time_signature_engraver"
                   \override TextScript.self-alignment-X = #CENTER
                   \override VerticalAxisGroup.outside-staff-placement-directive
                             = #'right-to-left-greedy
                 }
               }
           }
      #})

#(set-global-staff-size 16)

\markup \fill-line { \huge "Morino Sonderkonstruktion 100811, \"M. Thöni\"" }
\markup \vspace #2
\markup \fill-line
\general-align #Y #UP
{ \override #'(line-width . 45) \justify {
  Two sliders \bass-desc
  enable lower and upper bass reed sets.  One slider (stem
  up, diamond heads) enables upper baritone reed set.  The
  lower baritone reed set \bari-low-desc is not optional.
  Independent of the enabled reed sets is the chord note selection: a
  tutti slider (resulting chords marked with “*”) may be engaged.  Otherwise
  a chord root slider with positions 1–20 is consulted.
  Each chord in the diagram is marked either with
  “*” or with the range of slider positions producing it. }
 \epsfile #X #85 #"bassbuttons.eps" }
\markup \vspace #3

$@(map
   (lambda (p n)
     (score-format-set p n))
   (event-chord-pitches #{ <des as es bes f c g d a e b fis> #})
   #{ \markuplist { d♭ a♭ e♭ b♭ f c g d a e b f♯ } #})

\markup { Maximum number of reeds sounding with “*” slider engaged: }
\markuplist \override-lines #'(word-space . 4)
            \wordwrap-lines #(concatenate (stats-list))


-- 
David Kastrup