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
Am 16.12.2019 um 01:50 schrieb Thomas Morley:
Am So., 15. Dez. 2019 um 21:47 Uhr schrieb Thomas Morley
<thomasmorle...@gmail.com>:
Am So., 15. Dez. 2019 um 21:17 Uhr schrieb Michael Käppler <xmichae...@web.de>:
Hi all,
a few days ago I submitted a snippet to the LSR (title "Coloring
successive intervals"). I can see it in the snippet database,
but not in the webpage. The "Contributing" section of LSR states, that:
"Once the snippet is in, it has to be reviewed and approved by one of
the LSR editors,
and then it must be digested by the search engine. Within a few days,
you should be able to see your snippet online."
Is this still valid in principle? Or maybe did I something wrong?
Cheers,
Michael
In principle ... yes.
Though, I seem to be the only remaining regular active LSR editor, and
my time is limited.
Thus it may take some more time than the LSR "Contributing" section says.
Announcing it on the list helps, ofcourse.
I'll take a look soon.
As promised I had a look.
Many thanks for your snippet!
For now:
First I changed the LSR button "Large snippet" to "Standalone snippet".
It's a very rare case "Large snippet" is apppropriate, usualy for
snippets outputting multipe pages. In almost every other case it's
better to uncheck the buttons or to go for "Standalone snippet".
Otherwise compressed and (imho) ugly images are output by the LSR.
Please always observe a 80-characters line-width limit for your code.
Your snippet contains some advanced code. In such cases I often want
to discuss things a bit deeper. So:
What bugged me right from the first glance over it, is your need to
define several engravers, one for each case.
I think one engraver should do the work for _all_ those cases.
Attached you'll find my suggestion for this, along with better
indentation, 80-chars-line-width along with some minor adjustments.
Please have a look.
Nevertheless that can't be the final state, imho.
May I ask you to add inline code-comments what's done and why?
There are not so many examples of scheme-engravers around. One
thoroughly commented would be great.
Additionally, I'd go for more self-explaining variable-names.
P.e. "dt-st": for me it's an arbitrary collection of characters, with
a hyphen somewhere ;)
Thanks,
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 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 diatonical and semitonical
% distances for certain intervals
%
% 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 intervaldefs debug? intervals-given)
(list? (boolean? #f) list?) ; debug? is optional, defaults to #f
(let* ((msg-with-header
(lambda (msg)
(string-append "Color_interval_engraver: " msg)))
(lookup-interval-dist
(lambda (name)
(assoc-get name intervaldefs)))
(valid-interval?
(lambda (interval)
(let ((name (car interval))
(dir (second interval))
(enh? (third interval))
(color (fourth interval)))
(and (string? name)
(integer? dir)
(boolean? enh?)
(color? color)))))
(valid-interval-dist?
(lambda (dist)
(let ((dt (car dist))
(st (cdr dist)))
(and (integer? dt)
(integer? st)
(>= dt 0)
(>= st 0)))))
(valid-interval-dir?
(lambda (dir)
(or
(= dir UP)
(= dir 0)
(= dir DOWN))))
(search-intervals '()))
(for-each
(lambda (interval)
; Unpack interval data structure step by step, only go on
; if everything seems to be valid
(if (not (valid-interval? interval))
(ly:warning
(gen-warntext "Invalid interval specification ~a")
interval)
(let* ((name (car interval))
(dist (lookup-interval-dist name)))
(if (not dist)
(ly:warning
(msg-with-header
"Interval ~a not found in interval definitions")
name)
(if (not (valid-interval-dist? dist))
(ly:warning
(msg-with-header
"Found invalid definition ~a for interval ~a")
dist name)
(let ((dir (second interval)))
(if (not (valid-interval-dir? dir))
(ly:warning
(msg-with-header
"Invalid direction ~a for interval ~a specified")
dir name)
; All validity checks completed, combine interval
distances
; with other interval parameters (direction,
enharmonic?,
; color)
(let ((processed-interval (cons dist (cdr
interval))))
; Insert the processed interval at the beginning
of
; the result list, which is handed over to the
actual
; engraver. The result list is in reversed order,
; compared to the given interval list.
(set! search-intervals
(cons processed-interval
search-intervals))))))))))
intervals-given)
(if debug?
(begin
(display
(msg-with-header "Preprocessed intervals:\n")
(current-error-port))
(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
(msg-with-header
"No valid interval found. Returning 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)))
((process-acknowledged translator)
; process-acknowledged is called multiple times during
; a musical moment, even before any grob has been acknowledged.
; Therefore check whether there are already grobs in the queue
(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
(cond ((= search-interval-dir UP)
(and
(= search-interval-dist-semitonic
current-interval-dist-semitonic)
(if (not search-interval-enh?)
(= search-interval-dist-diatonic
current-interval-dist-diatonic)
#t)))
((= search-interval-dir 0)
(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)))
((= search-interval-dir DOWN)
(and
; for direction DOWN compare with negated
; values
(= search-interval-dist-semitonic
(- 0 current-interval-dist-semitonic))
(if (not search-interval-enh?)
(= search-interval-dist-diatonic
(- 0 current-interval-dist-diatonic))
#t)))
(else #f)))))
; 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)
;; added to trigger the warning
("2+++" ,DOWN #f ,darkyellow))
}
}
}
\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))
}
}
}
