[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
does the custom \dynamic function create DynamicText grobs?
From: |
Kieren MacMillan |
Subject: |
does the custom \dynamic function create DynamicText grobs? |
Date: |
Sat, 10 Feb 2018 18:30:51 -0500 |
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
- does the custom \dynamic function create DynamicText grobs?,
Kieren MacMillan <=