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: i...@kierenmacmillan.info _______________________________________________ lilypond-user mailing list lilypond-user@gnu.org https://lists.gnu.org/mailman/listinfo/lilypond-user