2017-08-29 14:27 GMT+02:00 Thomas Morley <thomasmorle...@gmail.com>: > 2017-08-27 22:34 GMT+02:00 David Kastrup <d...@gnu.org>: > >> You are right that fold-matches is probably not worth the trouble in >> brain contortion here: processing the result from list-matches should be >> good enough without overflowing memory. > [...] > > Though, if I split the string anyway (splitting at #\space should do > no harm, imho), it's probably cheaper to go for string-match instead > of list-matches.
I've now taken this route. Full working code/pdf attached, though, there's surely wide room to improve it. Usage should be clear from comments and example, I'm too tired to do verbose explanations. Cheers, Harm
\version "2.19.64"
#(use-modules (ice-9 regex))
%#(use-modules (ice-9 rdelim))
#(define char-set:dynamics
(char-set #\f #\m #\p #\r #\s #\z))
#(define separator-pair (cons #\{ #\}))
%% 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 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.
;; Those list elements are formated as a list of italic-markups for the
;; (possible parts) before and after the dynamic and dynamic-markup for the
;; dynamic itself. Other list elements are left untouched.
;; Returns a new list.
;;
;; Example:
;; (dynamics-list "\\{[^{}]*\\}" "poco {f}")
;; =>
;; (list "poco"
;; (list (markup #:italic "")
;; (markup #:dynamic "f")
;; (markup #:italic "")))
;;
(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
(make-italic-markup (match:prefix match))
(make-dynamic-markup cand)
(make-italic-markup (match:suffix match)))
s))
s)))
(string-split strg #\space))))
#(define (compose-markup markup-proc lst)
;; Takes a list and formats its elements with concat-markup (for sublists) or
;; italic-markup.
;; The resulting list is processed by markup-proc, usually 'make-line-markup'
;; or 'make-concat-markup'
;; Return this markup.
;; TODO? a check whether 'lst' and/or its elements is suitable does not happen
(markup-proc
(map
(lambda (e)
(if (list? e)
(make-concat-markup e)
(make-italic-markup e)))
lst)))
#(define (get-all-list-indices lst)
;; Takes a list and returns a new list of indices of sublists in 'lst'
(filter-map
(lambda (e c) (if (list? e) c #f))
lst
(iota (length lst))))
#(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)))))
#(define (get-some-markups lst idx)
;; 'lst' is a list of strings and/or markup-lists, usually processed by
;; 'dynamics-list'
;; 'idx' selects from (get-all-list-indices lst)
;;
;;
;; Identify the dynamic expression, by 'idx'. This dynamic expression may
;; contain other stuff, though.
;;
;; Get the stuff which is before the dynamic expression.
;; Get the stuff which may be before the dynamic, but should not rendered
;; with a dynamic font.
;; Get the dynamic, which should be centered below NoteColumn later.
;; Get the entire markup.
;;
;; Returns a list of above in this order.
;;
;; This list will be used later to calculate the values for X-offset to center
;; the identified dynamic below the NoteColumn
;;
;; Example:
;; (display-scheme-music
;; (get-some-markups (dynamics-list (cons #\{ #\}) "poco {f}") 0))
;; =>
;; (list (markup #:concat (#:italic "poco" #:italic " "))
;; (markup #:italic "")
;; (markup #:dynamic "f")
;; (markup
;; #:line
;; (#:italic
;; "poco"
;; #:concat
;; (#:italic "" #:dynamic "f" #:italic ""))))
(let ((all-dyn-indices (get-all-list-indices lst))
(complete-lst-mrkp (compose-markup make-line-markup lst)))
(if (null? all-dyn-indices)
(list '() '() '() complete-lst-mrkp)
(let* (;; if idx exceeds, print a warning and use first possible
;; dynamic
(dyn-pos
(if (>= idx (length all-dyn-indices))
(begin
(ly:warning
"requested dynamic to align does not exist, ignoring")
(car all-dyn-indices))
(list-ref all-dyn-indices idx)))
(before-part (take lst dyn-pos))
(before-ls
(if (null? before-part)
'()
;; put in " " between every element and at the end of
;; 'before-part'
;;
;; It would more convenient to use make-line-markup in
;; in 'before-mrkp' below, but I don't know how to insert
;; _single_ space at the end of make-line-markup, other
;; than:
;; (make-concat-markup
;; (make-line-markup (list ...))
;; " ")
;; which is clumsy as well.
(append
(list-insert-separator before-part " ")
'(" "))))
(before-mrkp (compose-markup make-concat-markup before-ls))
(dyn-expr (list-ref lst dyn-pos))
(first-part-dyn-expr (car dyn-expr))
(dyn-to-center (second dyn-expr)))
(list
before-mrkp
first-part-dyn-expr
dyn-to-center
complete-lst-mrkp)))))
dynamicH =
#(define-event-function (align-on-dyn? idx strg)
((boolean? #f)(index? 1) string?)
;; Takes a string, puts out a formated dynamic-script using dynamic font for
;; identified DynamicText, italic for all other stuff.
;; 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* (;; list-ref starts with zero for the first element, thus use (1- idx)
;; for a nicer user-interface
(info (get-some-markups (dynamics-list separator-pair strg) (1- idx)))
(dynamic
(make-music 'AbsoluteDynamicEvent
'text (make-normal-text-markup (last info))))
(x-off-proc
(lambda (grob)
(let* ((calculated-x-off
(if (markup? (third info))
(let* ((layout (ly:grob-layout grob))
(props
(ly:grob-alist-chain grob
(ly:output-def-lookup
layout
'text-font-defaults)))
;; get the parent NoteColumn
(x-parent (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-parent)
(ly:grob-extent x-parent x-parent X))))
;; get the lengths of the stencils for the
;; first three entries of 'info'
(stils-x-length-lst
(map
(lambda (e)
(interval-length
(ly:stencil-extent
(interpret-markup
layout
props
(make-normal-text-markup e))
X)))
(take info 3))))
;; 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 stils-x-length-lst))
align-on-dyn?)
(- parent-x-ext-center
(car stils-x-length-lst)
(second stils-x-length-lst)
(/ (third stils-x-length-lst) 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))))
;; 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
x-off-proc
(ly:music-property dynamic 'tweaks)))
dynamic))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%#(define tst "foo [[[[[{fff}]!, poco {f}, but {p} sub. {ma} non troppo {fff}")
%#(define tst "[[[[[{fff}]!, poco {f}, but {p} sub. {ma} non troppo")
#(define tst "{fff} poco {f}, but {p} sub. {ma} non troppo")
%#(define tst "{pp}, but {p} sub. {ma} non troppo")
%#(define tst "{f}")
%#(define tst "foo")
%#(define tst "poco {f}")
\score {
<<
\new Staff \with { instrumentName = "\\dynamicH" }
{ c'1 \dynamicH \tst }
\new Staff
\with {
instrumentName =
\markup \center-column { "\\dynamicH" "\\tweak" "self-alignment-X" }
}
{ c'1 -\tweak self-alignment-X #RIGHT \dynamicH \tst }
\new Staff
\with {
instrumentName =
\markup \center-column { "\\dynamicH" "\\tweak" "X-offset" }
}
{ c'1 -\tweak X-offset 1 \dynamicH \tst }
%% defaults
\new Staff \with { instrumentName = "default-dynamic" } { c'1 \fff }
\new Staff \with { instrumentName = "default-dynamic" } { c'1 \ff }
\new Staff \with { instrumentName = "default-dynamic" } { c'1 \f }
\new Staff \with { instrumentName = "default-dynamic" } { c'1 \ppp }
\new Staff \with { instrumentName = "default-dynamic" } { c'1 \pp }
\new Staff \with { instrumentName = "default-dynamic" } { c'1 \p }
\new Staff
\with {
instrumentName =
\markup \center-column { "\\dynamicH" "suspended Heads" }
}
{ <c' d'>1 \dynamicH \tst }
\new Staff \with { instrumentName = "default-dynamic" } { <c' d'>1 \fff }
%% helper for better viewing
\addlyrics \with { \override LyricText.parent-alignment-X = #LEFT }
{ \markup \with-dimensions #'(0 . 0) #'(0 . 0) \draw-line #'(0 . 160) }
>>
}
\score {
<<
\new Staff
\with { instrumentName = "\\dynamicH" }
{ c''\dynamicH "{fffff} dramatically" }
\new Staff
\with { instrumentName = "\\dynamicH" }
{ c''\dynamicH "{fffff},,,,,,,,,, dramatically" }
\new Staff
\with {
instrumentName =
\markup \center-column { "\\dynamicH" "\\tweak" "self-alignment-X" }
}
{
c''-\tweak self-alignment-X #LEFT
\dynamicH "poco {f}, but {p} sub. ma non troppo"
}
\new Staff
\with { instrumentName = "\\dynamicH" }
{ c''\dynamicH "poco {f}, but {p} sub. ma non troppo" }
\new Staff
\with {
instrumentName =
\markup \center-column {
"\\dynamicH"
"align-on-dyn? ##t"
"idx 1"
"->align on first Dynamic"
"although other text"
"is before"
}
}
{ c''\dynamicH ##t 1 "poco {f}, but {p} sub. ma non troppo" }
\new Staff
\with {
instrumentName =
\markup \center-column {
"\\dynamicH"
"align-on-dyn? ##t"
"idx 2"
"->align on second Dynamic"
"although other text"
"is before"
}
}
{ c''\dynamicH ##t 2 "poco {f}, but {p} sub. ma non troppo" }
\new Staff
\with {
instrumentName =
\markup \center-column { "\\dynamicH" "\\tweak" "self-alignment-X" }
}
{
c''-\tweak self-alignment-X #RIGHT
\dynamicH "poco {f}, but {p} sub. ma non troppo"
}
\new Staff
\with {
instrumentName =
\markup \center-column {
"\\dynamicH"
"\\tweak"
"self-alignment-X"
"DynamicText.parent-alignment-X"
"LEFT"
}
}
{
\override DynamicText.parent-alignment-X = #LEFT
cis''-\tweak self-alignment-X #RIGHT
\dynamicH "poco {f}, but {p} sub. ma non troppo"
}
\new Staff
\with {
instrumentName =
\markup \center-column {
"\\dynamicH"
"align-on-dyn? ##t"
"idx 1"
"->align on first Dynamic"
"although other text"
"is before"
}
}
{ c''\dynamicH ##t 1 "slightly more {pp}" }
\new Staff
\with {
instrumentName =
\markup \center-column {
"\\dynamicH"
"align-on-dyn? ##t"
"idx 3"
"->align on third Dynamic"
"although other text"
"is before"
}
}
{
c''\dynamicH ##t 3
"[{f}], but [{p}] sub. ma non troppo, segue {mf}"
_\markup
\halign #CENTER
\rounded-box "Above mezzoForte is (very) little off, no clue why"
%% rounding somewhere??
%% blot-diameter??
}
\new Staff \with { instrumentName = "default-dynamic" }
{ c''\dynamicH "{mf}" }
\new Staff \with { instrumentName = "default-dynamic" }
{ c''\mf }
%% helper for better viewing
\addlyrics \with { \override LyricText.parent-alignment-X = #LEFT }
{ \markup \with-dimensions #'(0 . 0) #'(0 . 0) \draw-line #'(0 . 160) }
>>
}
\paper { indent = 5 \cm }
\layout {
%\override DynamicText.stencil =
% #(lambda (grob) (box-stencil (ly:text-interface::print grob) 0 0))
\context {
\Staff
\override InstrumentName.font-size = -2
\override InstrumentName.baseline-skip = 2
\override InstrumentName.stencil =
#(lambda (grob)
(box-stencil
(system-start-text::print grob)
0 1))
}
}
on-the-fly-dynamics-02.pdf
Description: Adobe PDF document
_______________________________________________ lilypond-user mailing list lilypond-user@gnu.org https://lists.gnu.org/mailman/listinfo/lilypond-user
