Re: Questions about HorizontalBracket

[Lukas-Fabian Moser]

New version with some typos removed:



\version "2.21.0"

% -------------- Scheme functions for dealing with 2D vectors -------------
% A vector is represented as a pair v = (x . y), hence
% x is (car v) and y is (cdr v).

% Some routines for calculating with 2D vectors (given as scheme pairs)
#(define (vector-add v w) ; Calculate v+w
   (cons (+ (car v) (car w))
         (+ (cdr v) (cdr w))))
% Remember that (cons a b) by definition constructs the pair (a . b).

#(define (vector-substract v w) ; Calculate v-w
   (cons (- (car v) (car w))
         (- (cdr v) (cdr w))))

#(define (vector-stretch factor v) ; Calculate factor * v.
   ; (The mathematician in me wanted to write lambda * v, but lambda
   ; is a sacred reserved word in scheme :-).)
   (cons (* (car v) factor)
         (* (cdr v) factor)))

#(define (scalar-product v w) ; Euclidean scalar product of vectors
   (+ (* (car v) (car w))
      (* (cdr v) (cdr w))))

#(define (midpoint v w) ; calculate (v+w)/2
   (vector-stretch 1/2 (vector-add v w)))

#(define (rotate-90-ccw v)
   ; rotate vector 90° counter-clockwise
   ; (mathematically positive direction)
   (cons (- (cdr v)) (car v)))

#(define (normal p q)
   ; constructs a normal vector to the line from p to q.
   ; the length of the normal vector will be proportional to
   ; the distance [pq].
   (rotate-90-ccw (vector-substract q p)))

#(define (on-which-halfplane v normal start)
   ; A line through "start" with fixed normal vector "normal" cuts the 
plane
   ; into two half-planes. This function returns
   ; 0 if v lies on the line itself,
   ; +1 if v lies in the half plane that the normal vector points to,
   ; -1 otherwise.
   (let ((dist (- (scalar-product normal v)
                  (scalar-product normal start))))
     (cond ((> dist 0) 1) ; is there no "sgn" function in guile?!
           ((< dist 0) -1)
           (else 0))
     ))

% -------------- Markup functions replacing slur shapes -------------
% The following markup functions expect a list of control points
% like they are used for slurs:
% (start 1st-directional-point 2nd-directional-point stop)

% First, we define shortcuts for easy construction of \path's.
% [ Background: We want to construct a markup using \path. As you can
%   see in http://lilypond.org/doc/v2.20/Documentation/notation/graphic,
%   \path expects a list of commands of the form
%     '((moveto 0 0)
%       (lineto -1 1)
%       (lineto 1 1)
%       (lineto 1 -1)
%       (curveto -5 -5 -5 5 -1 0)
%       (closepath)),
%   i.e. each element is itself a list, starting with a command symbol like
%   'lineto followed by numeric parameters.
%   But for us, points/vectors are _pairs_ of numbers.
%   So, we define a "moveto" command does the necessary conversion: It 
combines
%   - the symbol "moveto",
%   - the x-coordinate of point p (i.e. (car p))
%   - the y coordinate of point p (i.e. (cdr p))
%   into a list. ]
#(define (moveto p) (list 'moveto (car p) (cdr p)))
#(define (lineto p) (list 'lineto (car p) (cdr p)))

% Markup functions are defined by #(define-markup-command ...), see
% 
http://lilypond.org/doc/v2.20/Documentation/extending/new-markup-command-definition
%
% [ Note that the syntax for defining new markup commands differs from
%   the syntax for defining new music functions:
% 
(http://lilypond.org/doc/v2.20/Documentation/extending/music-function-definitions)
%
%   #(define-markup-command (name-of-new-command layout props 
arguments...) (type-predictes...) ...)
%   vs.
%   name-of-new-music-function = #(define-music-function (arguments...) 
(type-predicates...) ...)
%
%   One of the reasons is that #(define-markup-command) defines not only
%   \name-of-new-command but also make-(name-of-new-command)-markup
%   to be used in scheme; see below. ]

#(define-markup-command
  (slurReplacementVShape layout props control-points)
  (number-pair-list?) ; The only actual parameter (control-points) 
