% organ_pedal_marks.ly

% \version "2.24.1"  % Lilypond version

%{
===============================================================================
Provide more options for organ pedal notation (heel/toe markings)
===============================================================================

By Rudolf Cardinal <rudolf@pobox.com>, Feb-Mar 2024. Public domain.
In memory of John Cardinal (1944-2024).

Last updated 23 Mar 2024.
With thanks to Thomas Morley for feedback and to all those who maintain
Lilypond and the Lilypond Snippet Repository.

-------------------------------------------------------------------------------
ABBREVIATIONS
-------------------------------------------------------------------------------

Abbreviations used throughout: L = left, R = right; T = toe, H = heel.

-------------------------------------------------------------------------------
RATIONALE
-------------------------------------------------------------------------------

Lilypond's standard commands for pedal marks are: \lheel, \ltoe, \rheel, \rtoe.
Internally, they are considered a kind of "articulation" mark, like accents
(and not, for example, a kind of fingering).

However, there are several ways of displaying these visually. Not all organists
may want Lilypond's default style, so this file provides some alternatives.

At the time of writing, there is nothing in the LilyPond snippet repository
(https://lsr.di.unimi.it/LSR/) that matches the terms "organ" and "pedal", but
some prior discussion (e.g.
https://lists.gnu.org/archive/html/lilypond-user/2016-02/msg00698.html).

-------------------------------------------------------------------------------
USAGE
-------------------------------------------------------------------------------

To use this file, first include it, e.g.

  \include "organ_pedal_marks.ly"

APPLYING A STYLE

Then, in a relevant place (typically once), choose a style by using one of the
following methods:

(a) manually apply and revert

  \applyPedalmarkStyle <STYLENAME>
  % ... your music here...
  \revertPedalmarkStyle

(b) use a "context":

  \withPedalmarkStyle <STYLENAME> {
    % ... your music here...
  }

For <STYLENAME>, use one of the following (including the double quotes):

  "lilypond"    -- for outward toes, outward heels (Lilypond defaults)
  "modern"      -- inward toes, circle heels
  "traditional" -- upward toes, downward heels

The styles are illustrated further below.

STANDARD PEDAL MARKS

As you normally would, use these commands just after the note of interest:

    \lheel
    \ltoe
    \rheel
    \rtoe

HEEL-TOE TRANSITIONS

New marks are also provided for heel-toe transitions with a single foot. These
are marked with two tied symbols, per Trevor (1971, page 13; see reference
below). As usual, the commands follow the note. They are:

  \lheeltoe
  \ltoeheel
  \rheeltoe
  \rtoeheel

"FOOT BEHIND/IN FRONT" MARKS

Additional marks are provided to indicate "this foot goes {behind/in front} of
the other", for foot crossings. The mark is a line above the pedal indicator
("in front") or below it ("behind"), per Trevor (1971, p12). The commands
follow the note, as usual, and are:

  \lheel_behind
  \lheel_infront
  \ltoe_behind
  \ltoe_infront
  \rheel_behind
  \rheel_infront
  \rtoe_behind
  \rtoe_infront

SLIDE MARKS

These commands print an "S" towards the outside of the staff (i.e. below left
pedal marks and above right pedal marks), to indicate that the foot is slid
after being first played (Trevor 1971, p12). An example would be: (a) toe on
black note, (b) same heel on white note, then slide heel backwards to allow (c)
same toe on white note. The direction of the slide (forward or backward) is
determined by the player in the context.

  \lheel_slide
  \ltoe_slide
  \rheel_slide
  \rtoe_slide

FORWARD/BACKWARD INDICATIONS

For indicating which foot should be placed slightly forward (F) or backward
(B) relative to the other, when the two feet are adjacent, these commands add
an "F" or "B" towards the outside of the pedal mark (Trevor 1971, p13).

  \lheel_backward
  \lheel_forward
  \ltoe_backward
  \ltoe_forward
  \rheel_backward
  \rheel_forward
  \rtoe_backward
  \rtoe_forward

FOOT SUBSTITUTIONS

There are also additional marks for transitions between feet. Often these are
implicit (e.g. Trevor 1971) but where explicit a broken line joins the symbols
for each feet (crossing the staff). The commands are:

  \lheel_rheel
  \lheel_rtoe
  \ltoe_rheel
  \ltoe_rtoe
  \rheel_lheel
  \rheel_ltoe
  \rtoe_lheel
  \rtoe_ltoe

FOOT GLIDES/GLISSANDO

Regardless of style, you can also apply glide/glissando marks between pedal
indications (e.g. Trevor 1971, pages 10/14). To do this, add
Pedal_glide_engraver to your staff, and use "\glide" between notes played by
the same foot. A glissando line will be drawn from (1) the pedal articulation
for the note that preceded \glide, to (2) the pedal articulation of the next
note played with the same foot.

Warning messages may be generated by Finger_glide_engraver ("warning: No finger
found to start a glide, ignoring"), but you can remove those by removing
Finger_glide_engraver. (Remove it from the Voice context, which is where it
operates, as follows. If you try to remove it in a different context such as
Staff, nothing changes. Note also the use of a hash [#] prefix to refer to a
user-defined engraver, but no such prefix for a built-in engraver.)

    \new Staff = "pedal" \with {
      \consists #Pedal_glide_engraver
    } {
      \time 4/4
      \clef "bass"
      \relative c \new Voice \with { \remove Finger_glide_engraver } {
        a2 \ltoe \glide g4 \ltoe \glide f \ltoe |
        f'2 \rtoe \glide g4 \rtoe \glide a \rtoe |
      }
    }

As a shortcut to (a) create a voice, (b) add Pedal_glide_engraver, and (c)
remove Finger_glide_engraver, you can use \newPedalVoice, e.g.

    \new Staff = "pedal" {
      \time 4/4
      \clef "bass"
      \relative c \newPedalVoice {
        a2 \ltoe \glide g4 \ltoe \glide f \ltoe |
        f'2 \rtoe \glide g4 \rtoe \glide a \rtoe |
      }
    }

The \newPedalVoice command takes an optional voice name, e.g.

    \newPedalVoice "right_foot" { ... }

is short for

    \new Voice = "right_foot"
    \with {
      \consists #Pedal_glide_engraver
      \remove Finger_glide_engraver
    } {
      ...
    }

-------------------------------------------------------------------------------
Symbols common to several pedal-mark styles
-------------------------------------------------------------------------------

The built-in symbols, which come from Lilypond's Feta font (in this description
approximated by UTF-8 set intersection/union symbols), are:

  dpedaltoe  ∧ or ^
  upedaltoe  ∨ or V
  dpedalheel ∩
  upedalheel ∪ or U

Here, (d)own and (u)p can be taken to represent the direction of the "open"
part of the symbol. We will also add a circle for heel marks in some styles.

-------------------------------------------------------------------------------
Lilypond default style
-------------------------------------------------------------------------------

Textual approximation:

                RH   RT
                ∩    ∧

    --------------------
    -----------------O--
    ------------O-------
    -------O------------
    --O-----------------

      ∨    ∪
      LT   LH

Note that the Lilypond documentation (at e.g.
https://lilypond.org/doc/v2.24/Documentation/notation/list-of-articulations)
doesn't make this entirely clear, because its demonstration of (for example)
"\lheel" displays the symbol (a) forced up to above the staff, (b) forced down
to below the staff, and (c) "free". (Click the score snippet to show the
Lilypond script.) Forcing pedal marks down/up would be a peculiar thing to do,
but Lilypond positions them correctly when not overridden.

-------------------------------------------------------------------------------
Modern style
-------------------------------------------------------------------------------

Textual approximation:

                RH   RT
                o    ∨

    --------------------
    -----------------O--
    ------------O-------
    -------O------------
    --O-----------------

      ∧    o
      LT   LH

This standard style is exemplified by e.g. C.H. Trevor (1971) "The Oxford Organ
Method", Oxford University Press, Oxford, UK (page 3 and subsequently).

-------------------------------------------------------------------------------
Traditional style
-------------------------------------------------------------------------------

Textual approximation:

                RH   RT
                ∪    ∧

    --------------------
    -----------------O--
    ------------O-------
    -------O------------
    --O-----------------

      ∧    ∪
      LT   LH

This older style is exemplified by e.g. J.S. Bach (works ~1710), "Organ Works,
Book 6", edited by Frederick Bridge and James Higgs and revised by Walter
Emery, 1948 edition, Novello & Company Limited, Borough Green, Sevenoaks, Kent,
UK. A good example is on page 3: the closing pedal passage of the Toccata and
Fugue in D minor (BWV 565).

This style uses the same symbols for L/R toe and for L/R heel, so the position
is the only L/R differentiator.

%}


% -----------------------------------------------------------------------------
% Tweak pedal marks
% -----------------------------------------------------------------------------

% The tweak_pedalmarks function takes one parameter (the name of the style) and
% returns a lambda that modifies a grob:

#(define (tweak_pedalmarks pedalmarkstyle)
  (lambda (grob)
    (let*
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ;; Style names
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      ((lilypond "lilypond")
       (modern "modern")
       (trad "traditional")
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ;; Constants
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       (markthickness 0.15)  ;; line thickness for marks (e.g. heel circle)
       (guidethickness 0.15)  ;; ... and for guides (e.g. foot transitions)
       (heelcircle_radius 0.6)  ;; radius of heel circle mark
       (tie_hspace 0.1)  ;; horizontal space between marks/tie, for tie marks
       (tie_vshift 0.5)  ;; vertical offset to tie for tied marks
       (fc_hext 3)  ;; fc = foot change; horizontal extent of guide line
       (fc_vext 8)  ;; vertical length of guide line
       (fc_vshift 0.25)  ;; extra vertical space between guide line and marks
       (fc_halflinefrac 0.1)  ;; the fraction of the guide line shown each side
       (fc_pad 2.75)  ;; lateral padding each side of the foot-change marks
         ;; ... effect most obvious when using a pedal glide between adjacent
         ;; notes that both have foot transition marks; too small and no glide
         ;; is shown. Slight trade-off with adjacent non-transition notes.
       (behind_hhext 0.5)  ;; half the horiz. extent of the "foot-behind" line
       (behind_vshift 0.35)  ;; gap to horizontal line for foot-behind marks
       (broken_halfwidth 0.5)  ;; half-width for "problem" filled-square marker
       ;; Letters as paths:
       (fpathinfo  ;; the letter F, height 1.0
         '((moveto  0.0  0.0)    ;; bottom left
           (lineto  0.0  1.0)    ;; left-hand side
           (lineto  0.7  1.0)    ;; top
           (moveto  0.0  0.5)
           (lineto  0.5  0.5)))  ;; crossbar
       (fscale 0.8)
       (bpathinfo  ;; the letter B, height 1.0
         '((moveto  0.0   0.0)  ;; bottom left
           (lineto  0.0   1.0)  ;; left-hand side
           (curveto 0.75  1.1   0.75  0.45  0.0  0.55)  ;; top loop
           (curveto 0.8   0.65  0.8   -0.1   0.0  0.0)))  ;; bottom loop
           ;; ... curveto: first control point x/y, second CP x/y, end x/y
       (bscale 0.9)
       (spathinfo  ;; the letter S, height ~1.0
         '((moveto   0.0   0.0)
           (curveto  0.7  -0.4  1.0  0.2  0.35 0.5)  ;; bottom curve
           (curveto  -0.3  0.8  0.0  1.4  0.7  1.0)))  ;; top curve
       (sscale 0.8)
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ;; Shortcut variables
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       (p pedalmarkstyle)
       (none_str "<none>")
       (grobname (symbol->string (grob::name grob)))
       (event (event-cause grob))
         ;; ... equivalent to (script_cause (ly:grob-property grob 'cause))
       (artic_type (ly:event-property event 'articulation-type))
       (a (if (null? artic_type) none_str (symbol->string artic_type)))
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ;; Symbols
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       (dpedaltoe (make-musicglyph-markup "scripts.dpedaltoe"))
       (upedaltoe (make-musicglyph-markup "scripts.upedaltoe"))
       (dpedalheel (make-musicglyph-markup "scripts.dpedalheel"))
       (upedalheel (make-musicglyph-markup "scripts.upedalheel"))
       (heelcircle (markup #:draw-circle heelcircle_radius markthickness #f))
       (broken (make-filled-box-markup
         (cons (- broken_halfwidth) broken_halfwidth)
         (cons (- broken_halfwidth) broken_halfwidth) 0))
       (tie_hspace_markup (make-hspace-markup tie_hspace))
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ;; Style-specific symbols (makes later code clearer)
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       (lily_ltoe upedaltoe)
       (lily_lheel upedalheel)
       (lily_rheel dpedalheel)
       (lily_rtoe dpedaltoe)
       (mod_ltoe dpedaltoe)
       (mod_heel heelcircle)
       (mod_rtoe upedaltoe)
       (trad_toe dpedaltoe)
       (trad_heel upedalheel)
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ;; Shortcut functions
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       (failbadstyle (lambda ()
         (ly:error "In tweak_pedalmarks, bad pedalmarkstyle: ~a" p)))
       (setsymbol (lambda (x) (begin
         (ly:grob-set-property! grob 'stencil ly:text-interface::print)
         (ly:grob-set-property! grob 'text x))))
       (hline (lambda (y) (list
         (list 'moveto (- behind_hhext) y)
         (list 'lineto behind_hhext y))))
       (overline (lambda (x) (make-combine-markup
         (markup #:path markthickness (hline behind_vshift))  ;; line
         (make-general-align-markup Y UP x))))  ;; original markup
       (underline (lambda (x) (make-combine-markup
         (make-general-align-markup Y DOWN x)  ;; original markup
         (markup #:path markthickness (hline (- behind_vshift))))))  ;; line
       (mkletter (lambda (p scale) (make-general-align-markup X CENTER
         (make-scale-markup
           (cons scale scale)
           (markup #:path (/ markthickness scale) p)))))
           ;; Scale the symbol, but end up with "markthickness" as the line
           ;; width nonetheless.
       (letterb (mkletter bpathinfo bscale))  ;; markup for letter B
       (letterf (mkletter fpathinfo fscale))  ;; markup for letter F
       (letters (mkletter spathinfo sscale))  ;; markup for letter S
       (overprint (lambda (x p) (make-combine-markup
         ;; show markup p above x
         (make-raise-markup fc_vshift
           (make-general-align-markup Y DOWN p))
         (make-general-align-markup Y UP
           (make-general-align-markup X CENTER x)))))
       (underprint (lambda (x p) (make-combine-markup
         ;; show markup p below x
         (make-general-align-markup Y DOWN
           (make-general-align-markup X CENTER x))
         (make-lower-markup fc_vshift
           (make-general-align-markup Y UP p)))))
       (dir (ly:grob-property grob 'direction))  ;; grob direction rel. to staff
       (tiepair (lambda (x y)
         ;; show x and y with a tie over/under them
         ;; (away from the staff, according to the grob's direction, dir)
         (markup #:tie (make-concat-markup (list
           (make-general-align-markup Y dir x)
           tie_hspace_markup
           (make-general-align-markup Y dir y))))))
       (footchangepath (lambda (x1 y1 x2 y2)
         ;; broken line for foot change
         (let*
           ((xext (- x2 x1))
            (yext (- y2 y1)))
           (list (list 'moveto x1 y1)
                 (list 'lineto
                       (+ x1 (* xext fc_halflinefrac))
                       (+ y1 (* yext fc_halflinefrac)))
                 (list 'moveto
                       (- x2 (* xext fc_halflinefrac))
                       (- y2 (* yext fc_halflinefrac)))
                 (list 'lineto x2 y2)))))
       (guideup (lambda (x y)
         ;; show x below the staff, a broken line up, then y above the staff
         (let*
           ((half_hext (/ fc_hext 2))
            (gpath (footchangepath (- half_hext) 0 half_hext fc_vext)))
           (setsymbol (make-concat-markup (list
             (make-lower-markup fc_vshift (make-general-align-markup Y UP x))
             (markup #:path guidethickness gpath)
             (make-raise-markup (+ fc_vext fc_vshift)
                                (make-general-align-markup Y DOWN y)))))
           (ly:grob-set-property! grob 'avoid-slur 'ignore)
           (ly:grob-set-property! grob 'Y-offset (/ fc_vext -2))
           (ly:grob-set-property! grob 'extra-spacing-width (cons fc_pad fc_pad)))))
       (guidedown (lambda (x y)
         ;; show x above the staff, a broken line down, then y below the staff
         (let*
           ((half_hext (/ fc_hext 2))
            (gpath (footchangepath (- half_hext) 0 half_hext (- fc_vext))))
           (setsymbol (make-concat-markup (list
             (make-raise-markup fc_vshift (make-general-align-markup Y DOWN x))
             (markup #:path guidethickness gpath)
             (make-lower-markup (+ fc_vext fc_vshift)
                                (make-general-align-markup Y UP y)))))
           (ly:grob-set-property! grob 'avoid-slur 'ignore)
           (ly:grob-set-property! grob 'Y-offset (/ fc_vext 2))
           (ly:grob-set-property! grob 'extra-spacing-width (cons fc_pad fc_pad)))))
      )  ;; end of "let" bindings section
      ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      ;; Function proper begins here
      ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      ;; (ly:message "tweak_pedalmarks: grobname = ~a, artic_type = ~a (pedalmarkstyle = ~a)" grobname a p)
      (cond
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ;; Standard pedal marks
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ((equal? a "lheel") (setsymbol
          (cond
            ((equal? p lilypond) lily_lheel)
            ((equal? p modern)   mod_heel)
            ((equal? p trad)     trad_heel)
            (else                (failbadstyle)))))
        ((equal? a "ltoe") (setsymbol
          (cond
            ((equal? p lilypond) lily_ltoe)
            ((equal? p modern)   mod_ltoe)
            ((equal? p trad)     trad_toe)
            (else                (failbadstyle)))))
        ((equal? a "rheel") (setsymbol
          (cond
            ((equal? p lilypond) lily_rheel)
            ((equal? p modern)   mod_heel)
            ((equal? p trad)     trad_heel)
            (else                (failbadstyle)))))
        ((equal? a "rtoe") (setsymbol
          (cond
            ((equal? p lilypond) lily_rtoe)
            ((equal? p modern)   mod_rtoe)
            ((equal? p trad)     trad_toe)
            (else                (failbadstyle)))))
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ;; Custom foot-behind/foot-in-front marks
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ((equal? a "lheel_behind") (setsymbol
          (cond
            ((equal? p lilypond) (underline lily_lheel))
            ((equal? p modern)   (underline mod_heel))
            ((equal? p trad)     (underline trad_heel))
            (else                (failbadstyle)))))
        ((equal? a "lheel_infront") (setsymbol
          (cond
            ((equal? p lilypond) (overline lily_lheel))
            ((equal? p modern)   (overline mod_heel))
            ((equal? p trad)     (overline trad_heel))
            (else                (failbadstyle)))))
        ((equal? a "ltoe_behind") (setsymbol
          (cond
            ((equal? p lilypond) (underline lily_ltoe))
            ((equal? p modern)   (underline mod_ltoe))
            ((equal? p trad)     (underline trad_toe))
            (else                (failbadstyle)))))
        ((equal? a "ltoe_infront") (setsymbol
          (cond
            ((equal? p lilypond) (overline lily_ltoe))
            ((equal? p modern)   (overline mod_ltoe))
            ((equal? p trad)     (overline trad_toe))
            (else                (failbadstyle)))))
        ((equal? a "rheel_behind") (setsymbol
          (cond
            ((equal? p lilypond) (underline lily_rheel))
            ((equal? p modern)   (underline mod_heel))
            ((equal? p trad)     (underline trad_heel))
            (else                (failbadstyle)))))
        ((equal? a "rheel_infront") (setsymbol
          (cond
            ((equal? p lilypond) (overline lily_rheel))
            ((equal? p modern)   (overline mod_heel))
            ((equal? p trad)     (overline trad_heel))
            (else                (failbadstyle)))))
        ((equal? a "rtoe_behind") (setsymbol
          (cond
            ((equal? p lilypond) (underline lily_rtoe))
            ((equal? p modern)   (underline mod_rtoe))
            ((equal? p trad)     (underline trad_toe))
            (else                (failbadstyle)))))
        ((equal? a "rtoe_infront") (setsymbol
          (cond
            ((equal? p lilypond) (overline lily_rtoe))
            ((equal? p modern)   (overline mod_rtoe))
            ((equal? p trad)     (overline trad_toe))
            (else                (failbadstyle)))))
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ;; Letter-annotated marks
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ((equal? a "lheel_backward") (setsymbol
          (cond
            ((equal? p lilypond) (underprint lily_lheel letterb))
            ((equal? p modern)   (underprint mod_heel letterb))
            ((equal? p trad)     (underprint trad_heel letterb))
            (else                (failbadstyle)))))
        ((equal? a "lheel_forward") (setsymbol
          (cond
            ((equal? p lilypond) (underprint lily_lheel letterf))
            ((equal? p modern)   (underprint mod_heel letterf))
            ((equal? p trad)     (underprint trad_heel letterf))
            (else                (failbadstyle)))))
        ((equal? a "lheel_slide") (setsymbol
          (cond
            ((equal? p lilypond) (underprint lily_lheel letters))
            ((equal? p modern)   (underprint mod_heel letters))
            ((equal? p trad)     (underprint trad_heel letters))
            (else                (failbadstyle)))))
        ((equal? a "ltoe_backward") (setsymbol
          (cond
            ((equal? p lilypond) (underprint lily_ltoe letterb))
            ((equal? p modern)   (underprint mod_ltoe letterb))
            ((equal? p trad)     (underprint trad_toe letterb))
            (else                (failbadstyle)))))
        ((equal? a "ltoe_forward") (setsymbol
          (cond
            ((equal? p lilypond) (underprint lily_ltoe letterf))
            ((equal? p modern)   (underprint mod_ltoe letterf))
            ((equal? p trad)     (underprint trad_toe letterf))
            (else                (failbadstyle)))))
        ((equal? a "ltoe_slide") (setsymbol
          (cond
            ((equal? p lilypond) (underprint lily_ltoe letters))
            ((equal? p modern)   (underprint mod_ltoe letters))
            ((equal? p trad)     (underprint trad_toe letters))
            (else                (failbadstyle)))))
        ((equal? a "rheel_backward") (setsymbol
          (cond
            ((equal? p lilypond) (overprint lily_rheel letterb))
            ((equal? p modern)   (overprint mod_heel letterb))
            ((equal? p trad)     (overprint trad_heel letterb))
            (else                (failbadstyle)))))
        ((equal? a "rheel_forward") (setsymbol
          (cond
            ((equal? p lilypond) (overprint lily_rheel letterf))
            ((equal? p modern)   (overprint mod_heel letterf))
            ((equal? p trad)     (overprint trad_heel letterf))
            (else                (failbadstyle)))))
        ((equal? a "rheel_slide") (setsymbol
          (cond
            ((equal? p lilypond) (overprint lily_rheel letters))
            ((equal? p modern)   (overprint mod_heel letters))
            ((equal? p trad)     (overprint trad_heel letters))
            (else                (failbadstyle)))))
        ((equal? a "rtoe_backward") (setsymbol
          (cond
            ((equal? p lilypond) (overprint lily_rtoe letterb))
            ((equal? p modern)   (overprint mod_rtoe letterb))
            ((equal? p trad)     (overprint trad_toe letterb))
            (else                (failbadstyle)))))
        ((equal? a "rtoe_forward") (setsymbol
          (cond
            ((equal? p lilypond) (overprint lily_rtoe letterf))
            ((equal? p modern)   (overprint mod_rtoe letterf))
            ((equal? p trad)     (overprint trad_toe letterf))
            (else                (failbadstyle)))))
        ((equal? a "rtoe_slide") (setsymbol
          (cond
            ((equal? p lilypond) (overprint lily_rtoe letters))
            ((equal? p modern)   (overprint mod_rtoe letters))
            ((equal? p trad)     (overprint trad_toe letters))
            (else                (failbadstyle)))))
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ;; Custom single-foot change marks
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ((equal? a "ltoeheel") (setsymbol
          (cond
            ((equal? p lilypond) (tiepair lily_ltoe lily_lheel))
            ((equal? p modern)   (tiepair mod_ltoe mod_heel))
            ((equal? p trad)     (tiepair trad_toe trad_heel))
            (else                (failbadstyle)))))
        ((equal? a "lheeltoe") (setsymbol
          (cond
            ((equal? p lilypond) (tiepair lily_lheel lily_ltoe))
            ((equal? p modern)   (tiepair mod_heel mod_ltoe))
            ((equal? p trad)     (tiepair trad_heel trad_toe))
            (else                (failbadstyle)))))
        ((equal? a "rtoeheel") (setsymbol
          (cond
            ((equal? p lilypond) (tiepair lily_rtoe lily_rheel))
            ((equal? p modern)   (tiepair mod_rtoe mod_heel))
            ((equal? p trad)     (tiepair trad_toe trad_heel))
            (else                (failbadstyle)))))
        ((equal? a "rheeltoe") (setsymbol
          (cond
            ((equal? p lilypond) (tiepair lily_rheel lily_rtoe))
            ((equal? p modern)   (tiepair mod_heel mod_rtoe))
            ((equal? p trad)     (tiepair trad_heel trad_toe))
            (else                (failbadstyle)))))
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ;; Custom foot-substitution change marks
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ((equal? a "ltoe_rtoe") (cond
          ((equal? p lilypond) (guideup lily_ltoe lily_rtoe))
          ((equal? p modern)   (guideup mod_ltoe mod_rtoe))
          ((equal? p trad)     (guideup trad_toe trad_toe))
          (else                (failbadstyle))))
        ((equal? a "ltoe_rheel") (cond
          ((equal? p lilypond) (guideup lily_ltoe lily_rheel))
          ((equal? p modern)   (guideup mod_ltoe mod_heel))
          ((equal? p trad)     (guideup trad_toe trad_heel))
          (else                (failbadstyle))))
        ((equal? a "lheel_rtoe") (cond
          ((equal? p lilypond) (guideup lily_lheel lily_rtoe))
          ((equal? p modern)   (guideup mod_heel mod_rtoe))
          ((equal? p trad)     (guideup trad_heel trad_toe))
          (else                (failbadstyle))))
        ((equal? a "lheel_rheel") (cond
          ((equal? p lilypond) (guideup lily_lheel lily_rheel))
          ((equal? p modern)   (guideup mod_heel mod_heel))
          ((equal? p trad)     (guideup trad_heel trad_heel))
          (else                (failbadstyle))))
        ((equal? a "rtoe_ltoe") (cond
          ((equal? p lilypond) (guidedown lily_rtoe lily_ltoe))
          ((equal? p modern)   (guidedown mod_rtoe mod_ltoe))
          ((equal? p trad)     (guidedown trad_toe trad_toe))
          (else                (failbadstyle))))
        ((equal? a "rtoe_lheel") (cond
          ((equal? p lilypond) (guidedown lily_rtoe lily_lheel))
          ((equal? p modern)   (guidedown mod_rtoe mod_heel))
          ((equal? p trad)     (guidedown trad_toe trad_heel))
          (else                (failbadstyle))))
        ((equal? a "rheel_ltoe") (cond
          ((equal? p lilypond) (guidedown lily_rheel lily_ltoe))
          ((equal? p modern)   (guidedown mod_heel mod_ltoe))
          ((equal? p trad)     (guidedown trad_heel trad_toe))
          (else                (failbadstyle))))
        ((equal? a "rheel_lheel") (cond
          ((equal? p lilypond) (guidedown lily_rheel lily_lheel))
          ((equal? p modern)   (guidedown mod_heel mod_heel))
          ((equal? p trad)     (guidedown trad_heel trad_heel))
          (else                (failbadstyle))))
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ;; Unknown beyond here; not a pedal mark articulation
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ;; (else (ly:message "unknown articulation type: ~a" a))
      ))))

applyPedalmarkStyle = 
#(define-music-function (pedalmarkstyle) (string?)
  (_i "Apply custom organ pedal marks to the score")
  #{
    % Either of the contexts "Score." or "Staff." make sense here. If you omit
    % a context, the override applies to the current contexts, but not (it
    % seems) to sub-contexts like a new Voice. A pedal passage is normally a
    % staff, so we could use "Staff."; however, it would be extremely unusual
    % to use two different pedal mark styles in the same score. Advanced users
    % can rewrite this to change the context if required; we'll aim for
    % simplicity here and use Score.
    \override Score.Script.before-line-breaking = #(tweak_pedalmarks pedalmarkstyle)
  #})

revertPedalmarkStyle = {
  \revert Score.Script.before-line-breaking
}

withPedalmarkStyle = 
#(define-music-function (pedalmarkstyle notes) (string? ly:music?)
  (_i "Apply custom organ pedal marks to a passage")
  #{
    \applyPedalmarkStyle #pedalmarkstyle
    $notes  % Use $notes for a copy, rather than #notes and some risk of modification
    \revertPedalmarkStyle
  #})


% -----------------------------------------------------------------------------
% New articulations, defined first as "broken" marks (later to be overridden)
% -----------------------------------------------------------------------------

% Default symbol and articulation parameters for undefined marks:

#(define pedalbroken_stencil
  (make-filled-box-stencil '(-0.5 . 0.5) '(-0.5 . 0.5)))
#(define pedalbroken_left ` (
  (stencil . ,pedalbroken_stencil)
  (padding . 0.20)
  (avoid-slur . around)
  (direction . ,DOWN)))
#(define pedalbroken_right ` (
  (stencil . ,pedalbroken_stencil)
  (padding . 0.20)
  (avoid-slur . around)
  (direction . ,UP)))

% Single mark articulations:

#(append! default-script-alist (list ` (lheel_backward . ,pedalbroken_left)))
#(append! default-script-alist (list ` (lheel_behind   . ,pedalbroken_left)))
#(append! default-script-alist (list ` (lheel_forward  . ,pedalbroken_left)))
#(append! default-script-alist (list ` (lheel_infront  . ,pedalbroken_left)))
#(append! default-script-alist (list ` (lheel_slide    . ,pedalbroken_left)))

#(append! default-script-alist (list ` (ltoe_backward  . ,pedalbroken_left)))
#(append! default-script-alist (list ` (ltoe_behind    . ,pedalbroken_left)))
#(append! default-script-alist (list ` (ltoe_forward   . ,pedalbroken_left)))
#(append! default-script-alist (list ` (ltoe_infront   . ,pedalbroken_left)))
#(append! default-script-alist (list ` (ltoe_slide     . ,pedalbroken_left)))

#(append! default-script-alist (list ` (rheel_backward . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rheel_behind   . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rheel_forward  . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rheel_infront  . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rheel_slide    . ,pedalbroken_right)))

#(append! default-script-alist (list ` (rtoe_backward  . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rtoe_behind    . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rtoe_forward   . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rtoe_infront   . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rtoe_slide     . ,pedalbroken_right)))

lheel_backward = #(make-articulation 'lheel_backward)
lheel_behind   = #(make-articulation 'lheel_behind)
lheel_forward  = #(make-articulation 'lheel_forward)
lheel_infront  = #(make-articulation 'lheel_infront)
lheel_slide    = #(make-articulation 'lheel_slide)

ltoe_backward  = #(make-articulation 'ltoe_backward)
ltoe_behind    = #(make-articulation 'ltoe_behind)
ltoe_forward   = #(make-articulation 'ltoe_forward)
ltoe_infront   = #(make-articulation 'ltoe_infront)
ltoe_slide     = #(make-articulation 'ltoe_slide)

rheel_backward = #(make-articulation 'rheel_backward)
rheel_behind   = #(make-articulation 'rheel_behind)
rheel_forward  = #(make-articulation 'rheel_forward)
rheel_infront  = #(make-articulation 'rheel_infront)
rheel_slide    = #(make-articulation 'rheel_slide)

rtoe_backward  = #(make-articulation 'rtoe_backward)
rtoe_behind    = #(make-articulation 'rtoe_behind)
rtoe_forward   = #(make-articulation 'rtoe_forward)
rtoe_infront   = #(make-articulation 'rtoe_infront)
rtoe_slide     = #(make-articulation 'rtoe_slide)

% Two-mark articulations, single foot:

#(append! default-script-alist (list ` (ltoeheel . ,pedalbroken_left)))
#(append! default-script-alist (list ` (lheeltoe . ,pedalbroken_left)))
#(append! default-script-alist (list ` (rtoeheel . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rheeltoe . ,pedalbroken_right)))

ltoeheel = #(make-articulation 'ltoeheel)
lheeltoe = #(make-articulation 'lheeltoe)
rtoeheel = #(make-articulation 'rtoeheel)
rheeltoe = #(make-articulation 'rheeltoe)

% Two-mark articulations, two feet:

#(append! default-script-alist (list ` (ltoe_rtoe   . ,pedalbroken_left)))
#(append! default-script-alist (list ` (ltoe_rheel  . ,pedalbroken_left)))
#(append! default-script-alist (list ` (lheel_rtoe  . ,pedalbroken_left)))
#(append! default-script-alist (list ` (lheel_rheel . ,pedalbroken_left)))
#(append! default-script-alist (list ` (rtoe_ltoe   . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rtoe_lheel  . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rheel_ltoe  . ,pedalbroken_right)))
#(append! default-script-alist (list ` (rheel_lheel . ,pedalbroken_right)))

ltoe_rtoe   = #(make-articulation 'ltoe_rtoe)
ltoe_rheel  = #(make-articulation 'ltoe_rheel)
lheel_rtoe  = #(make-articulation 'lheel_rtoe)
lheel_rheel = #(make-articulation 'lheel_rheel)
rtoe_ltoe   = #(make-articulation 'rtoe_ltoe)
rtoe_lheel  = #(make-articulation 'rtoe_lheel)
rheel_ltoe  = #(make-articulation 'rheel_ltoe)
rheel_lheel = #(make-articulation 'rheel_lheel)

% -----------------------------------------------------------------------------
% Pedal_glide_engraver
% -----------------------------------------------------------------------------
% After Finger_glide_engraver (part of Lilypond).

#(define Pedal_glide_engraver
  (lambda (context)
    (let*
      ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      ;; Variables stored across note events
      ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      ((foot-glide-event '())  ;; key = gliding foot; value = list
       (glide-grobs '())  ;; key = gliding foot; value = spanner grob
       (glide-tweaks '())
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ;; Constants
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       (lfoot-plain
          ;; Standard Lilypond:
         '("lheel" "ltoe"
           ;; Custom heel-toe transitions:
           "lheeltoe" "ltoeheel"
           ;; Custom annotated single-foot marks:
           "lheel_backward" "lheel_behind" "lheel_forward" "lheel_forward"
           "lheel_infront"  "lheel_slide"
           "ltoe_backward"  "ltoe_behind"  "ltoe_forward"  "ltoe_infront"
           "ltoe_infront"   "ltoe_slide"))
       (transitions-end-lfoot
         ;; Custom foot substitutions ending on the left foot:
         '("rheel_lheel" "rheel_ltoe" "rtoe_lheel" "rtoe_ltoe"))
       (rfoot-plain  ;; As above but for the right foot.
         ;; Standard Lilypond:
         '("rheel" "rtoe"
           ;; Custom heel-toe transitions:
           "rheeltoe" "rtoeheel"
           ;; Custom annotated single-foot marks:
           "rheel_backward" "rheel_behind" "rheel_forward" "rheel_forward"
           "rheel_infront"  "rheel_slide"
           "rtoe_backward"  "rtoe_behind"  "rtoe_forward"  "rtoe_infront"
           "rtoe_infront"   "rtoe_slide"))
       (transitions-end-rfoot  ;; As above but for the right foot.
         ;; Custom foot substitutions ending on the left foot:
         '("lheel_rheel" "lheel_rtoe" "ltoe_rheel" "ltoe_rtoe"))
       (vadjustment 5)  ;; should be slightly over 0.5 * fc_vext (see above)
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ;; Helper functions
       ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       (get_endfoot (lambda (astr)
         ;; If astr is a string representation of a pedal articulation, return
         ;; the "final" (or only) foot used in that articulation, or false (#f)
         ;; if not recognized.
         (cond
           ((or  (member astr lfoot-plain)
                 (member astr transitions-end-lfoot)) "left")
           ((or  (member astr rfoot-plain)
                 (member astr transitions-end-rfoot)) "right")
           (else #f))))  ;; not a recognized pedal articulation
       (get_startfoot (lambda (astr)
         ;; Equivalently, but for the starting foot.
         (cond
           ((or  (member astr lfoot-plain)
                 (member astr transitions-end-rfoot)) "left")
           ((or  (member astr rfoot-plain)
                 (member astr transitions-end-lfoot)) "right")
           (else #f))))
       (get_oppfoot (lambda (foot)
         ;; The opposite foot to that passed.
         (cond
           ((equal? foot "left")  "right")
           ((equal? foot "right") "left")
           (else                  (ly:error "Bad foot parameter to get_oppfoot")))))
       (is_transition_pedalmark (lambda (astr)
         ;; Is this a transition pedalmark, which has a large Y extent and
         ;; therefore requires adjustment for?
         (or (member astr transitions-end-lfoot)
             (member astr transitions-end-rfoot))))
       (get_vadjustment_endfoot (lambda (astr)
         ;; Return a vertical adjustment for the end foot of a transition mark.
         (cond
           ((member astr transitions-end-lfoot) (- vadjustment))
           ((member astr transitions-end-rfoot) vadjustment)
           (else 0))))
       (get_vadjustment_startfoot (lambda (astr)
         ;; Return a vertical adjustment for the end foot of a transition mark.
         (cond
           ((member astr transitions-end-lfoot) vadjustment)
           ((member astr transitions-end-rfoot) (- vadjustment))
           (else 0))))
       (adjust_spanner_y (lambda (spannergrob side y)
         (let*
           ((bd (copy-tree (ly:grob-property spannergrob 'bound-details)))
            ;; I think that without "copy-tree", "bd" remains reference-bound to
            ;; the grob. Modifying it alters the grob without writing back the
            ;; properties. Moreover, it can alter multiple unrelated grobs (e.g.
            ;; finger glides that the current engraver isn't meant to touch),
            ;; which suggests a reference to a master version. Therefore we have
            ;; to copy it with copy-tree, as above.
            (bdside (assoc-ref bd side)))
           (if (not (equal? y 0)) (begin
             ;; (ly:message "adjust_spanner_y: spannergrob = ~a, side = ~a, y = ~a; adjusting" spannergrob side y)
             (ly:grob-set-property! spannergrob 'bound-details (assoc-set!
               bd side (assoc-set! bdside 'Y y))))))))
       (adjust_following_y_left (lambda (spannergrob astr)
         (let* ((y (get_vadjustment_endfoot astr)))
               (adjust_spanner_y spannergrob 'left y))))
       (adjust_preceding_y_right (lambda (spannergrob astr)
         (let* ((y (get_vadjustment_startfoot astr)))
               (adjust_spanner_y spannergrob 'right y))))
      ) ;; end of "let" bindings section
      (make-engraver
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ;; Listener
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        (listeners
          ((note-event this-engraver event)
            (let*
              ((music-cause (ly:event-property event 'music-cause))
               (arts (ly:prob-property music-cause 'articulations))
               (startfoot #f)
               (endfoot #f)
               (tweaks #f)
               (glide #f)
               (process_artic (lambda (a)
                 ;; Catch pedal articulations
                 (let*
                   ((atype (ly:prob-property a 'articulation-type))
                    (astr (symbol->string atype))
                    (sf (get_startfoot astr))
                    (ef (get_endfoot astr))
                    (pedal (not (equal? ef #f))))  ;; is it a pedal articulation?
                   (begin
                     ;; (ly:message ">>> listener: --------------------------")
                     ;; (ly:message ">>> listener: ArticulationEvent, astr = ~a" astr)
                     (if pedal (begin
                       (set! startfoot sf)
                       (set! endfoot ef)))))))
               (process_glide (lambda (a) (begin
                 ;; (ly:message ">>> listener: FingerGlideEvent")
                 (set! tweaks (ly:prob-property a 'tweaks))
                 (set! glide #t))))
              ) ;; end of "let" bindings section

              ;; Find 'ArticulationEvent and catch it.
              ;; Find 'FingerGlideEvent and catch its tweaks.

              (for-each
                (lambda (art)
                  (let*
                    ((name (ly:prob-property art 'name)))
                    (cond
                      ((eq? name 'ArticulationEvent) (process_artic art))
                      ((eq? name 'FingerGlideEvent)  (process_glide art)))))
                arts)

              ;; Store found tweaks in local `glide-tweaks` with endfoot as key.
              ;; This is needed in order not to confuse grobs and their tweaks,
              ;; if this engraver is consisted in Staff context.

              (if (pair? tweaks)
                (set! glide-tweaks (cons (cons endfoot tweaks) glide-tweaks)))

              ;; Update local `foot-glide-event`, creating an alist with the
              ;; relevant foot being the key. The relevant foot is the endfoot
              ;; for the starting mark, and the startfoot for the following
              ;; mark.
              ;; - if glide is true, create a new entry in `foot-glide-event`
              ;;   as (list endfoot glide event)
              ;; - if glide is false, set the value for the key to false

              ;; (ly:message ">>> listener: startfoot = ~a, endfoot = ~a, glide = ~a" startfoot endfoot glide)
              (cond
                ((and endfoot glide)
                 ;; This moment has a pedalmark and a GLIDE following
                 (set! foot-glide-event
                   (cons (list endfoot glide event) foot-glide-event)))
                ((and glide (not endfoot))
                 ;; This moment has an ORPHAN GLIDE
                 (ly:warning
                   "No pedal articulation found to start a glide, ignoring."))
                ((and endfoot (not glide))
                 ;; This moment has NO GLIDE following it
                 (set! foot-glide-event (assoc-set! foot-glide-event endfoot #f))))
            )))  ;; end of listener
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ;; Acknowledger
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        (acknowledgers
          ((script-interface this-engraver grob source-engraver)
            (let*
              ((cause (ly:grob-property grob 'cause))
               (atype (ly:prob-property cause 'articulation-type))
               (astr (symbol->string atype))
               (startfoot (get_startfoot astr))  ;; for the CURRENT mark
               (endfoot (get_endfoot astr))  ;; for the CURRENT mark
               (foot-glide-evt (assoc-get endfoot foot-glide-event))
               ;; ... a FOLLOWING glide, if present
               (new-glide-grob
                 ;; the (FOLLOWING) grob being created, or false (#f)
                 (if foot-glide-evt
                   (ly:engraver-make-grob this-engraver 'FingerGlideSpanner
                     (last foot-glide-evt))
                   #f))
               (tweaks (assoc-get endfoot glide-tweaks '())))

              ;; (ly:message ">>> acknowledger: astr = ~a, startfoot = ~a, endfoot = ~a, grob = ~a, new-glide-grob = ~a" astr startfoot endfoot grob new-glide-grob)

              ;; Respect user tweaks
              (if (ly:grob? new-glide-grob)
                (for-each
                  (lambda (tweak)
                    (if (pair? (car tweak))
                      (let*
                        ((key (cdar tweak)))
                        (ly:grob-set-nested-property! new-glide-grob key (cdr tweak)))
                    (ly:grob-set-property! new-glide-grob (car tweak) (cdr tweak))))
                  tweaks))

              ;; Update local `glide-tweaks`, setting the already done tweaks to
              ;; an empty list for the current foot.
              (set! glide-tweaks (assoc-set! glide-tweaks endfoot '()))

              ;; Set right bound.
              ;; Select the preceding spanner grob via our startfoot (its
              ;; endfoot) from glide-grobs, if there is one, and call it
              ;; preceding-spanner.
              (let*
                ((preceding-spanner (assoc-get startfoot glide-grobs)))
                ;; (ly:message ">>> acknowledger: ... has preceding glide = ~a, has following glide = ~a" (not (not preceding-spanner)) (not (not foot-glide-evt)))
                (if preceding-spanner (begin
                  ;; (ly:message ">>> acknowledger: binding RIGHT edge of PRECEDING glide to current pedalmark; announcing its end")
                  ;; (ly:message ">>> acknowledger: ... preceding-spanner = ~a" preceding-spanner)
                  (ly:spanner-set-bound! preceding-spanner RIGHT grob)
                  (adjust_preceding_y_right preceding-spanner astr)
                  (ly:engraver-announce-end-grob this-engraver preceding-spanner grob)
                  (if (not foot-glide-evt) (begin
                    ;; (ly:message ">>> acknowledger: ... also clearing glide-grobs for foot = ~a/~a, since no following glide" startfoot endfoot)
                    (set! glide-grobs (assoc-set! glide-grobs startfoot #f))
                    (set! glide-grobs (assoc-set! glide-grobs endfoot #f)))))))

              ;; Set left bound and store the foot with the created grob
              ;; (FOLLOWING glide) as a pair in local `glide-grobs`
              (if new-glide-grob (begin
                ;; (ly:message ">>> acknowledger: ... binding LEFT edge of FOLLOWING glide to current pedalmark, and adding it to glide-grobs for foot = ~a" endfoot)
                (set! glide-grobs (cons (cons endfoot new-glide-grob) glide-grobs))
                (ly:spanner-set-bound! new-glide-grob LEFT grob)
                (adjust_following_y_left new-glide-grob astr))))))
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ;; Finalizer
        ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ((finalize this-engraver)
          ;; Warn for a created grob without right bound (if so, kill the grob).
          (for-each
            (lambda (grob-entry)
              ;; (ly:message ">>> Finalizing: ~a" grob-entry)
              (if (and (ly:grob? (cdr grob-entry))
                       (not (ly:spanner-bound (cdr grob-entry) RIGHT #f)))
                (begin
                  (ly:warning "Missing glide target for ~a, for foot = ~a"
                              (cdr grob-entry)
                              (car grob-entry))
                  (ly:grob-suicide! (cdr grob-entry)))))
            glide-grobs)
          ;; Housekeeping
          (set! glide-grobs '())
          (set! glide-tweaks '())
          (set! foot-glide-event '()))
      )  ;; end of make-engraver
    )))


% -----------------------------------------------------------------------------
% newPedalVoice
% -----------------------------------------------------------------------------

newPedalVoice = 
#(define-music-function
    (name notes)  ;; name is optional
    ((string? "") ly:music?)
  #{
    \new Voice = #name
    \with {
      \consists #Pedal_glide_engraver
      \remove Finger_glide_engraver
    }
    {
      $notes  % Use $notes for a copy, rather than #notes and some risk of modification
    }
  #})


% =============================================================================
% organ_pedal_marks.ly ends here
% =============================================================================

% organ_pedal_marks_demo.ly

% \version "2.24.1"  % Lilypond version

% =============================================================================
% Demonstration of organ_pedal_marks.ly
% =============================================================================
% By Rudolf Cardinal <rudolf@pobox.com>, Feb 2024. Public domain.
% In memory of John Cardinal (1944-2024).

% \include "organ_pedal_marks.ly"

\language "english"
% \bookOutputName "organ_pedal_marks_demo"
#(set-global-staff-size 14)
\header {
  tagline = \markup { }  % Turn off Lilypond footer
}

toccata_ending = \relative c' {
  % ---------------------------------------------------------------------------
  % Standard pedal marks
  % ---------------------------------------------------------------------------
  % The closing pedal passage (bars 27-30) from the Toccata of J.S. Bach
  % (~1703-7), Toccata and Fugue in D minor (BWV 565), marked following the
  % Novello 1948 edition (see organ_pedal_marks.ly for citation).
  % A couple have been added so that every note has a pedal mark.

  r2 g4 \rtoe f \ltoe |
  bf4. \rtoe a16 \rheel g \ltoe
    a8. \rtoe e16 \ltoe f \rheel d \lheel e \rtoe cs \ltoe |
  d \rheel b \ltoe cs \rtoe a \lheel bf \rtoe gs \ltoe a \lheel g' \rtoe
    f8 \rheel d \ltoe a4 \rtoe |
  d,2 \ltoe r2 |
}

pedal_marks_passage_one = \relative c {
  % ---------------------------------------------------------------------------
  % Heel-toe marks
  % ---------------------------------------------------------------------------
  d4 \ltoeheel d \lheeltoe d \rtoeheel d \rheeltoe \bar "||"
  % ---------------------------------------------------------------------------
  % Foot changes
  % ---------------------------------------------------------------------------
  d4 \ltoe_rtoe d \ltoe_rheel d \lheel_rtoe d \lheel_rheel |
  d \rtoe_ltoe d \rtoe_lheel d \rheel_ltoe d \rheel_lheel \bar "||"
  % ---------------------------------------------------------------------------
  % Slides and forward/backward indicators
  % ---------------------------------------------------------------------------
  f8 \rtoe_slide e \rheel_slide  d \ltoe_slide c \lheel_slide r2 \bar "||"
  <<
    \newPedalVoice "rightfoot" {
      \voiceThree
      e4 \rheel_forward d \rtoe_forward
      e  \rtoe_backward d \rheel_backward |
    }
    \newPedalVoice "leftfoot" {
      \voiceFour
      d4 \lheel_backward c \ltoe_backward
      d  \ltoe_forward  c \lheel_forward |
    }
  >> \bar "||"
  % ---------------------------------------------------------------------------
  % Foot-behind markings
  % ---------------------------------------------------------------------------
  g4  \rtoe           a \lheel_behind
  b   \rtoe           c \ltoe_behind |
  d   \rtoe           c \ltoe
  b   \rheel_infront  a \ltoe |
  g   \rtoe_infront   r4
  g'4 \ltoe           f \rheel_behind |
  e   \ltoe           d \rtoe_behind
  c   \ltoe           d \rtoe |
  e   \lheel_infront  f \rtoe
  g   \ltoe_infront   r4 \bar "||"
}

pedal_marks_passage_two = \relative c {
  % ---------------------------------------------------------------------------
  % Foot glissando marks (e.g. toe slides from one note to the next)
  % ---------------------------------------------------------------------------
  \newPedalVoice {
    f4 \rtoe \glide e \rtoe d \rheel \glide c \rheel |
    f4 \ltoe \glide e \ltoe d \lheel \glide c \lheel \bar "||"
  }

  % ---------------------------------------------------------------------------
  % And with unusual single-pedal marks:
  % ---------------------------------------------------------------------------
  \newPedalVoice {
    g'8 \ltoe_backward \glide f \ltoe_behind \glide
      e \ltoe_forward \glide d \ltoe_infront \glide
      c \ltoe_slide \glide b \ltoeheel r4 |
    g'8 \rtoe_backward \glide f \rtoe_behind \glide
      e \rtoe_forward \glide d \rtoe_infront \glide
      c \rtoe_slide \glide b \rtoeheel r4  \bar "||"
  }

  % ---------------------------------------------------------------------------
  % Two pedal voices + glissando
  % ---------------------------------------------------------------------------
  <<
    \newPedalVoice "rightfoot" {
      \voiceThree
      f'4 \rtoe \glide e \rtoe d \rheel \glide c \rheel
    }
    \newPedalVoice "leftfoot" {
      \voiceFour
      f,4 \ltoe \glide e \ltoe d \lheel \glide c \lheel
    }
  >> \bar "||"
  % ---------------------------------------------------------------------------
  % Control condition: two pedal voices without glissando
  % ---------------------------------------------------------------------------
  <<
    \new Voice = "rightfoot" {
      \voiceThree
      e'4 \rtoe d \rheel c \rtoe b \rheel
    }
    \new Voice = "leftfoot" {
      \voiceFour
      e,4 \ltoe d \lheel c \ltoe b \lheel
    }
  >> |
}

common_time = {
  \time 4/4
}
common_time_bass = {
  \common_time
  \clef "bass"
}
common_settings_toccata = {
  \common_time_bass
  \key d \minor
}

\score {
  \new Staff {
    \sectionLabel "Unmodified (Bach, BWV 565, bars 27-30). Pedal marks are always L below staff, R above."
    \common_settings_toccata
    \toccata_ending
  }
}

\score {
  \new Staff {
    \common_settings_toccata
    \sectionLabel "Forced to Lilypond default style (outward-pointing toes, outward-pointing heels)"
    % Demonstrate the "applyPedalmarkStyle"/"revertPedalmarkStyle" method:
    \applyPedalmarkStyle "lilypond"
    \toccata_ending
    \revertPedalmarkStyle
  }
}

\score {
  \new Staff {
    \common_settings_toccata
    \sectionLabel "Modern style (e.g. Trevor 1971; inward toes, circle heels)"
    % But usually it will be clearer and less error-prone to use
    % "withPedalmarkStyle":
    \withPedalmarkStyle "modern" { \toccata_ending }
  }
}

\score {
  \new Staff {
    \common_settings_toccata
    \sectionLabel "Traditional style (e.g. Bach/Novello 1948; upward toes, downward heels)"
    \withPedalmarkStyle "traditional" { \toccata_ending }
  }
}

\score {
  \new Staff {
    \common_time_bass
    \sectionLabel "Heel/toe change; foot change; foot slide; foot forward/backward; foot behind/in-front (Lilypond)"
    \withPedalmarkStyle "lilypond" { \pedal_marks_passage_one }
  }
}

\score {
  \new Staff {
    \common_time_bass
    \sectionLabel "Heel/toe change; foot change; foot slide; foot forward/backward; foot behind/in-front (modern)"
    \withPedalmarkStyle "modern" { \pedal_marks_passage_one }
  }
}

\score {
  \new Staff {
    \common_time_bass
    \sectionLabel "Heel/toe change; foot change; foot slide; foot forward/backward; foot behind/in-front (traditional)"
    \withPedalmarkStyle "traditional" { \pedal_marks_passage_one }
  }
}

\score {
  \new Staff {
    \common_settings_toccata
    \sectionLabel "As above but no style applied; will fail and print square broken-pedal marks"
    \pedal_marks_passage_one
  }
}

\score {
  <<
    % -------------------------------------------------------------------------
    % Finger glides, for comparison
    % -------------------------------------------------------------------------
    \new PianoStaff <<
      \new Staff = "RH" {
        \sectionLabel "Finger glides (standard Lilypond) and pedal glides (new) (no pedal mark style applied)"
        \common_time
        \clef "treble"
        \relative c'' {
          <cs\glide-2>2. <d-2>4 |
          \set fingeringOrientations = #'(right)
            <cs\glide-3>2.
            \set fingeringOrientations = #'(left)
            <d-3>4 |
          r2 r4 r8
            \set fingeringOrientations = #'(right)
            <g\glide-2>16
            \set fingeringOrientations = #'(left)
            <f-2> |
        }
      }
      \new Staff = "LH" {
        \common_time_bass
        \relative c {
          <cs\glide-2>2. <d-2>4 |
            \set fingeringOrientations = #'(right)
            <cs\glide-3>2.
            \set fingeringOrientations = #'(left)
            <d-3>4 |
          r2 r4 r8
            \set fingeringOrientations = #'(right)
            <e\glide-2>16
            \set fingeringOrientations = #'(left)
            <f-2> |
        }
      }
    >>

    % -------------------------------------------------------------------------
    % Standard pedal glides
    % -------------------------------------------------------------------------
    \new Staff = "pedal" {
      \common_time_bass
      \relative c \newPedalVoice {
        a2 \ltoe \glide g4 \ltoe \glide f \ltoe |
        f'2 \rtoe \glide g4 \rtoe \glide a \rtoe |
      }
      <<
        \relative c \newPedalVoice "right_foot" {
          \voiceThree
          a'2 \rtoe \glide g4 \rtoe \glide f \rtoe |
        }
        \relative c \newPedalVoice "left_foot" {
          \voiceFour
          r4 f, \ltoe \glide g \ltoe \glide a \ltoe |
        }
      >>
    }
  >>
}

\score {
  \new Staff {
    \common_time_bass
    \sectionLabel "More pedal glides (foot glissando); with unusual marks; two pedal voices with/without glides (modern style)"
    \withPedalmarkStyle "modern" { \pedal_marks_passage_two }
  }
}

\score {
  % ---------------------------------------------------------------------------
  % Checking all symbols are treated properly: foot transitions
  % ---------------------------------------------------------------------------
  \new Staff = "pedal"
  % \with { \remove Staff_symbol_engraver }
  {
    \sectionLabel "Pedal glides with foot transition marks"
    \common_time_bass
    \withPedalmarkStyle "modern" {
      \relative c' \newPedalVoice {
        a16 \ltoe \glide
          g \ltoe_rtoe \glide a \rtoe \glide
          b \rtoe_ltoe \glide a \ltoe
          r16 r8 r2 |
        a16 \ltoe \glide
          g \ltoe_rtoe   \glide r16 f \rtoe_ltoe   \glide r16
          e \ltoe_rheel  \glide r16 d \rheel_ltoe  \glide r16
          c \lheel_rtoe  \glide     b \rtoe_lheel  \glide
          a \lheel_rheel \glide     g \rheel_lheel \glide
          f \lheel r8 |
      }
    }
  }
}

\score {
  % ---------------------------------------------------------------------------
  % Check that glides don't bridge gaps incorrectly
  % ---------------------------------------------------------------------------
  \new Staff = "pedal"
  % \with { \remove Staff_symbol_engraver }
  {
    \sectionLabel "Behaviour with potentially erroneous glides within a voice, and other edge check conditions"
    \common_time_bass
    \withPedalmarkStyle "modern" {
      \relative c \newPedalVoice {
        f4 \ltoe \glide g \rtoe f \ltoe r |
          % ... Likely erroneous, but it attaches to the next use of the same
          % foot.
        b \rtoe_ltoe \glide a \ltoe_rtoe \glide g \rtoe_ltoe f \ltoe |
          % ... Checking here that a superfluous glide doesn't persist (bridging
          % to the last note).
      }
    }
  }
}