Hello Gordon,

I’ve created a function for replacing arbitrary chords with other chords. Note 
that this requires the use of absolute notation, because to support relative 
notation I’d need to implement my own parser just to know what octave the 
notes are in.

Cheers,
Valentin
\version "2.22"

% returns a string representation of a pitch
#(define (pitch->str p)
   (string-append "Po"
                  (number->string (ly:pitch-octave p))
                  "n"
                  (number->string (ly:pitch-notename p))))

% returns a symbol representation of a list of pitches
#(define (signature pitches)
   (let
    ((sp (sort pitches ly:pitch<?)))
    (string->symbol (apply string-append (map pitch->str sp)))))

% takes a alist that maps symbol representations of chords to a list of pitches and some music
% and replaces all occurences of chords with the key pitches in the alist with chords with the
% pitches associated with that key
replaceChords =
#(define-music-function (replacements mus) (list? ly:music?)
   ; get a list of all notes in music
   (define (extract-notes music)
     (let
      ((name (ly:music-property music 'name))
       (elt (ly:music-property music 'element))
       (elts (ly:music-property music 'elements)))
      (if (eq? name 'NoteEvent)
          (let
           ((nelt (if (null? elt) elt (extract-notes elt)))
            (nelts (apply append (map extract-notes elts))))
           (cons music (append nelt nelts)))
          (let
           ((nelt (if (null? elt) elt (extract-notes elt)))
            (nelts (apply append (map extract-notes elts))))
           (append nelt nelts)))))
   ; get the duration of a chord from one of the notes in the chord
   (define (extract-duration notes)
     (if (null? notes) 0
         (ly:music-property (first notes) 'duration)))
   ; get pitch from a note
   (define (extract-one-pitch note)
     (ly:music-property note 'pitch))
   ; get list of pitches from a list of notes
   (define (extract-pitch notes)
     (map extract-one-pitch notes))
   ; check if argument is a note
   (define (is-note? music)
     (eq? (ly:music-property music 'name) 'NoteEvent))
   ; check if argument is not a note
   (define (is-not-note? music)
     (not (is-note? music)))
   ; remove all notes from 'elements
   (define (remove-notes music)
     (let
      ((elt (ly:music-property music 'element))
       (elts (ly:music-property music 'elements)))
      (if (not (null? elt))
          (if (is-note? elt)
              (ly:music-set-property! music 'element '())
              (remove-notes elt)))
      (ly:music-set-property! music 'elements
                              (filter is-not-note? elts))
      (map remove-notes (ly:music-property music 'elements))))
   ; add specified notes to 'elements
   (define (add-notes music pitches dur)
     (define (add-note p)
       (if (not (null? p))
           (begin
            (ly:music-set-property! music 'elements
                                    (cons
                                     (make-music
                                       'NoteEvent
                                       'pitch
                                       (car p)
                                       'duration
                                       (ly:make-duration 2))
                                     (ly:music-property music 'elements)))
            (add-note (cdr p)))))
     (add-note pitches))
   ; parse music tree
   (define (walk-music-tree music)
     (let
      ((name (ly:music-property music 'name))
       (elt (ly:music-property music 'element))
       (elts (ly:music-property music 'elements)))
      ; is music a chord?
      (if (eq? name 'EventChord)
          (let*
           ((note-raw (extract-notes music))
            (duration (extract-duration note-raw))
            (notes (sort (extract-pitch note-raw) ly:pitch<?))
            (rep-pitches (ly:assoc-get (signature notes) replacements)))
           (if rep-pitches
               (begin
                 (remove-notes music)
                 (add-notes music rep-pitches duration))
               (display (format "Chord ~a not found!\n" (signature notes))))))
         (if (not (null? elt)) (walk-music-tree elt))
         (map walk-music-tree elts)))
   (walk-music-tree mus)
   mus)

% takes some music and creates a list of all pitches in the music
#(define (notes->pitches mus)
   (define (extract-notes music)
     (let
      ((name (ly:music-property music 'name))
       (elt (ly:music-property music 'element))
       (elts (ly:music-property music 'elements)))
      (if (eq? name 'NoteEvent)
          (let
           ((nelt (if (null? elt) elt (extract-notes elt)))
            (nelts (apply append (map extract-notes elts))))
           (cons music (append nelt nelts)))
          (let
           ((nelt (if (null? elt) elt (extract-notes elt)))
            (nelts (apply append (map extract-notes elts))))
           (append nelt nelts)))))
   (define (extract-one-pitch note)
     (ly:music-property note 'pitch))
   (define (extract-pitch notes)
     (map extract-one-pitch notes))
   ; is music a chord?
   (let
    ((note-raw (extract-notes mus)))
    (sort (extract-pitch note-raw) ly:pitch<?)))

% takes some music and creates a symbol representation of all pitches in the music
#(define (sigchord mus)
    (signature (notes->pitches mus)))

% takes music of the form { a1 a2 b1 b2 ... } and returns a replacement alist
% for replacing a1 with a2, b1 with b2, ...
replistfrommusic=#(define-scheme-function (mus) (ly:music?)
   (define (walk-elts elts)
    (if (or (null? elts) (null? (cdr elts)))
        '()
        (cons (cons (sigchord (car elts)) (notes->pitches (cadr elts)))
              (walk-elts (cddr elts)))))
   (let
    ((name (ly:music-property mus 'name))
     (elts (ly:music-property mus 'elements)))
    ; is music sequential?
    (if (not (eq? name 'SequentialMusic)) (warning "Music does not seem to be sequential!"))
    (walk-elts elts)))



%%%%%%%%%%%%%%%%%%%%%
%%%%%% EXAMPLE %%%%%%
%%%%%%%%%%%%%%%%%%%%%

rep = \replistfrommusic { c <c' e'>
                       d <d' f'>
                       <c' d' e'> <d' e' f'> }

{ \replaceChords \rep { <c' d' e'>->^"markup and chord articulations are preserved!" <c>^"to replace single notes, use single note chords!" c <d> <c,> } }

Attachment: signature.asc
Description: This is a digitally signed message part.

Reply via email to