should be a list of (we expect: four) number pairs
  (let* ((start (first control-points))
         (1st-directional-point (second control-points))
         (2nd-directional-point (third control-points))
         (stop (fourth control-points)))
    (interpret-markup layout props #{
      \markup {
        \path #0.1 #(list (moveto start)
                          ; from start ...
                          (lineto (midpoint 1st-directional-point 
2nd-directional-point))
                          ; ... draw line to the midpoint of the two 
directional control points  ...
                          ; ... and then to stop.
                          (lineto stop))
                      } #})))

#(define-markup-command
  (slurReplacementBracket layout props control-points)
  (number-pair-list?)
  (let* ((start (first control-points))
         (stop (fourth control-points))
         (1st-directional-point (second control-points))
         ; We have to find out the direction in which the bracket should
         ; protrude. The idea here is to use the first directional
         ; control point of the slur and draw the bracket such that
         ; it lies in the half-plane (with respect to the line through
         ; "start" and "stop" in which that control point lies.)
         (normal (normal start stop))
         (scaled-normal
          (vector-stretch
           (* 0.075 (on-which-halfplane 1st-directional-point normal 
start))
           normal)))
    (interpret-markup layout props #{
      \markup {
        \path #0.1
        #(list (moveto start)
               ; draw lines:
               ; from start to start + scaled-normal
               ;            to stop + scaled-normal
               ;            to stop
               ; yielding a bracket-shaped path.
               (lineto (vector-add start scaled-normal))
               (lineto (vector-add stop scaled-normal))
               (lineto stop))
                      } #})))

% Might as well test the markup functions right away:

\markup {
  Test of markup command "\slurReplacementVShape:"
  \slurReplacementVShape #'((0 . 0) (2 . 2) (5 . 3) (8 . 1))
}

\markup {
  Test of markup command "\slurReplacementBracket:"
  \slurReplacementBracket #'((0 . 0) (2 . 2) (5 . 3) (8 . 1))
}


% -------------- Macros for tweaking slurs -------------

VShapeSlur = \tweak stencil
#(lambda (grob)
   (grob-interpret-markup
    ; Interpret as a markup (see bonus consideration below) ...
    grob ; ... using the layout/properties settings active for the 
current grob ...
    ; ... the following markup:
    (make-slurReplacementVShape-markup
     ; What you would write inside a LilyPond \markup as
     ; \slurReplacementVShape {parameters},
     ; in scheme becomes:
     ; (make-slurReplacementVShape-markup parameters)
     ;
     ; As parameters, we take the control-points property of the
     ; current grob (which we know will be a slur, because that's where
     ; we intend to use the \VShapeSlur command).
     ; The fact that slurs do have a property 'control-points can be
     ; found in
     ; http://lilypond.org/doc/v2.20/Documentation/internals/slur
     (ly:grob-property grob 'control-points))))
\etc

bracketSlur = \tweak stencil
#(lambda (grob)
   (grob-interpret-markup
    grob (make-slurReplacementBracket-markup
          (ly:grob-property grob 'control-points))))
\etc

% -------------- Tests -------------


\relative c' {
  c1 \bracketSlur ( d) e \bracketSlur( f g a g f')
  c,1 \VShapeSlur ( d) e \VShapeSlur( f g a g f')
}

\markup {
  The "\=..." mechanism for distinguishing arbitrarily many (maybe 
overlapping)
  slurs also can be used:
}
\relative c' {
  c4 \VShapeSlur \=0_( \VShapeSlur \=1^( d e \bracketSlur \=2_( f\=1) 
e^( d\=2) c b\=0))
}

\markup \wordwrap {
  Nowhere in our definition of "\\VShapeSlur" do we actually require the
  "\\tweak"ed grob to be a slur. Everything that has suitable 
'control-points
  should work - for example, a tie! And behold:
}
\relative c' {
  c1 \VShapeSlur ~ c
  d'1 \bracketSlur ~ d
}
\markup \wordwrap {
  (Turns out that naming our tweak macros "\\VShapeSlur" and 
"\\bracketSlur"
  might have been a little bit rash.)
}

% ----- Bonus consideration ("what I learned while writing this") 
----------------
% What's the deal with
% (interpret-markup layout props ...) vs. (grob-interpret-markup grob ...) ?
%
% Both turn a markup into a stencil ("they draw the markup"). For this,
% they need context: For instance, settings about the current font-size 
etc.,
% which are stored in the layout and props variables. So the question
% becomes: What does grob-interpret-markup do?
% To find out, I simply looked up its definition in LilyPond itself. In
% scm/output-lib.scm, we find:
%
%   (define-public (grob-interpret-markup grob text)
%     (let* ((layout (ly:grob-layout grob))
%            (defs (ly:output-def-lookup layout 'text-font-defaults))
%            (props (ly:grob-alist-chain grob defs)))
%
%       (ly:text-interface::interpret-markup layout props text)))
%
% To wit, grob-interpret-markup asks the grob to reveal the suitable
% layout and props that are needed to call 
ly:text-interface::interpret-markup.
%
% BUT: What about the prefix "ly:text-interface::"?
% The answer may be found in scm/markup.scm:
%
%   (define-public interpret-markup ly:text-interface::interpret-markup)
%
% which means: ly:text-interface::interpret-markup is the full name,
% for which interpret-markup is just a shorthand.