Hi Harm,
sorry that I did not respond for over one month... Many other things had
to be done.
Now I would like to finish this snippet to be free for new interesting
things. ;)
I did substantially rework some parts of the engraver, namely switching
to a list-processing-way of dealing with current/last-grobs/pitches/...
Not sure if you like this change. I like it for less code duplication...
Hi Michael,
Am Fr., 27. Dez. 2019 um 16:12 Uhr schrieb Michael Käppler <xmichae...@web.de>:
Hi Harm,
thanks for your comments and this inspiring discussion!
me too!
Iiuc, you want to keep the possibility the user defines the intervaldefs like
#(define intervaldefs
'(("my-prime++" . (0 . 1))
...)
Exactly.
Fine with me, this should be mentioned in the description/comments,
probably like
%% Interval definitions alist
%% Key:
%% number-string determines the interval type, 1=prime, 2=second, 3=third ...
%% plus and minus signs determine variant, no sign=perfect interval, +=major,
%% ++=augmented, -=minor, --=diminished
%% Other strings for the interval-type are possible as well, if given
to the engraver in the same way.
(Bad wording, you may get the point, though ... hopefully)
Done.
Btw, I'd change
%% 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.
to always use capital N for
intervalN etc
Done. The reason was that I thought of 'n' as the "running" variable
(n=1,2,3 etc.) and 'N' as the last value,
that 'n' finally reaches.
But maybe this was rather misleading.
I found no need to do work in `process-acknowledged`.
Thus all work is done in 'note-head-interface of `acknowledgers`
Probably more efficient, but I have not really checked.
I think it is definitily more efficient, since process-acknowledged is
called multiple times after
one grob has been acknowledged by the engraver. The question is to which
extent
the "educational" idea of showing the various hooks in action justifies
this overhead.
I think we should go for the current code.
Other hooks should be thoroughly demonstrated, _if_ they are needed to
get the desired result.
In other words, demonstrating process-acknowledged should be left to
another LSR snippet.
Ok.
Btw, there is one case, where I don't know how to deal with:
2.18.2 can't cope with an empty engraver, see:
\score {
\new Staff \relative c' { c4 d }
\layout {
\context {
\Voice
\consists \color_interval_engraver #intervaldefs #`(("30-" 0 #t ,green))
}
}
}
No problem for 2.19.83, though.
Oh no, further insufficient testing of mine. The following minimal
"void" engraver
works for me with both 2.18.2 and 2.19.80:
`((initialize . ,(lambda (translator) #t)))
Nice, I'd add a comment about different behaviour of 2.18.2 vs 2.19.x
accepting an empty list as engraver.
You go back to the list-syntax, also possible would be:
(make-engraver ((initialize translator) '()))
Done.
Some other remarks:
the type-check uses ly:dir?, ofcourse it's my own suggestion to use
ly:dir?, though probably worth a comment, because the allowed 0 here
means UP _and_ DOWN as opposed to the usual CENTER.
Done.
Some comments exceed the 80-characters line-width.
For some strings you circumvent it by doing (string-append "long
string " "other long string")
I'll not object to do so. Though, I've no problem to simply put those
long strings at line-begin or to decrease indentation.
Even if that means to violate usual indentation-rules.
All things mentioned above are micro-issues, imho, I hope you'll not
tired of me being such a nitpicker.
Not at all. It's interesting to learn from your style!
And a general one.
If a note is last in previous interval and first in a new one, then
the color from the new one is done, leaving the first of the previous
interval with the for it set color:
\score {
<<
\new Staff { b c' b' }
\new Staff { <b c' b'> }
>>
\layout {
\context {
\Voice
\consists
\color_interval_engraver #intervaldefs
#`(("2-" 0 #t ,green)
("7+" 0 #t ,red)
)
}
}
}
No clue how to improve this situation.
You're absolutely right. I think this is unavoidable with this design
(coloring both notes).
I added a warning for this case and, while I was at it, some more debug
output.
Some neat solution would be to draw Horizontal_brackets instead. Thus we
could
correctly represent overlapping intervals, too.
I do not have the time to implement this, however.
Cheers,
Michael
\version "2.18.2"
%% 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 (parser location 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)))
(newline)
(format cep
"*** This is ~a from ~a ~a ***\n"
engraver-name context-type context-id)
(format cep "Bar number ~a, moment ~a\n"
current-bar-number current-moment)
(format cep "Pitches (last/current): ~a/~a\n"
(second pitches)
(first pitches))
(format cep "Distance (diatonic/semitonic): ~a/~a\n"
current-interval-dist-diatonic
current-interval-dist-semitonic)
(if matching-interval
(begin
(format cep "Match! Found interval ~a, coloring ~a\n"
matching-interval search-interval-color)
(if last-noteheads-color
(format cep
"Recoloring - Last note heads color: ~a\n"
last-noteheads-color))))
(display "---------------------\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))
}
}
}
