Color note heads outside nominal instrument range

[Peter Gentry]

This is the cleaned up function - I hope Thunderbird does a better job 
then Outlook.

\version "2.19.15"
% 
-------------------------------------------------------------------------------------------------
%
% P Gentry (address@hidden)  29 May 2015
%
%Function to color any notes outside the nominal range of the instrument
%
%The nominal ranges are particualr performers ranges rather than actual 
instrument range
%
% include function file 
C:/Users/Peter/LilyPool/Includes/ranges/instrument_ranges.ly'
% usuage include --> \include "./ranges/instrument_ranges.ly"
% usuage call -->       \naturalizeInstrumentRange "instrument" music
%
% Note the ranges refer to music transposed for each instrument not the 
true pitches.
% use % for comment outside scheme function -  use ; inside scheme functions
% 
-------------------------------------------------------------------------------------------------

#(define (naturalize-instrument-range p instrument )
   (let ((o (ly:pitch-octave p))
  (a (* 4 (ly:pitch-alteration p)))
;; alteration, a, in quarter tone steps, for historical reasons
  (n (ly:pitch-notename p)))

;; clarinet range e, to f'  -1 2 0  to 1 3 0
(cond
   ((equal? instrument "clarinet" )
   (if (<= o -1) (begin (set! o -1 )))
  (if (>= o 3) (begin (set! o 2 )))
(cond
  ( (and (= o -1) (<= a 2) (<= n 1))   (set! o 0))
  ( (and (= o  2) (>    n 3))                (set! o 1))
  ( (and (= o  2) (<= n 3))                (set! o 2)) )
  (if (> o 2) (begin (set! o 2 ))))

;; bass clarinet eb range eb, to f'  -1 1 2  (-1 2 -2)  to 1 3 0
   ((equal? instrument "bass clarinet eb" )
   (if (<= o -1) (begin (set! o -1 )))
  (if (>= o 3) (begin (set! o 2 )))
(cond
  ( (and (= o -1) (<= a 2) (<= n 1))  (set! o 0))
  ( (and (= o  2) (>    n 3))               (set! o 1))
  ( (and (= o  2) (<= n 3))                (set! o 2)) )
  (if (> o 2) (begin (set! o 2 ))))

;; bass clarinet c range c, to f'  -1 0 0   to 1 3 0
   ((equal? instrument "bass clarinet c" )
   (if (<= o -1) (begin (set! o -1 )))
  (if (>= o 3) (begin (set! o 2 )))
(cond
  ( (and (= o -1) (< a 0) (<= n 0))  (set! o 0))
  ( (and (= o  2) (>    n 3))               (set! o 1))
  ( (and (= o  2) (<= n 3))                (set! o 2)) )
  (if (> o 2) (begin (set! o 2 ))))

;; flute range c to f'  1 0 0   to 1 3 0
((equal? instrument "flute")
    (if (< o 0) (begin (set! o 0 )))
(cond
  ( (and (= o 0) (< a  0) (= n 0)) (set! o 1))
  ( (and (= o 2) (> n  3))            (set! o 1))
  ( (and (= o 2) (<= n 3))           (set! o 2)) )
(if (> o 2) (begin (set! o 2 ))))

;; alto range c to f'  1 0 0   to 1 3 0
((equal? instrument "alto")
    (if (< o 0) (begin (set! o 0 )))
(cond
  ( (and (= o 0) (< a  0) (= n 0)) (set! o 1))
  ( (and (= o 2) (> n  3))            (set! o 1))
  ( (and (= o 2) (<= n 3))          (set! o 2)) )
  (if (> o 2) (begin (set! o 2 )))) )

 (ly:make-pitch o n (/ a 4))

))

% 
-------------------------------------------------------------------------------------------------
% a variable for the notehaed color on pitch change
% 
-------------------------------------------------------------------------------------------------

my-color = #(x11-color 'red)

% 
-------------------------------------------------------------------------------------------------
% this function rebuilds the music object optionally changing pitch and 
notehead color
% 
-------------------------------------------------------------------------------------------------
#(define (instrumentrange music instrument )
   (  ly:music? string? )
; extract the various portions of the music object
(let ((es (ly:music-property music 'elements))
           (e   (ly:music-property music 'element))
           (p   (ly:music-property music 'pitch)))

; rebuild any 'elements unchanged
(if (pair? es)
   (ly:music-set-property! music 'elements
   (map (lambda (x) (instrumentrange x instrument)) es)))

; rebuild any 'element unchanged
 (if (ly:music? e) (ly:music-set-property! music 'element
                            (instrumentrange e instrument )))

;rebuild the pitch and if a changed pitch add the color tweak
(if (ly:pitch? p)
          (let ((new-pitch (naturalize-instrument-range p instrument)))
          (ly:music-set-property! music 'pitch new-pitch)
          (if (and (not (equal? p new-pitch)) (color? my-color))
              (ly:music-set-property! music 'tweaks
              (acons
                'color my-color
               (ly:music-property music 'tweaks))))))

     music))

% 
------------------------------------------------------------------------------------------------------------------------------------
% the Lily file calling function \naturalizeInstrumentRange "instrument 
string"  followed by a sequential music object
% 
------------------------------------------------------------------------------------------------------------------------------------
naturalizeInstrumentRange =
#(define-music-function (parser location  instrument m )
  ( string? ly:music? )
  (instrumentrange m instrument ))

\score {
  \naturalizeInstrumentRange "bass clarinet eb"
  \new Staff \relative c' {
    c,8  cis des d dis ees e eis fes f fis ges g gis aes a ais bes b 
bis ces
   c8  cis des d dis ees e eis fes f fis ges g gis aes a ais bes b bis ces
   c8  cis des d dis ees e eis fes f fis ges g gis aes a ais bes b bis ces
   c8  cis des d dis ees e eis fes f fis ges g gis aes a ais bes b bis ces

  }
}
\score {
 \new Staff \relative c' {
    c,8  cis des d dis ees e eis fes f fis ges g gis aes a ais bes b 
bis ces
   c8  cis des d dis ees e eis fes f fis ges g gis aes a ais bes b bis ces
   c8  cis des d dis ees e eis fes f fis ges g gis aes a ais bes b bis ces
   c8  cis des d dis ees e eis fes f fis ges g gis aes a ais bes b bis ces

  }
}