\version "2.18.2"

#(define (get-pitch elt)
   (ly:music-property elt 'pitch))

#(define (extract-pitches lst result) 
   (cond
    ((null? lst) result)
    ((ly:pitch? (get-pitch (car lst)))
     (set! result (append result (list (get-pitch (car lst)))))
     (extract-pitches (cdr lst) result))
    ((ly:music-property (car lst) 'elements)
     (append
      (extract-pitches (ly:music-property (car lst) 'elements) result)
      (extract-pitches (cdr lst) '())))
    (else (extract-pitches (cdr lst) result))))

extractPitches =
#(define-scheme-function
  (parser location lst)
  (ly:music?)
  (extract-pitches
   (extract-named-music lst '(EventChord NoteEvent))
   '()))

colorPitches =
#(define-music-function (parser location pitch-list col)
   (list? color?)
   #{
     \override NoteHead.color =
     #(lambda (grob)
        (let ((pitch (ly:event-property (ly:grob-property grob 'cause) 'pitch)))
          (if (any
               (lambda (x) (= (ly:pitch-semitones pitch) (ly:pitch-semitones x)))
               pitch-list)
              col)))
   #})



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


upper = \relative c' {
  c cis d dis es f fis fisis g aeses gis a ais bes b c
}

% \colorPitches takes a list of pitches.  These may be specified using the Scheme
% function ly:make-pitch or they can be extracted from a music expression, using
% the function \extractPitches

playerI = #(list (ly:make-pitch 0 1 0) (ly:make-pitch 0 4 1/2))

playerII = \extractPitches { \relative c' { cis es g } }


\score {
  \new Staff \upper
  \layout { }
}

\score {
  \new Staff {
    \colorPitches \playerI #blue
    \upper
  }
  \layout { }
}

\score {
  \new Staff {
    \colorPitches \playerII #green
    \upper
  }
  \layout { }
}

\score {
  \new Staff {
    \colorPitches \extractPitches { \relative c' { <fis ais> } } #yellow
    \upper
  }
  \layout { }
}

% demonstrates \extractPitches
%#(display #{ \extractPitches \upper #})