2017-09-03 18:30 GMT+02:00 Thomas Morley <[email protected]>:
> I think I know how to proceed,
@Kieren
Attached the newest and heavily revised version.
Please read comments for usage.
@David
For one example I use predefined markup-commands like
\markup with-red = \markup \with-color #red \etc
I seem to remember there was some even simpler possibility. Or was it
just a proposal? I can't find it at the moment.
Btw,
\markup my-concat = \markup \concat { \etc "!" }
\markup \my-concat "foo"
fails, no surprise, just a dream ...
Cheers,
Harm
\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 '() '() '())
(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))))
dynamicH =
#(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))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% REMARKS
%% All examples align the dynamic under the NoteColumn
%% Remove the optional arguments in
%% \dynamicH ##t 1 ...
%% if you want different behaviour
%%
%% Some examples use fonts Purisa and LilyJazz, make sure you have them
%#(set-default-paper-size "a4")
\paper { indent = 5 \cm }
layoutDefault =
\layout {
%% DynamicText may be customized with overrides as below.
%% Currently given are the defaults.
%
%\override DynamicText.details.separator-pair = #(cons #\{ #\})
%
%% first value of the pair is used to determine fontsize of dynamics, second
%% for other text
%\override DynamicText.details.dyn-rest-font-sizes = #'(0 . 0)
%
%% first value of the pair is used to render dynamics, second for other text
%% Be aware: if you change/extend the simple make-dynamic-markup, but
%% want to have the dynamics _all_ rendered with dynamic-font wrap your new
%% command around make-dynamic-markup
%\override DynamicText.details.markup-commands =
% #(cons make-dynamic-markup make-italic-markup)
%
%\override DynamicText.font-size = 0
}
%% Change fontsize independently
layoutI =
\layout {
\override DynamicText.details.dyn-rest-font-sizes = #'(3 . -2)
}
%% Change used markup-commands independently
layoutII =
\layout {
\override DynamicText.details.dyn-rest-font-sizes = #'(5 . 0)
\override DynamicText.details.markup-commands =
#(cons
(lambda (arg)
(markup
#:normal-text
#:override '(box-padding . 0.5)
#:override '(thickness . 3)
#:box
#:bold
#:override '(font-name . "LilyJazz")
arg))
(lambda (arg)
(markup
;; Limitation:
;; underline returns a nice output by accident!
;; undertie not
;; Reason: every single part of the text markup needs to be
;; processed separately, otherwise the offsetting calculation will
;; be broken
#:underline
#:override '(font-name . "Purisa")
arg)))
}
%% Change used markup-commands independently
%% Other syntax
layoutIII =
\layout {
\override DynamicText.details.markup-commands =
#(cons
(lambda (arg)
#{
\markup
\override #'(padding . 0.7)
\override #'(thickness . 2.5)
%% REMARK to self:
%% patch make-bracket-markup, its thickness is not customizable
\parenthesize
\dynamic
$arg
#})
(lambda (arg) #{ \markup \bold $arg #}))
\override DynamicText.font-size = 0
}
%% Change used markup-commands independently
%% Again other syntax
\markup customize-dyn =
\markup \ellipse \dynamic \etc
\markup with-red =
\markup \with-color #red \etc
layoutIV =
\layout {
\override DynamicText.details.markup-commands =
#(cons make-customize-dyn-markup make-with-red-markup)
\override DynamicText.font-size = 0
}
%% \dynamicH takes two optional arguments, see above.
%% As soon as more sophisticated markup-commands are used to render the dynamic
%% part using them is recommended.
%% For the sake of the examples shortness, they are always applied here
mus =
<<
\new Staff { c''1\dynamicH ##t 1 "text before {ppppp}" }
\new Staff { c''1\dynamicH ##t 1 "{ppppp} text after" }
\new Staff { c''1\dynamicH ##t 1 "text before {ppppp} text after" }
%% helper for better viewing
\addlyrics %\with { \override LyricText.parent-alignment-X = #LEFT }
{ \markup \with-dimensions #'(0 . 0) #'(0 . 0) \draw-line #'(0 . 30) }
>>
\score { \mus \layoutDefault \header { piece = "DEFAULTS" } }
\score { \mus \layoutI \header { piece = "FONTSIZES" } }
\score { \mus \layoutII \header { piece = "MARKUP-COMMANDS" } }
\score { \mus \layoutIII \header { piece = "MARKUP-COMMANDS" } }
\score { \mus \layoutIV \header { piece = "MARKUP-COMMANDS" } }
\score {
\new Staff { c''1\dynamicH ##t 1 "text before _ppppp_ text after" }
\layout {
\override DynamicText.details.separator-pair = #(cons #\_ #\_)
}
\header { piece = "Changed SEPARATOR-PAIR (no visible changes)" }
}
\score {
\new Staff { c''1\dynamicH ##t 2 "center on {ppppp} second {ff} dynamic" }
\layoutIV
\header { piece = "CENTER ON SECOND DYNAMIC" }
}
_______________________________________________
lilypond-user mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/lilypond-user
