does the custom \dynamic function create DynamicText grobs?

[Kieren MacMillan]

Hi Harm,

Does the snippet below show expected behaviour from your custom \dynamic 
function?
I would have expected the \omit to affect both "dynamic texts"…

Thanks,
Kieren.

%%%%  SNIPPET BEGINS
\version "2.19.64"

#(use-modules (ice-9 regex))

#(define (note-column::main-extent grob)
"Return extent of the noteheads in the 'main column', (i.e. excluding any 
suspended noteheads), or extent of the rest (if there are no heads)."
  (let* ((note-heads (ly:grob-object grob 'note-heads))
         (stem (ly:grob-object grob 'stem))
         (rest (ly:grob-object grob 'rest)))
    (cond ((ly:grob-array? note-heads)
           (let (;; get the cdr from all note-heads-extents, where the car
                 ;; is zero
                 (n-h-right-coords
                   (filter-map
                     (lambda (n-h)
                       (let ((ext (ly:grob-extent n-h grob X)))
                          (and (= (car ext) 0) (cdr ext))))
                     (ly:grob-array->list note-heads))))
             ;; better be paranoid, find the max of n-h-right-coords and return
             ;; a pair with (cons 0 <max>)
             (cons 0.0 (reduce max 0 n-h-right-coords))))
          ((ly:grob? rest)
           (ly:grob-extent rest grob X))
          ;; better be paranoid
          (else '(0 . 0)))))

%% TODO #\space as well?
#(define char-set:dynamics
  (char-set #\f #\m #\p #\r #\s #\z))

%% TODO
%% There's the scheme-procedure `make-regexp', I'm not confident with reg-exps
%% to use it, though
#(define (make-reg-exp separator-pair)
  (format #f "\\~a[^~a~a]*\\~a"
    (car separator-pair)
    (car separator-pair)
    (cdr separator-pair)
    (cdr separator-pair)))

#(define (dynamics-list separator-pair strg)
;; Takes a string, which is splitted at space. Local reg-exp and separators are
;; processed from @var{separator-pair}.
;; Dynamic signs within the splitted string (which are rendered by separators)
;; are selected by matching reg-exp and by containing only dynamic characters
;; between the separators.
;;
;; Returns a new list containing not-dynamic strings and sublists with always
;; three entries.  Before-the-dynamic - dynamic - after-dynamic.
;;
;; Example:
;; (dynamics-list (cons #\{ #\}) "poco -{f}- piu"))
;; =>
;; (list "poco" (list "-" "f" "-") "piu")
;;
  (let ((reg-exp (make-reg-exp separator-pair))
        (separators (char-set (car separator-pair) (cdr separator-pair))))
    (map
      (lambda (s)
        (let* ((match (string-match reg-exp s)))
           (if match
               (let* ((poss-dyn (match:substring match))
                      (cand (string-trim-both poss-dyn separators)))
                 (if (string-every char-set:dynamics cand)
                       (list
                         (match:prefix match)
                         cand
                         (match:suffix match))
                     s))
               s)))
      (string-split strg #\space))))

#(define (get-all-list-indices lst)
"Takes a list and returns a new list of all indices of sublists in @var{lst}"
  (filter-map
    (lambda (e c) (if (list? e) c #f))
    lst
    (iota (length lst))))

#(define (dynamic-text::format-dynamics fontsize markup-command lst)
;; (1) Convert lst into a list where the targeted string is rendered
;;     with dynamic-markup.  The targeted string is identified by being
;;     second in a three-element-(sub-)list of lst.
;; (2) remove empty strings from (sub-)lists.
;; (3) insert " " between any element of lst but not between
;;     elements of the (sub-)lists
;; (4) Return a new list, unfolded one level
;; TODO disentangle applying markup-commands from other stuff?
    (append-map
      (lambda (y) (if (list? y) y (list y)))
      (list-insert-separator
        (map
          (lambda (e)
            (if (and (list? e) (= (length e) 3))
                (remove
                   (lambda (x) (and (string? x) (string-null? x)))
                   (list
                     (car e)
                     (if (number? fontsize)
                         (make-fontsize-markup fontsize
                           (markup-command (second e)))
                         (markup-command (second e)))
                     (last e)))
                e))
          lst)
        " ")))

#(define (dynamic-text::format-text fontsize markup-command lst)
"Format string-parts of @var{lst} with @var{fontsize} and @var{markup-command}"
  (map
    (lambda (arg)
      (if (string? arg)
          (if (number? fontsize)
              (make-fontsize-markup fontsize
                (markup-command arg))
              (markup-command arg))
          arg))
    lst))

#(define (get-list-parts lst dyn-indices idx)
;; Relying on @var{idx}, which selects from @var{dyn-indices} return a new
;; list containing sublists with stuff before the selected dynamic, the
;; dynamic itself and stuff after the dynamic.
  (if (null? dyn-indices)
      (list lst '() '())
      (let* (;; if idx exceeds, print a warning and use first possible
             ;; dynamic
             (dyn-pos
               (if (>= idx (length dyn-indices))
                   (begin
                     (ly:warning
                       "requested dynamic to align does not exist, ignoring")
                     (car dyn-indices))
                   (list-ref dyn-indices idx)))
             (before-dyn (take lst dyn-pos))
             (dyn-to-align (list-ref lst dyn-pos))
             (after-dyn (drop lst (1+ dyn-pos))))
        (list
          before-dyn
          dyn-to-align
          after-dyn))))

dynamic =
#(define-event-function (align-on-dyn? idx strg)
  ((boolean? #f)(index? 1) string?)
;; Takes a string, puts out a formated dynamic-script using a certain
;; markup-command for identified DynamicText, and another markup-command for all
;; other stuff.
;; Both markup-commands are called from 'details.markup-commands. If not set
;; make-dynamic-markup and make-italic-markup are used.
;; Font-sizes for both are called from 'details.dyn-rest-font-sizes. If not set
;; default is used.
;; This text is placed below the NoteColumn, with first occurring DynamicText
;; centered.
;;
;; Setting the optional @var{idx} makes it possible to choose other
;; occurring DynamicText.
;; If some other text is before the DynamicText it will be printed left
;; aligned.  This may be changed by setting optional @var{align-on-dyn}.
;;
;; Be aware while using any optional variable you need to set both.
;;
;; The appearance is futher tweakable by applying tweaks for self-alignment-X
;; and X-offset.
;; If using a tweak for self-alignment-X the calculated value for X-offset will
;; not be used.
;; If using a tweak for X-offset, this value will be added to the calculated
;; one.
;;
;; Limitations:
;;   - Does not respond to _overrides_ of self-alignment-X

  (let* ((dynamic (make-music 'AbsoluteDynamicEvent))
         (tweak-proc
           (lambda (grob)
             (let* (;; get the fontsizes to use from the relevant
                    ;; details-sub-property, i.e. 'dyn-rest-font-sizes
                    (dyn-rest-font-sizes
                      (assoc-get
                        'dyn-rest-font-sizes
                        (ly:grob-property grob 'details)
                        (cons #f #f)))
                    ;; get the markup-commands to use from the relevant
                    ;; details-sub-property, i.e. 'markup-commands
                    (markup-commands
                      (assoc-get
                        'markup-commands
                        (ly:grob-property grob 'details)
                        (cons make-dynamic-markup make-italic-markup)))
                    (separator-pair
                      (assoc-get
                        'separator-pair
                        (ly:grob-property grob 'details)
                        (cons #\{ #\})))
                    ;; get a nested list with dynamics in sublists
                    (basic-dyn-list (dynamics-list separator-pair strg))
                    ;; do dynamic-markups, remove empty strings
                    (cleaned-basic-dyn-list
                      (dynamic-text::format-dynamics
                          (car dyn-rest-font-sizes)
                          (car markup-commands)
                          basic-dyn-list))
                    ;; get indices of dynamics
                    (all-dyn-indices
                      (get-all-list-indices cleaned-basic-dyn-list))
                    ;; do other text-markups
                    (text-dyn-mrkp-list
                      (dynamic-text::format-text
                        (cdr dyn-rest-font-sizes)
                        (cdr markup-commands)
                        cleaned-basic-dyn-list))
                    ;; get a list containing:
                    ;;   before-dynamic, dynamic, after-dynamic
                    ;; list-ref starts with zero for the first element, thus
                    ;; use (1- idx) for a nicer user-interface
                    (splitted-text-dyn-mrkp-list
                      (get-list-parts
                        text-dyn-mrkp-list all-dyn-indices (1- idx)))
                    (all-markups
                      (map
                        (lambda (e)
                          (if (markup-list? e)
                              (make-normal-text-markup
                                (make-concat-markup e))
                              e))
                        splitted-text-dyn-mrkp-list))
                    (all-stils
                      (map
                        (lambda (mrkp)
                          (grob-interpret-markup grob mrkp))
                        all-markups))
                    (layout (ly:grob-layout grob))
                    (line-thick (ly:output-def-lookup layout 'line-thickness))
                    (all-stil-lengths
                      (map
                        (lambda (stil)
                          (let* ((stil-ext (ly:stencil-extent stil X))
                                 (left-car (if (interval-sane? stil-ext)
                                           (car stil-ext)
                                           0))
                                 ;; if the markup-command used to render
                                 ;; dynamics, causes negative extent to the left
                                 ;; and the entire dynamic expression starts
                                 ;; with an empty stencil, it's needed to add
                                 ;; some calculated correction
                                 (corr
                                   (+ (* 2 left-car)
                                   (/ line-thick 2))))
                            (+
                              (interval-length stil-ext)
                              (if (ly:stencil-empty? (car all-stils))
                                  corr
                                  0))))
                        all-stils))
                    (calculated-x-off
                      (if (markup? (second all-markups))
                          (let* ((x-par (ly:grob-parent grob X))
                                 (parent-x-ext-center
                                   (interval-center
                                     (if (ly:grob-property grob
                                           'X-align-on-main-noteheads)
                                         (note-column::main-extent x-par)
                                         (ly:grob-extent x-par x-par X)))))
                            ;; The final calculation takes the extent of the
                            ;; NoteColumn into account.
                            ;; If there is some other text before the dynamic,
                            ;; return 0, but not if align-on-dyn is #t
                            (if (or (zero? (car all-stil-lengths))
                                    align-on-dyn?)
                                (- parent-x-ext-center
                                   (car all-stil-lengths)
                                   (/ (second all-stil-lengths) 2)
                                   )
                                0))
                          ;; if no dynamic at all, do (my choice):
                          0))
                    ;; get tweaks for self-alignment-X
                    (prev-self-alignment-X-tweaks
                      (filter
                        (lambda (tw)
                          (eq? (car tw) 'self-alignment-X))
                        (ly:prob-property
                          (ly:grob-property grob 'cause)
                          'tweaks)))
                    ;; Get previous tweaks for X-offset and add their values
                    ;; They are added to the final result
                    (prev-x-offset-tweaks
                      (filter
                        (lambda (tw)
                          (and (number? (cdr tw)) (eq? (car tw) 'X-offset)))
                        (ly:prob-property
                          (ly:grob-property grob 'cause)
                          'tweaks)))
                    (prev-x-off (apply + (map cdr prev-x-offset-tweaks))))

             ;; TODO is it safe to put the stencil-creation into
             ;;      'before-line-breaking?
             (begin
               (ly:grob-set-property! grob 'stencil
                (stack-stencils X RIGHT 0 all-stils))
               ;; if previous tweaks for self-alignment-X are present return '()
               (if (not (pair? prev-self-alignment-X-tweaks))
                   (ly:grob-set-property! grob
                     'X-offset (+ prev-x-off calculated-x-off))
                   '()))))))
    ;; If a previous tweak for self-alignment-X is present, set
    ;; 'before-line-breaking to the empty list retuned by x-off-proc for this
    ;; case.
    ;; Otherwise 'before-line-breaking will change 'X-offset to the calculated
    ;; value returned from x-off-proc (taking previous tweaks for 'X-offset
    ;; into account.
    ;; TODO need to keep previous settings of 'before-line-breaking?
    (set! (ly:music-property dynamic 'tweaks)
          (acons 'before-line-breaking
                 tweak-proc
                 (ly:music-property dynamic 'tweaks)))
    dynamic))

testing = {
  c''1\p c''1\dynamic "test {p}"
}

\score { \testing }

\score {
  \testing
  \layout {
    \context {
      \Score
      \omit DynamicText
    }
  }
}
%%%%  SNIPPET ENDS
________________________________

Kieren MacMillan, composer
‣ website: www.kierenmacmillan.info
‣ email: address@hidden