Hi Harm,
thanks for your comments and this inspiring discussion!
I would like to discuss a couple of things further.
My current version is attached.
You try to give the user always meaningful warning-messages.
That's great, putting out really helpful messages is hard work...
Alas, speaking only for me, I don't like those multiple nested `if`.
Thus I defined `type-check-intervals-given` and use it to filter the
user-given interval-list.
`filter` will return false for the first occurrence of failed
`type-check-intervals-given`. Thus it can be used to deal with
user-errors step-by-step.
Nice solution!
Along with it, I added a basic check for the user provided list (about
equal length of each sublist)
A good addition, but it did not work as intended, because the dissection
of the list with (car) (second) etc. took place regardless of whether
the interval was well-formed. See the comment in the code below.
I would not use ly:error here, because that will
terminate the compilation process, right? It may be that
some intervals are well-formed and some are not. I think we should
still go on and process the well-formed intervals.
Otherwise we should raise an error for the other fault conditions
(Direction, enharmonic, color, missing interval in definitions) too,
what I do not think is appropriate.
There was an undefined variable `gen-warntext`, which is now gone as well.
Sorry for that mistake, which reminds me of always thoroughly testing
my code... :(
Furthermore, I changed the basic `intervaldefs` to take only pairs of
the interval-string and the semi-tonoc steps. The diatonic steps are
calculated relying on the interval-string.
I have to admit that I'm not happy with this change.
I think the user should be able to use custom
interval denotations like e.g.
https://en.wikipedia.org/wiki/Interval_(music)#Alternative_interval_naming_conventions
rather than having to rely on a hardcoded system.
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.
A plethora of minor changes in code and comments... ;)
WDYT?
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)))
I'm commenting now directly in your code, mentioning only thoughts
that I did not mention before. Btw, your code had pretty much
lines with trailing whitespace which I removed, because I work here
on a local git repo and the diffs become cluttered otherwise...
#(use-modules (ice-9 pretty-print))
Removed, since unused.
color_interval_engraver =
#(define-scheme-function (parser location intervaldefs debug?
intervals-given)
(list? (boolean?) list?) ;; debug? is optional, defaults to #f
(define (string-diatonic-semi-tonic-list string-semi-tonic-list)
(map
(lambda (e)
(let* ((interval-string
(string-trim-both
(car e)
(lambda (c) (or (eqv? c #\+) (eqv? c #\-)))))
(interval-diatonic
(string->number interval-string)))
(cons (car e) (cons (1- interval-diatonic) (cdr e)))))
string-semi-tonic-list))
(define (type-check-intervals-given msg-header)
Is there a reason for not defining this as a binding
in the following (let* ...)?
No need to explicitly pass msg-header, then.
(lambda (interval)
;; basic check for amount of args
(if (= 4 (length interval))
#t
(begin
(ly:error
"~a Interval ~a must have 4 entries" msg-header interval)
#f))
Here is a bug - if the check does not succeed,
the function will not return with #f but instead
go on with the (let) construct.
;; check every entry for type, additonally 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?
(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))))))
(let* ((msg-header "Color_interval_engraver:")
(interval-defs-list (string-diatonic-semi-tonic-list
intervaldefs))
(cleaned-intervals-given
(filter (type-check-intervals-given msg-header)
intervals-given))
(search-intervals
;; mmh, not sure if `reverse` is really needed
It is not needed, because the order of checking the intervals does not
matter.
(It would only matter if two conflicting interval colors are given, like
\consists \color_interval_engraver #intervaldefs
#`(("3--" 0 #f ,green)
("3--" 0 #f ,yellow))
(reverse
(map
(lambda (interval)
(let ((diatonic-semitonic-pair
(assoc-get (car interval) interval-defs-list)))
(cons diatonic-semitonic-pair (cdr interval))))
cleaned-intervals-given))))
[Rest skipped]
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
%% 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:")
(empty-engraver
`((initialize . ,(lambda (translator) #t))))
(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, additonally 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?
(if (ly:dir? dir)
#t
(begin
(ly:warning
(string-append
"~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
(string-append
"~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
(string-append
"~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)
(let ((last-grob #f)
(current-grob #f))
(make-engraver
;; 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)
;; Store current and last note head grob
(set! last-grob current-grob)
(set! current-grob grob)
;; Check for grobs in the queue, before continuing
(if (and last-grob current-grob)
;; Note head grobs store a reference to the
;; event that caused their generation
;; Thus we can extract the pitch
(let* ((current-grob-cause
(ly:grob-property current-grob 'cause))
(current-pitch
(ly:event-property current-grob-cause 'pitch))
(last-grob-cause (ly:grob-property last-grob 'cause))
(last-pitch (ly:event-property last-grob-cause 'pitch))
;; Calculate interval distances, diatonic and semitonic
(current-interval-dist-diatonic
(- (ly:pitch-steps current-pitch)
(ly:pitch-steps last-pitch)))
(current-interval-dist-semitonic
(- (ly:pitch-semitones current-pitch)
(ly:pitch-semitones last-pitch)))
;; 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 "Previous pitch: ~a\n" last-pitch)
(format cep "Current pitch: ~a\n" current-pitch)
(format cep "Diatonic diff: ~a\n"
current-interval-dist-diatonic)
(format cep "Semitonic diff: ~a\n"
current-interval-dist-semitonic)
(format cep "Matching interval: ~a\n" matching-interval)
(format cep "Grob color: ~a\n" search-interval-color)
(display "**********\n" cep)))
(if search-interval-color
(begin
;; Color current and last note head grob
(set! (ly:grob-property current-grob 'color)
search-interval-color)
(set! (ly:grob-property last-grob 'color)
search-interval-color)))))))))))
\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 Staff
\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))
}
}
}
\score {
\new Staff \relative c' { c4 d }
\layout {
\context {
\Voice
\consists \color_interval_engraver #intervaldefs #`(("30-" 0 #t ,green))
}
}
}
