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"

%%% 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
% Value:
% the car represents the diatonic steps, the cdr the semitones
% 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))))


% Usage:
% \interval_color_engraver intervaldefs interval dir enh color
% intervaldefs: alist containing information about diatonical and semitonical 
% distance for certain intervals
% interval: string - specifying the interval to search after
% dir: integer - #UP (=1) #DOWN (=-1) or #0 (up and down)
% enh: boolean - search for enharmonically equivalent intervals, too?
% color: lilypond color value, see NR A.7.
% 
% \layout {
%   \context {
%     \Voice 
%     \consists \interval_color_engraver #intervaldefs #"2--" #UP ##f #green
%   }
% }

interval_color_engraver = 
#(define-scheme-function (parser location intervaldefs args)
  (list? list?)
  (lambda (context)
    (let* ((intervals (map car args))
           (dirs (map second args))
           (enhs (map third args))
           (colors (map fourth args))
           (dt-st-list 
             (map 
               (lambda (interval)
                 (assoc-get interval intervaldefs))
               intervals))
           (given-intervals-dt-st-list '())
           (last-grob #f)
           (current-grob #f)
           (neg (lambda (pair) (cons (- (car pair)) (- (cdr pair)))))
           (DEBUG 0))

      (make-engraver
       ((initialize translator)
        (for-each
          (lambda (interval dir dt-st)
            (if dt-st
                (set! given-intervals-dt-st-list
                  (cons
                    (case dir
                      ((1) (list dt-st))
                      ((0) (list dt-st (neg dt-st)))
                      ((-1) (list (neg dt-st)))
                      (else 
                        (ly:warning 
                         "Invalid direction ~a specified. Can't color anything." 
                          dir)
                        '()))
                     given-intervals-dt-st-list))
                (ly:warning 
          "Interval ~a not found in interval definitions. Can't color anything." 
                  interval)))
            intervals
            dirs
            dt-st-list))
       (acknowledgers
        ((note-head-interface engraver grob source-engraver)
         (set! last-grob current-grob)
         (set! current-grob grob)))
       ((process-acknowledged translator)
       
        (for-each
          (lambda (enh given-intervals-dt-st interval color)
            (if (and last-grob current-grob)
                (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))
                       (current-interval-dt-st  
                         (cons
                           (- (ly:pitch-steps current-pitch)
                              (ly:pitch-steps last-pitch))
                           (- (ly:pitch-semitones current-pitch)
                              (ly:pitch-semitones last-pitch))))
                       (check-interval 
                         (lambda (interval)
                           (if enh
                               ; To find enharmonically equivalent intervals,  
                               ; only compare semitonical distance
                               (= (cdr interval) (cdr current-interval-dt-st))
                               (equal? interval current-interval-dt-st))))
                       (color-grob? (any check-interval given-intervals-dt-st)))
                  (if (= DEBUG 1)
                      (let ((cep (current-error-port))
                            (first-of-cidtst (car current-interval-dt-st))
                            (second-of-cidtst (cdr current-interval-dt-st)))
                        (newline)
                        (format cep "Previous pitch: ~a\n" last-pitch)
                        (format cep "Current pitch: ~a\n" current-pitch)
                        (format cep "Diatonic diff: ~a\n" first-of-cidtst)
                        (format cep "Semitonic diff: ~a\n" second-of-cidtst)
                        (format cep "Color grob?: ~a\n" color-grob?)))
                  (if color-grob?
                      (begin
                        (set! (ly:grob-property current-grob 'color) color)
                        (set! (ly:grob-property last-grob 'color) color))))))
          enhs
          (reverse given-intervals-dt-st-list)
          intervals
          colors))))))
  
\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 
        \interval_color_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 \interval_color_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 \interval_color_engraver #intervaldefs #`(("3-" 0 #t ,green))
    }
  }
}

Reply via email to