Am Sa., 21. Dez. 2019 um 00:35 Uhr schrieb Michael Käppler <xmichae...@web.de>:
>
> Hi Harm et al.,
> attached is my updated version.
> I decided to split up the validity checks from the actual engraver,
> because otherwise in case of invalid parameters the engraver would
> only be instantiated to do nothing and nevertheless have its
> acknowledger called every time.
> The code is much more verbose now, which makes the flow of information
> and control
> clearer I hope.
>
> Please let me know what you think about it.
>
> Cheers,
> Michael
Hi Michael,
thanks again for your updated snippet.
I've taken a closer look.
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.
Along with it, I added a basic check for the user provided list (about
equal length of each sublist)
There was an undefined variable `gen-warntext`, which is now gone as well.
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 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.
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.
Cheers,
Harm
\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 cdr represents the semitonic steps.
%% diatonic steps are calculated relying on the key in the engraver
%% 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++" . 1)
("1" . 0)
("2-" . 1)
("2--" . 0)
("2+" . 2)
("2++" . 3)
("3-" . 3)
("3--" . 2)
("3+" . 4)
("3++" . 5)
("4--" . 4)
("4++" . 6)
("4" . 5)
("5--" . 6)
("5++" . 8)
("5" . 7)
("6-" . 8)
("6--" . 7)
("6+" . 9)
("6++" . 10)
("7-" . 10)
("7--" . 9)
("7+" . 11)
("7++" . 12)
("8--" . 11)
("8++" . 13)
("8" . 12)
("9-" . 13)
("9--" . 12)
("9+" . 14)
("9++" . 15)
("10-" . 15)
("10--" . 14)
("10+" . 16)
("10++" . 17)
("11--" . 16)
("11++" . 18)
("11" . 17)
("12--" . 18)
("12" . 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))
%% }
%% }
#(use-modules (ice-9 pretty-print))
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)
(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))
;; 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
(reverse
(map
(lambda (interval)
(let ((diatonic-semitonic-pair
(assoc-get (car interval) interval-defs-list)))
(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)
'())
;; 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))
}
}
}
