Back in 2015 people on the list helped me with extracting notes from
chords, in this thread:
   https://lists.gnu.org/archive/html/lilypond-user/2015-09/msg00394.html

The solution from 2015 has broken now, in the transition between versions
2.21.0 and 2.24.1.  I think it's because of changes in Guile 2.2.  I
haven't had the opportunity to test with versions strictly between 2.21.0
and 2.24.1.

My situation is that I have music containing chords which I want to play
on a monophonic synthesizer, by generating separate MIDI tracks such that
in each track there is only one note playing at a time.  After recording
the tracks separately I'll mix the audio files.  So I'd like to have a
function I can call that takes in music with multi-note chords and selects
just one note from each chord.  Making it a little more complicated, the
number of notes in the chords varies, including some single notes that
Lilypond may represent internally as different from "chords."  I need to
generate as many tracks as the maximum number of notes that will play
simultaneously, but have silence in the extra tracks at times when there
are fewer notes playing than there are tracks.

So, for instance, if my input looks like
  { c4 <c e>4 <c e g>4 }

then I want to generate tracks that might look like
  { c4 c4 c4 }
  { r4 e4 e4 }
  { r4 r4 g4 }

It's not important which tracks get which notes and which tracks get
silence; all that matters is that the union of the output tracks should be
the same notes that were in the input, with silence assigned to
unused tracks.  It would be nice if it could handle more complicated
structures of overlapping notes like
  << { c2 } { d4 e4 } >>

but the solution I've been using since 2015 doesn't, there are some
foreseeable problems with doing that in the general case, and it's not my
main concern right now.  The main issue is that I want my existing files
that work to continue working in more recent Lilypond.

This is a near-dealbreaker for me using a more recent Lilypond at all - I
could and might fix it by just sticking to 2.21.0 indefinitely - but I'd
really like to also be able to override midiDrumPitches, which seems to be
new in some version more recent than 2.21.

Here's a small example showing the problem:

\include "chord.ly"
music = { <c d>1 }
{ \extractNote #3 \music }

In version 2.21.0 that produces a whole-note rest.  In version 2.24.1 with
Guile 2.2 it gives this error output:

GNU LilyPond 2.24.1 (running Guile 2.2)
Processing `test.ly'
Parsing...ERROR: In procedure %resolve-variable:
Unbound variable: #{ }#

Lilypond 2.24.1 compiled with Guile 3.0.9 also gives this error.

I attach the version of chord.ly I'm using, which I got from the 2015
discussion.  I found these links helpful at that time and I think one of
them contained the original for this version of chord.ly:
  http://gillesth.free.fr/Lilypond/chord/
  http://www.lilypondforum.de/index.php?topic=2080.msg11479#msg11479

but those links are both dead now, making it difficult for me to figure
out exactly which changes I applied to get it to work in 2015.  The
version currently in LSR snippet number 545 does not give the unbound
variable error, but it is dated earlier, and it has the problem for which
I started the 2015 thread:  on an out-of-range index it just returns the
last note (d in my example) instead of returning silence.

The present error output seems to be specific to the case of extracting a
note that doesn't exist, such as the third note of a two-note chord in my
example.  It works without error if I only ask for notes that exist.
However, I can't really avoid giving an out-of-range index; being able to
do that and get silence is a big part of the point of the exercise.

-- 
Matthew Skala
msk...@ansuz.sooke.bc.ca                 People before tribes.
https://ansuz.sooke.bc.ca/
%% version Y/M/D = 2015/03/23
%% LSR = http://lsr.di.unimi.it/LSR/Item?u=1&id=761
%% LSR = http://lsr.di.unimi.it/LSR/Item?u=1&id=545
%% for Lilypond 2.16 or higher.
%% last major change in extract-note function : as \tuplet as now
%% a 'duration property, we have to deal with this special case.
%% by chord->note. You can now specified several numbers, to
%% extract several notes at one time

#(define (noteEvent? music)
(eq? (ly:music-property music 'name) 'NoteEvent))

#(define (no-duration? music)
(not (ly:duration? (ly:music-property music 'duration))))

#(define (expand-q-chords music); for q chords : see chord-repetition-init.ly
(expand-repeat-chords! (list 'rhythmic-event) music))

%%%%%%%%%%%%%%%%%%%%%%%%%%  extractNote  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define tagNotExtractNote (gensym))
#(use-modules (ice-9 receive)) %% for the use of receive

#(define (chord->note chord n . args)
"Return either the note n of chord chord, keeping articulations or if other
numbers are specified in args, a chord with the matching notes."
(receive (notes others)
 (partition noteEvent? (ly:music-property chord 'elements))
 (if (null? notes)
   chord
   (let* ((len (length notes))
          (res (filter-map
            (lambda(i)
              (and (integer? i)
                   (<= i len)
                   (> i 0)
                   (list-ref notes (1- i)))) ; list-ref is zero-based
            (cons n args)))
           (one-note (cond 
             ((null? res) (let ((note (list-ref notes (1- len)))) ; last note
                (make-music 'RestEvent 'duration (ly:music-property note 
'duration))))
             ((null? (cdr res))(car res)) ; only one note
             (else #f))))
      (if one-note
        (begin ; not a chord, a note alone.
          (ly:music-set-property! one-note 'articulations 
            (append (ly:music-property one-note 'articulations) others))
          one-note)
        (make-event-chord (append res others)))))))
         
#(define (extract-note music n . args)
"Extract the note n of each chords in music, keeping articulations.
If other numbers are given in args, the function returns a chord build with all
matching notes. If no note matches, returns the last note of the chord."
 (map-some-music 
   (lambda (evt)
     (let ((name (ly:music-property evt 'name)))
      (cond 
        ((eq? 'EventChord name)
           (let ((tags (ly:music-property evt 'tags)))
              (if (memq tagNotExtractNote tags)
                 (ly:music-set-property! evt 'tags ; only remove the tag
                     (delq tagNotExtractNote tags))
                 (set! evt (apply chord->note evt n args)))
              evt))
        ((eq? 'TimeScaledMusic name) #f) ;; \tuplet have now a 'duration 
property !
        (else (and (ly:music-property evt 'duration #f) evt)))))
   (expand-q-chords music)))

extractNote = #(define-music-function (parser location n music )
                                                            (number? ly:music?)
 (extract-note (event-chord-wrap! music) n))

% usefull for notExtractNote
tagify = #(define-music-function (parser location tag music)(symbol? ly:music?)
"Add `tag in the tags property of all chords"
(music-map
  (lambda (evt)
    (if (eq? 'EventChord (ly:music-property evt 'name))
       (ly:music-set-property! evt 'tags
             (cons tag (ly:music-property evt 'tags))))
        evt)
  music))

notExtractNote = #(define-music-function (parser location music)(ly:music?)
"Avoids music to be extracted by \\extractNote."
#{ \tagify #tagNotExtractNote $music #})

%%%%%%%%%%%%%%%%%%%%%%%%%%  extractVoice  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define tagNotExtractVoice (gensym))

#(define (extract-voice music d deeper-level?) ;; d as a decimal number
   (define (nth-voice voices n)
    (let ((len (length voices)))
     (list-ref voices (1-   ; list-ref is zero-based !
      (if (<= n len) n len)))))
   
   (define (not-extract? x)
     (let ((tags (ly:music-property x 'tags)))
        (and (memq tagNotExtractVoice tags)   ; don't extract anything
             (begin 
               (ly:music-set-property! x 'tags 
                   (delq tagNotExtractVoice tags)) ; only remove the tag
               x))))
   
   (define (myfilter x)
     (or (not-extract? x)
         (case (ly:music-property x 'name #f)
           ((SimultaneousMusic EventChord) x)
           ((OverrideProperty PropertySet VoiceSeparator) #f)
           ((ContextSpeccedMusic)
              (if (eq? (ly:music-property x 'context-type) 'Voice)
                (set! x (myfilter (ly:music-property x 'element #f))))
              x)
           (else (if (ly:music-property x 'duration #f)
             x
             (let ((e (ly:music-property x 'element #f))
                   (es (ly:music-property x 'elements #f)))
               (if e (ly:music-set-property! x 'element (myfilter e)))
               (if (pair? es)(ly:music-set-property! x 'elements
                                (filter myfilter es)))
               x))))))
(map-some-music 
 (lambda(evt)
   (case (ly:music-property evt 'name)
     ((EventChord) evt)
     ((SimultaneousMusic)
        (or (not-extract? evt)
            (let* ((save-d d)                      ; if d = 4.321, we'll get :
                   (n (truncate d))                ; n = 4 (the integer part)
                   (next-d (- (* 10  d)(* 10 n)))  ; next-d = 43.21 - 40 = 3.21
                   (voices (filter myfilter (ly:music-property evt 
'elements))))     
              (set! evt (if (or (null? voices)(< n 1))
                 '()
                 (nth-voice voices (inexact->exact n))))
              (if deeper-level? (begin                                   
                (set! d (if (< next-d 1) n next-d))        ; keep n if 
(truncate next-d) = 0
                (set! evt (extract-voice evt d deeper-level?)))) ; 
SimultaneousMusic inside?
              (set! d save-d)
              evt)))
     (else (and (ly:music-property evt 'duration #f)
                evt))))
 music))

extractVoice = #(define-music-function (parser location n music )
                                                            (integer? ly:music?)
"Extract in music, the n-th voice of simultaneous music of the same level, 
keeping 
only basic music events (no more \\Voicexxx or \\new Voice). A Voice separator
doesn't count as a voice."
(extract-voice music n #f))

deepExtractVoice = #(define-music-function (parser location x music )
                                                            (number? ly:music?)
"Behaves like extractVoice, taking first the integer part of x as n argument, 
but
goes deeper in each simultaneous music, extracting voice of other potential
simultaneous music, taking now as n argument the first digit of the decimal part
of x, then continues always deeper with second digit and so on.
Notes that a digit of 0, means taking previous value of n, so 2 is equivalent 
to 2,222...
and 2,3 to 2,333..."
(extract-voice music x #t))

notExtractVoice = #(define-music-function (parser location music)(ly:music?)
"Inside an \\extractVoice section, avoids that a part of this section (called
here `music) to be extracted."
#{ \tag #tagNotExtractVoice $music #})

%%%%%%%%%%%%%%%%%%%%%%%%%%%%% derivated functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% If you have enter << <c e g> \\ <ais cis fis> >>, the first function will
%% give you c, the second fis
extractPartUpper = #(define-music-function (parser location music )(ly:music?)
 #{ \extractNote #1000 \extractVoice #1 $music #})

extractPartLower = #(define-music-function (parser location music )(ly:music?)
 #{ \extractNote #1 \extractVoice #1000 $music #})
                          %%%%%% shortcuts %%%%%%%
#(define ePU extractPartUpper)
#(define ePL extractPartLower)

%%%%%%%%%%%%%%%%%%%%% addNote

#(define (add-note music notes-to-add)                ; music and notes-to-add 
as music
  (define (note->chords-arti note)                    ; note as a NoteEvent
    (receive (note-arti chord-arti)
      (partition      ; separates arti for NoteEvent from arti for EventChord
        (lambda (evt)(memq (ly:music-property evt 'name)
                       (list 'StringNumberEvent 'StrokeFingerEvent 
'FingeringEvent)))
        (ly:music-property note 'articulations))
      (ly:music-set-property! note 'articulations note-arti)
      chord-arti))
  (let* ((alist      ; a list of pairs of 2 lists : '(notes . articulations)
          (reverse (let loop ((m (expand-q-chords notes-to-add)) ; q to chords
                              (p '())) ; m = music, p previous value of the list
            (case (ly:music-property m 'name)
              ((or SkipEvent SkipMusic) ; a skip in notes-to-add means : add 
nothing
                 (cons #f p))           ; add #f to the list
              ((NoteEvent) 
                 (acons (list m) (note->chords-arti m) p))
              ((EventChord)
                 (receive (notes arti) ; separates notes from scripts, dynamics 
etc
                   (partition noteEvent? (ly:music-property m 'elements))
                   (if (pair? notes)(acons notes arti p) p)))
              (else (let ((e (ly:music-property m 'element)))
                 (fold loop
                       (if (ly:music? e)(loop e p) p)
                       (ly:music-property m 'elements))))))))
        (entry #f)  ; will be (car alist)
        (entry? (lambda() (and
                  (pair? alist)
                  (begin (set! entry (car alist))
                         (set! alist (cdr alist))
                         entry))))
        (do-add (lambda (notes arti)
                  (let* ((dur (ly:music-property (car notes) 'duration))
                         (new-notes (map            ; fix all durations to dur
                           (lambda(evt)(ly:music-set-property! evt 'duration 
dur)
                                       evt)
                           (car entry)))            ; the list of new notes
                         (new-arti (cdr entry)))    ; the articulations
                     (append new-notes notes new-arti arti)))))
    ;; combine in chords, each element of alist with notes of music  
   (map-some-music
     (lambda(x)
       (case (ly:music-property x 'name)
           ((NoteEvent)(if (entry?)
              (make-event-chord (do-add (list x) (note->chords-arti x)))
              x))
           ((EventChord)
              (if (entry?)(receive (notes arti) ; separates notes from scripts, 
dynamics etc
                (partition noteEvent? (ly:music-property x 'elements))
                (if (pair? notes)(ly:music-set-property! x 'elements (do-add 
notes arti)))))
              x)
           (else (and (ly:music-property x 'duration #f) x)))) ; #f means : go 
deeper
     (expand-q-chords music))))


addNote = #(define-music-function (parser location music notes)
                                                          (ly:music? ly:music?)
"Merges in a chord, the first note or chord in `music, with the first note or 
chord
in `notes, including articulations, then continues to the second one, and so on.
The duration of notes are taken from `music.
In `notes, only note or chord events are kept."
(add-note music notes)) % be seen in \relative mode
          

%%%%%%%%%%%%%%%%%%%% addVoice
%% Traditionnal way
addVoice = #(define-music-function (parser location music newVoice)
                                                          (ly:music? ly:music?)
#{ << $music \\ $newVoice >> #})


%% Alternate way
addVoiceAlt = #(define-music-function (parser location music newVoice)
                                                          (ly:music? ly:music?)
#{ << { \voiceOne $music } \new Voice { \voiceTwo $newVoice } >>
   \oneVoice #})
                                                          
%%%%%%%%%%%%%%%%%%%%
#(define dyn-list '(AbsoluteDynamicEvent CrescendoEvent DecrescendoEvent))

deleteDynamics = #(define-music-function (parser location music) (ly:music?)
(music-filter (lambda (evt)
                (not (memq (ly:music-property evt 'name) dyn-list)))
              music))

%%%%%%%%%%%%%%%%%%%%%%%%

doubleNote = #(define-music-function (parser location music) (ly:music?)
"Double each note with the note an octave higher."
 #{ \addNote {\transpose c c' $music } $music #})

%%%%%%%%%%%%%%%%%%%%%%%%
#(define (delete-duplicates-notes music-with-chords)
"In a chord, delete a note if an another note with the same pitch is found"
(let ((chords (extract-named-music music-with-chords 'EventChord)))
   (for-each 
     (lambda(chord)
       (ly:music-set-property! chord 'elements 
         (delete-duplicates
          (ly:music-property chord 'elements)
          (lambda(note1 note2)
            (equal? (ly:music-property note1 'pitch)
                    (ly:music-property note2 'pitch))))))        
     chords)
   music-with-chords))


%%%%%%%%%%%%%%%%%%%%%%%%
%% Well \shiftDurations do now the same things ...
%% depracated functions

doubleDur = #(define-music-function (parser location music)(ly:music?)
(map-some-music
 (lambda (evt)
   (let ((dur (ly:music-property evt 'duration #f)))
     (and dur (begin
          (ly:music-set-property! evt 'duration (ly:make-duration
            (1- (ly:duration-log dur))
            (ly:duration-dot-count dur)))
          evt))))
 music))

halfDur = #(define-music-function (parser location music)(ly:music?)
(map-some-music
 (lambda (evt)
   (let ((dur (ly:music-property evt 'duration #f)))
     (and dur (begin
         (ly:music-set-property! evt 'duration (ly:make-duration
            (1+ (ly:duration-log dur))
            (ly:duration-dot-count dur)))
         evt))))
 music))
        %%%%%%%%%%%%%%%%%%%%%%%%% TESTS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%{  %% <- add a % to test functions
\markup \fill-line { "***** \\extractNote and \\deepExtractVoice *****" }
music = \relative c''{
  <c e g>4-> <d f>( <b g' d'>) <c e g>-.
  <<
    {e4 f g2 << {<a c>4 b c2} \new Voice { \voiceThree f,2 e} >> }
    \\
    { c2 b4 d <<{d2 c2}  \new Voice  {\voiceFour g4 r c,2}>>}
  >>
}

\score {
  \new Staff \music
  \header { piece = "Music with chords and voices"}
}
\score { <<
  \new Staff \extractNote #3 \deepExtractVoice #1 \music
  \new Staff \extractNote #2 \deepExtractVoice #1.2 \music
  \new Staff \extractNote #1 \deepExtractVoice #2.1 \music
  \new Staff \extractNote #1 \deepExtractVoice #4 \music
  >>
  \header { piece = "Music splited in 4 staffs"}
}


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\markup \fill-line { "***** \\extractNote and \\addNote *****" }

musicA = \relative c' {c'4.-> d8-. c4(\p b8) r c4\f c c2}
musicB = \relative c' {e f e d e s e}
\score { <<
  \new Staff \musicA
  \new Staff \addNote \musicA \musicB
  >>
  \header { piece = "ajout des notes {e f e d e s e}"}
}
  
music = \relative c' {
  g'2  g4 g
  a b c d
  c1 }
musicB = \addNote \addNote 
           \music 
           \relative c' { e d e f g e f e }
           \relative c' { c b c f, e a g c }
\score {<<
  \new Staff \musicB
  \new Staff \extractNote #3 \musicB
  \new Staff \extractNote #2 \musicB
  \new Staff { \clef bass \extractNote #1 \musicB }
  >>
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\markup \fill-line { "***** \\doubleNote *****" }

mus = \relative c' { a4 e' g fis g2-> c,-> }
music = \doubleNote \mus
\new Staff \mus
\new Staff \music

\markup \fill-line { "***** \\notExtractVoice *****" }
music = \relative c' << 
  { c'2 d }
  \new Voice { \voiceTwo
               \notExtractVoice \override Voice.NoteHead.color = #red
               e2 f} 
>>

\new Staff \extractVoice #2 \music

m = 
\relative c' {
     <c e g>4~
     <c e g>4
     <d f a>
     <e g>
     c2.
}

\new Staff \m
\new Staff \extractNote #3 \m
\new Staff \extractNote #2 \m
\new Staff \extractNote #1 \m


%}

Reply via email to