Coloring successive intervals
This scheme engraver searches for specified successive intervals in a voice, e.g. a minor third. If the interval occurs somewhere, the note heads of both notes defining the interval are colored. The engraver can be added to every Voice context.
Usage: \color_interval_engraver #intervaldefs #debug? #intervals-given
intervaldefs: alist containing information about semitonical distances for certain intervals, diatonical distance is calculated in the engraver using `string-diatonic-semi-tonic-list`, relying on the key.
debug?: (optional) boolean, if true, output information about the processed pitches
intervals-given: list of the form
#`((interval1 ,dir1 enh1 ,color1)
(interval2 ,dir2 enh2 ,color2)
...
(intervalN ,dirN enhN ,colorN))
with
intervalN: string - specifying the interval to search after
dirN: integer - UP (=1) DOWN (=-1) or 0 (up and down)
enhN: boolean - search for enharmonically equivalent intervals, too?
colorN: lilypond color value, see NR A.7.
Example:
\layout {
\context {
\Voice
\consists \color_interval_engraver #intervaldefs
#`(("2--" ,UP #f ,green)
("3+" ,DOWN #t ,blue))
}
}
Debug mode:
With debug? set to #t, the engraver does output
- The preprocessed list of intervals to search after
- Detailed information about all note head grobs the engraver has acknowledged
Warnings:
The engraver tries to provide helpful warning messages when fed with invalid input or if other issues prevent the engraver from working correctly.
Some examples:
Warning: Color_interval_engraver: In interval (2++ 2 #f (0.5 0.5 0.0)), wrong type argument: 2, needs to be a direction.Warning: Color_interval_engraver: Recoloring note head in Voice N/A, bar number 1 #<Pitch ees'> belongs to intervals ((2 . 3) 1 #f (0.0 1.0 0.0)) and ((3 . 5) -1 #f (1.0 0.0 0.0))Warning: Adding color_interval_engraver to a Staff context may lead to unexpected results if the Staff contains more than one voice.
\version "2.24.0"
%%% Create an engraver that colors note heads depending on the
%%% intervals between successive pitches
%% Interval definitions alist
%%
%% Key:
%% number determines the interval type, 1=prime, 2=second, 3=third ...
%% plus and minus signs determine variant, no sign=perfect interval, +=major,
%% ++=augmented, -=minor, --=diminished
%% This naming scheme is arbitrary, it is possible to label the interval-types
%% differently, like
%%
%% '(("A1" . (0 . 1))
%% ("P1" . (0 . 0))
%% ("m2" . (1 . 1)) etc.
%%
%% if an argument list using the same labels is passed to the engraver.
%%
%% Value:
%% the car represents the diatonic, the cdr the semitonic steps.
%% Only positive values are specified, negative values for
%% intervals downwards are generated in the engraver.
%% This list may be extended or completely overwritten
%% Usage: #(display (assoc-get "4--" intervaldefs))
#(define intervaldefs
'(("1++" . (0 . 1))
("1" . (0 . 0))
("2-" . (1 . 1))
("2--" . (1 . 0))
("2+" . (1 . 2))
("2++" . (1 . 3))
("3-" . (2 . 3))
("3--" . (2 . 2))
("3+" . (2 . 4))
("3++" . (2 . 5))
("4--" . (3 . 4))
("4++" . (3 . 6))
("4" . (3 . 5))
("5--" . (4 . 6))
("5++" . (4 . 8))
("5" . (4 . 7))
("6-" . (5 . 8))
("6--" . (5 . 7))
("6+" . (5 . 9))
("6++" . (5 . 10))
("7-" . (6 . 10))
("7--" . (6 . 9))
("7+" . (6 . 11))
("7++" . (6 . 12))
("8--" . (7 . 11))
("8++" . (7 . 13))
("8" . (7 . 12))
("9-" . (8 . 13))
("9--" . (8 . 12))
("9+" . (8 . 14))
("9++" . (8 . 15))
("10-" . (9 . 15))
("10--" . (9 . 14))
("10+" . (9 . 16))
("10++" . (9 . 17))
("11--" . (10 . 16))
("11++" . (10 . 18))
("11" . (10 . 17))
("12--" . (11 . 18))
("12" . (11 . 19))))
%% Create an engraver that compares the intervals between sequential pitches
%% of a voice with a given list of intervals.
%% If a specified interval is found, the heads of both notes encompassing
%% the interval are colored.
%%
%% Mode of operation:
%% Intervals are defined by two integers representing the diatonic
%% resp. semitonic distance between two pitches.
%% It is necessary to take both distances into account to distinguish
%% between enharmonically identical intervals, e.g. a major third
%% and a diminished fourth.
%% Example:
%% d -> f# : diatonic distance = 2 steps (f# is derived from f natural),
%% semitonic distance = 4 steps
%% d -> gb: diatonic distance = 3 steps (gb is derived from g natural),
%% semitonic distance = 4 steps
%%
%% The engraver consists of two parts:
%%
%% color_interval_engraver: checks, whether the given parameters are valid,
%% looks up the interval in the interval definitions alist and hands
%% the determined interval distances together with the other unchanged
%% parameters over to the actual engraver color-interval-engraver-core.
%%
%% color-interval-engraver-core: creates a scheme-engraver which
%% acknowledges note head grobs and stores the last and
%% current grob locally. Then the pitches are extracted and the interval between
%% the last and current pitch is compared to the specified interval.
%%
%% Usage:
%% \color_interval_engraver #intervaldefs #debug? intervals-given
%%
%% intervaldefs: alist containing information about semitonical distances for
%% certain intervals, diatonical distance is calculated in the engraver using
%% `string-diatonic-semi-tonic-list`, relying on the key.
%%
%% debug?: (optional) boolean, if true, output information about the processed
%% pitches
%%
%% intervals-given: list of the form
%% #`((interval1 ,dir1 enh1 ,color1)
%% (interval2 ,dir2 enh2 ,color2)
%% ...
%% (intervalN ,dirN enhN ,colorN))
%% with
%% intervalN: string - specifying the interval to search after
%% dirN: integer - UP (=1) DOWN (=-1) or 0 (up and down)
%% enhN: boolean - search for enharmonically equivalent intervals, too?
%% colorN: lilypond color value, see NR A.7.
%%
%% Constructing the argument list with `(= quasiquote) provides
%% an elegant shorthand for (list (list interval1 dir1 enh1 color1)
%% (list interval2 dir2 enh2 color2))
%% This would not work with '(= quote), because this special form does
%% not allow to unquote certain list elements with the comma ,
%% The directions UP and DOWN and the color values, however, need
%% to be evaluated to the corresponding integer values resp.
%% RGB values.
%%
%% \layout {
%% \context {
%% \Voice
%% \consists \color_interval_engraver #intervaldefs
%% `(("2--" ,UP #f ,green)
%% ("3+" ,DOWN #t ,blue))
%% }
%% }
color_interval_engraver =
#(define-scheme-function (interval-defs debug? intervals-given)
(list? (boolean?) list?) ;; debug? is optional, defaults to #f
(let* ((msg-header "Color_interval_engraver:")
;; 2.18.2 does not accept an empty list as engraver, unlike 2.19.x
(empty-engraver
(make-engraver ((initialize translator) '())))
(type-check-interval
(lambda (interval)
;; basic check for amount of args
(if (not (= 4 (length interval)))
(begin
(ly:warning
"~a Interval ~a must have 4 entries" msg-header interval)
#f)
;; check every entry for type, additionally the first entry
;; whether it's a key in intervaldefs
(let ((name (car interval))
(dir (second interval))
(enh? (third interval))
(color (fourth interval)))
(and
;; check first entry for string? and
;; whether it's in intervaldefs
(if (and (string? name) (assoc-get name intervaldefs))
#t
(begin
(ly:warning
"~a In interval ~a, ~a not found in interval definitions"
msg-header
interval
(car interval))
#f))
;; check second entry for ly:dir?
;; As opposed to the normal meaning of 0 (=CENTER),
;; 0 means up >and< down here
(if (ly:dir? dir)
#t
(begin
(ly:warning
"~a In interval ~a, wrong type argument: ~a, needs to be a direction."
msg-header
interval
dir)
#f))
;; check third entry for boolean?
(if (boolean? enh?)
#t
(begin
(ly:warning
"~a In interval ~a, wrong type argument: ~a, needs to be a boolean."
msg-header
interval
enh?)
#f))
;; check fourth entry for color?
(if (color? color)
#t
(begin
(ly:warning
"~a In interval ~a, wrong type argument: ~a, needs to be a color."
msg-header
interval
color)
#f)))))))
(cleaned-intervals-given
(filter type-check-interval intervals-given))
(search-intervals
(map
(lambda (interval)
(let ((diatonic-semitonic-pair
(assoc-get (car interval) interval-defs)))
(cons diatonic-semitonic-pair (cdr interval))))
cleaned-intervals-given)))
(if debug?
(begin
(ly:message "~a Preprocessed intervals:\n" msg-header)
(for-each
(lambda (search-interval)
(format (current-error-port)
"Distances (DT/ST):~a, direction:~a, enharmonic:~a, color:~a\n"
(car search-interval)
(second search-interval)
(third search-interval)
(fourth search-interval)))
search-intervals)))
(if (null? search-intervals)
(begin
(ly:warning
"~a No valid interval found. Returning empty engraver" msg-header)
empty-engraver)
;; Instantiate actual engraver
(color-interval-engraver-core search-intervals debug?))))
#(define (color-interval-engraver-core search-intervals debug?)
(lambda (context)
;; Context type: Staff, Voice, etc.
;; Context id: arbitrary string
;; \new <context-type> = <context-id> \music
;; \new Voice = "soprano" \music
(let ((engraver-name "Color_interval_engraver")
(context-type (ly:context-name context))
(context-id (let ((id (ly:context-id context)))
(if (string-null? id)
"N/A"
id)))
;; Later we want to extract the current bar number from there
(score-context (ly:context-find context 'Score))
(noteheads-to-process '())
(ready-to-process? #f)
(last-noteheads-color #f)
(last-interval #f))
(make-engraver
((initialize translator)
;; Output a warning if the engraver has been added to a Staff context
;; If the Staff consists of more than one Voice, the engraver cannot
;; distinguish the different voices and will mix them up
(if (eq? context-type 'Staff)
(ly:warning
(string-append
"Adding color_interval_engraver to a Staff context may lead "
"to unexpected results if the Staff contains more than one "
"voice."))))
;; This engraver does not listen to events, thus it does not
;; define listeners. It does only acknowledge grobs,
;; specifically note heads created by other engravers.
(acknowledgers
((note-head-interface engraver grob source-engraver)
(if ready-to-process?
;; if we have two note heads already, push the old one out
(set! noteheads-to-process (list grob (car noteheads-to-process)))
;; We need two note heads to compare the underlying pitches
;; -> store note heads until we have two
(begin
(set! noteheads-to-process (cons grob noteheads-to-process))
(if (= (length noteheads-to-process) 2)
(set! ready-to-process? #t))))
;; Check for grobs in the queue, before continuing
(if ready-to-process?
;; Note head grobs store a reference to the
;; event that caused their generation
;; Thus we can extract the pitch
(let* ((current-bar-number
(ly:context-property score-context 'currentBarNumber))
(current-moment (ly:context-current-moment context))
(grob-causes (map (lambda (grob)
(ly:grob-property grob 'cause))
noteheads-to-process))
(pitches (map (lambda (cause)
(ly:event-property cause 'pitch))
grob-causes))
;; Calculate interval distances, diatonic and semitonic
(current-interval-dist-diatonic
(apply - (map ly:pitch-steps pitches)))
(current-interval-dist-semitonic
(apply - (map ly:pitch-semitones pitches)))
;; Check if a given interval matches the current interval
(interval-match?
(lambda (search-interval)
(let* ((search-interval-dist (car search-interval))
(search-interval-dir (second search-interval))
(search-interval-enh? (third search-interval))
(search-interval-dist-diatonic
(car search-interval-dist))
(search-interval-dist-semitonic
(cdr search-interval-dist)))
;; if search-interval-enh? was set to true for
;; the current interval, compare only the semitonic
;; distances, e.g. c#-f would also match a major 3rd,
;; not only a diminished 4th
;;
;; search-interval-dir can only be -1, 0, 1
;; other values are excluded by typechecking,
;; thus 0 needs special casing,
;; for other cases multiplying relevant value with
;; search-interval-dir is enough
;; -- harm
(if (zero? search-interval-dir)
(and
;; if direction does not matter, compare
;; with absolute values
(= search-interval-dist-semitonic
(abs current-interval-dist-semitonic))
(if (not search-interval-enh?)
(= search-interval-dist-diatonic
(abs current-interval-dist-diatonic))
#t))
(and
(= search-interval-dist-semitonic
(* search-interval-dir
current-interval-dist-semitonic))
(if (not search-interval-enh?)
(= search-interval-dist-diatonic
(* search-interval-dir
current-interval-dist-diatonic))
#t))))))
;; Get first occurrence of a matching interval
(matching-interval (find interval-match? search-intervals))
;; Extract color from matching interval
(search-interval-color (if matching-interval
(fourth matching-interval)
#f)))
(if debug?
(let* ((cep (current-error-port)))
(format cep
"\n*** This is ~a from ~a ~a ***\n"
engraver-name context-type context-id)
(format cep "\nBar number ~a, moment ~a\n"
current-bar-number current-moment)
(format cep "\nPitches (last/current): ~a/~a\n"
(second pitches)
(first pitches))
(format cep "\nDistance (diatonic/semitonic): ~a/~a\n"
current-interval-dist-diatonic
current-interval-dist-semitonic)
(if matching-interval
(begin
(format cep "\nMatch! Found interval ~a, coloring ~a\n"
matching-interval search-interval-color)
(if last-noteheads-color
(format cep
"\nRecoloring - Last note heads color: ~a\n"
last-noteheads-color))))
(display "\n---------------------\n" cep)))
(if search-interval-color
(begin
;; Check if the note heads directly preceding were
;; colored, too. If true, the last note head belongs
;; to two distinct intervals
;;
;; <noteheads-to-process>
;; (grobB grobA)
;; interval grobB<->grobA matches -> color!
;; (grobB_colored grobA_colored)
;; <next iteration>
;; (grobC grobB_colored)
;; interval grobC<->grobB matches -> color!
;; (grobC_colored grobB_colored_colored (!))
;; -> information about interval grobA<->grobB gets lost
;; In this case, print a warning
(if last-noteheads-color
(ly:warning
(string-append
"~a: Recoloring note head in ~a ~a, bar number ~a\n"
"~a belongs to intervals ~a and ~a")
engraver-name
context-type
context-id
current-bar-number
(second pitches)
last-interval
matching-interval))
;; Color current and last note head grob
(for-each
(lambda (grob)
(ly:grob-set-property!
grob
'color
search-interval-color))
noteheads-to-process)))
;; Preserve the current color (if any) for recoloring check
;; (see above)
(set! last-noteheads-color search-interval-color)
(set! last-interval matching-interval)))))))))
\markup \column {
\line {
"Diminished second," \with-color #green "up" "and" \with-color #blue "down"
}
\line {
"Minor second," \with-color #yellow "up" "and" \with-color #cyan "down"
}
\line {
"Major second," \with-color #red "up" "and" \with-color #darkgreen "down"
}
\line {
"Augmented second," \with-color #darkcyan "up"
"and" \with-color #darkyellow "down"
}
}
\score {
\new Voice
\relative c'' {
fis4 g e d as gis cis bes f g cis des des, e g fis
}
\layout {
\context {
\Voice
\consists
\color_interval_engraver #intervaldefs
#`(("2--" ,UP #f ,green)
("2--" ,DOWN #f ,blue)
("2-" ,UP #f ,yellow)
("2-" ,DOWN #f ,cyan)
("2+" ,UP #f ,red)
("2+" ,DOWN #f ,darkgreen)
("2++" ,UP #f ,darkcyan)
("2++" ,DOWN #f ,darkyellow)
;; Not specified interval
;("2+++" ,DOWN #f ,darkyellow)
;; Direction not suitable
;("2++" 2 #f ,darkyellow)
;; Wrong type argument for 'searching enharmonically equivalent, too?'
;("2++" ,DOWN foo ,darkyellow)
;; Wrong type for color
;("2++" ,DOWN #f (1 2 3 4 5))
;; Wrong amount of entries
;("2++" ,DOWN #f)
)
}
}
}
\markup \column {
"Color intervals regardless of direction"
\with-color #green "Diminished third"
\with-color #yellow "Minor third"
\with-color #red "Major third"
\with-color #darkcyan "Augmented third"
}
\score {
\new Staff \relative c' { d4 f e cis gis' e f a d bis cis as e ges des fis }
\layout {
\context {
\Voice
\consists \color_interval_engraver #intervaldefs
#`(("3--" 0 #f ,green)
("3-" 0 #f ,yellow)
("3+" 0 #f ,red)
("3++" 0 #f ,darkcyan))
}
}
}
\markup \column {
"Color enharmonically equivalent intervals, too"
\with-color #green "Augmented second, minor third"
}
\score {
\new Staff \relative c' { d4 f e a ges }
\layout {
\context {
\Voice
\consists \color_interval_engraver #intervaldefs #`(("3-" 0 #t ,green))
}
}
}
\markup \column {
"Output warning, if note belongs to two intervals"
\line { \with-color #green "Minor third" and
\with-color #red "perfect fourth" }
}
\score {
\new Staff \relative c' { c4 es bes des }
\layout {
\context {
\Voice
\consists \color_interval_engraver #intervaldefs
#`(("3-" ,UP #f ,green)
("4" ,DOWN #f ,red))
}
}
}
\markup \column {
"Output debug information"
\line { \with-color #green "Minor second" and
\with-color #red "perfect fourth" }
}
\score {
<<
\new Voice = "Soprano" \relative c' {
\key b \minor
\partial 2 fis2
e2. fis4
b2 a4 r
cis fis, b a
gis2 fis4 r
}
\new Voice = "Alto" \relative c' {
\key b \minor
\partial 2 d2
cis2. d4
d (e) fis r
fis (fis) eis fis
fis eis fis r
}
>>
\layout {
\context {
\Voice
\consists \color_interval_engraver #intervaldefs ##t
#`(("2-" ,DOWN #f ,green)
("4" ,UP #f ,red))
}
}
}
\markup \column {
"Output warning, if engraver has been added to staff instead of voice context"
\line { \with-color #green "Minor second" and
\with-color #red "perfect fourth" }
}
\score {
\new Staff <<
\new Voice = "Soprano" \relative c' {
\voiceOne
\key b \minor
\partial 2 fis2
e2. fis4
b2 a4 r
cis fis, b a
gis2 fis4 r
}
\new Voice = "Alto" \relative c' {
\voiceTwo
\key b \minor
\partial 2 d2
cis2. d4
d (e) fis r
fis (fis) eis fis
fis eis fis r
}
>>
\layout {
\context {
\Staff
\consists \color_interval_engraver #intervaldefs
#`(("4" ,UP #f ,red)
("2-" ,DOWN #f ,green))
}
}
}
\paper { tagline = ##f }
