Am Mi., 12. Okt. 2022 um 11:37 Uhr schrieb Thomas Morley
<thomasmorle...@gmail.com>:
>
> Am Mo., 10. Okt. 2022 um 21:04 Uhr schrieb Kieren MacMillan
> <kie...@kierenmacmillan.info>:
> >
> > Hi Jean,
> >
> > > This looks like you have done something like
> > > { c'\custdyn "p" }
> > > instead of
> > > { c'\custdyn "{p}" }
> >
> > Hmmm… the only three calls I have look like the second (correct) version,
> > not the first. But switching those three custom dynamics to simple/native
> > dynamics eliminates the error, so it's definitely something in that code
> > that's breaking.
> >
> > Because I need to keep ploughing forward on this score, I'm going to bail
> > here and just leave them as simple dynamics… When I can take a breath (next
> > week?), I'll return and see if I/we can figure out the real root of the
> > problem.
> >
> > Thank you so much for all your help!
> > Kieren.
>
> Hi Kieren,
>
> sorry for the delay...
> I wrote the original code for 2.19.65 and overlooked the bug you
> encountered - it happens if the string-argument is plain text, i.e. no
> dynamics are present, _and_ no spaces occur like "laut", "sehr laut"
> would have worked.
> Furhermore there were a guile1/guile2 problem: `split-at' behaves
> differently now.
> The definition for `note-column::main-extent' is now superflous, can
> be retrieved by calling NoteColumn.main-extent.
>
> Attached you'll find the newest code.
>
Aargh, still an oversight...
New file attached.
>
> You need to rename the function `dynamicH' to `custdyn'
>
> Though, there's currently a patch waiting for 2.25. deleting the
> \simple-markup-command.
> https://gitlab.com/lilypond/lilypond/-/merge_requests/1650
> If merged it will break the coding again.
> While it is possible to work around I'll object to this change.
>
> Cheers,
> Harm
\version "2.23.13"
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% DynamicText, created on the fly
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% Reads
%%%% DynamicText.details.separator-pair
%%%% DynamicText.details.dyn-rest-font-sizes
%%%% DynamicText.details.markup-commands
%%%% DynamicText.details.inner-x-space
%%%% DynamicText.details.outer-x-space
#(use-modules (ice-9 regex))
#(define remove-empty
;; Remove empty strings and empty lists from the given list 'lst'
(lambda (lst)
(remove
(lambda (e)
(or
(and (string? e) (string-null? e))
(and (list? e) (null? e))))
lst)))
#(define char-set:dynamics
(char-set #\f #\m #\p #\r #\s #\z))
#(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)
(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 (dynamic-text::format-text
fontsizes inner-kern outer-kern text-markup-command lst)
(let* ((mrkp-cmnd
(lambda (arg) (make-normal-text-markup (text-markup-command arg))))
(txt-font-size (if (pair? fontsizes) (cdr fontsizes) #f))
(txt-mrkp-cmnd
(lambda (txt)
(if (number? txt-font-size)
(make-fontsize-markup txt-font-size (mrkp-cmnd txt))
(mrkp-cmnd txt))))
(left-out (if (pair? outer-kern) (car outer-kern) #f))
(left-inner (if (pair? inner-kern) (car inner-kern) #f))
(right-inner (if (pair? inner-kern) (cdr inner-kern) #f))
(right-out (if (pair? outer-kern) (cdr outer-kern) #f))
(space-mrkp-cmd
(lambda (space)
(if (number? space)
(txt-mrkp-cmnd (make-hspace-markup space))
""))))
(map
(lambda (e)
(if (list? e)
(remove-empty
(list
(cond ((and (string-null? (car e)) (equal? e (car lst))) '())
((string-null? (car e))
(space-mrkp-cmd left-out))
((and (not (string-null? (car e))) (equal? e (car lst)))
(make-concat-markup
(remove-empty
(list
(txt-mrkp-cmnd (car e))
(space-mrkp-cmd left-inner)))))
(else
(make-concat-markup
(remove-empty
(list
(space-mrkp-cmd left-out)
(txt-mrkp-cmnd (car e))
(space-mrkp-cmd left-inner))))))
(second e)
(cond ((and (string-null? (last e)) (equal? e (last lst))) '())
((string-null? (last e))
(space-mrkp-cmd right-out))
((and (not (string-null? (last e)))
(equal? e (last lst)))
(make-concat-markup
(remove-empty
(list
(space-mrkp-cmd right-inner)
(txt-mrkp-cmnd (last e))))))
(else
(make-concat-markup
(remove-empty
(list
(space-mrkp-cmd right-inner)
(txt-mrkp-cmnd (last e))
(space-mrkp-cmd right-out))))))))
(make-line-markup (list (txt-mrkp-cmnd e)))))
lst)))
#(define (get-string-indices lst)
(filter-map
(lambda (e c) (if (string? e) c #f))
lst
(iota (length lst))))
#(define (dynamic-text::structered-list
separators fontsizes inner-kern outer-kern markup-commands idx strg)
(let* ((ls (dynamics-list separators strg))
(dynamic-fontsize (if (pair? fontsizes) (car fontsizes) #f))
(dyn-mrkp-cmnd (car markup-commands))
(dynamic-mrkp-cmnd
(lambda (txt)
(if (number? dynamic-fontsize)
(make-fontsize-markup dynamic-fontsize
(make-normal-text-markup (dyn-mrkp-cmnd txt)))
(make-normal-text-markup (dyn-mrkp-cmnd txt)))))
(formated-dyns
(dynamic-text::format-text
fontsizes
inner-kern
outer-kern
(cdr markup-commands)
ls))
(spaced-formated-dyns
(list-insert-separator formated-dyns (make-simple-markup " ")))
(spaced-plain
(append-map
(lambda (y) (if (markup-list? y) y (list y)))
spaced-formated-dyns))
(spaced-with-dyn
(map
(lambda (e)
(if (string? e)
(dynamic-mrkp-cmnd e)
e))
spaced-plain))
(string-spaced-indices (get-string-indices spaced-plain))
;; if idx exceeds, print a warning and use first possible
;; dynamic
;; if idx is negative, due to (1- idx) in the function-body of dynamicH
;; return #f, same for if (null? string-spaced-indices). Meaning no
;; dynamics are indicated.
;; This will finally return (with dynamicH) a left align dynamic.
(dyn-pos
(cond ((or (negative? idx) (null? string-spaced-indices)) #f)
((>= idx (length string-spaced-indices))
(begin
(ly:warning
"requested dynamic to align does not exist, ignoring")
(car string-spaced-indices)))
(else (list-ref string-spaced-indices idx))))
(splitted-at-dyn-index
(if dyn-pos
(call-with-values
(lambda () (split-at spaced-with-dyn dyn-pos))
list)
spaced-with-dyn)))
(if (markup-list? splitted-at-dyn-index)
splitted-at-dyn-index
(let* ((before (car splitted-at-dyn-index))
(dyn&else (cadr splitted-at-dyn-index)))
(cons*
before
(if (pair? dyn&else)
(list (car dyn&else) (cdr dyn&else))
dyn&else))))))
dynamicH =
#(define-event-function (idx strg)
((index? 1) string?)
"Returns customized DynamicText derived from @var{strg}.
Parts which should be rendered with as dynamics should be entered by
surrounding them with the elements of @code{details.separator-pair}, default is
@code{(cons #\\{ #\\})}.
The output is done by using the procedures from @code{details.markup-commands},
defaulting to @code{(cons make-dynamic-markup make-italic-markup)}.
Further customizing is possible by using
@code{details.dyn-rest-font-sizes}, needs a pair, default is unset
@code{details.inner-x-space}, needs a pair, default is unset
@code{details.outer-x-space}, needs a pair, default is is unset
The optional @var{idx} determines which dynamic part is centered under the
NoteColumn (in case @var{strg} contains multiple dynamics)."
(let* ((dynamic (make-music 'AbsoluteDynamicEvent))
(tweak-proc
(lambda (grob)
(let* ((separator-pair
(assoc-get
'separator-pair
(ly:grob-property grob 'details)
(cons #\{ #\})))
;; 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)))
;; get the markup-commands to use from the relevant
;; details-sub-property, i.e. 'markup-commands, a pair
;; car for dynamic, cdr for the rest
(markup-commands
(assoc-get
'markup-commands
(ly:grob-property grob 'details)
(cons make-dynamic-markup make-italic-markup)))
;; get the pair-value to use for inserting some space to the
;; left and/or right of the dynamic, usefull for bracketed
;; dynamics or dynamics with punctuations
(inner-kern
(assoc-get
'inner-x-space
(ly:grob-property grob 'details)))
;; get the pair-value to use for inserting some space
;; between the dynamic expression and other text.
(outer-kern
(assoc-get
'outer-x-space
(ly:grob-property grob 'details)))
(stil-candidates
(dynamic-text::structered-list
separator-pair
dyn-rest-font-sizes
inner-kern
outer-kern
markup-commands
(1- idx)
strg))
(all-stils
(map
(lambda (mrkp)
(if (null? mrkp)
empty-stencil
(grob-interpret-markup grob
(if (markup-list? mrkp)
(make-concat-markup mrkp)
mrkp))))
stil-candidates))
(prev-self-alignment-X-tweaks
(filter
(lambda (tw)
(eq? (car tw) 'self-alignment-X))
(ly:prob-property
(ly:grob-property grob 'cause)
'tweaks))))
(begin
(ly:grob-set-property! grob 'stencil
(stack-stencils X RIGHT 0 all-stils))
;; if previous tweak for self-alignment-X is present return '()
(cond
((pair? prev-self-alignment-X-tweaks)
'())
((markup-list? stil-candidates)
(ly:grob-set-property! grob 'X-offset
(ly:grob-property grob 'X-offset)))
(else
(ly:grob-set-property! grob 'X-offset
(let* ((x-exts
(map
(lambda (stil) (ly:stencil-extent stil X))
(take all-stils 2)))
(x-par (ly:grob-parent grob X))
(parent-x-ext-center
(interval-center
(if (ly:grob-property grob
'X-align-on-main-noteheads)
(ly:grob-property x-par 'main-extent)
(ly:grob-extent x-par x-par X))))
;; 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))))
(+
prev-x-off
(-
parent-x-ext-center
(interval-length (car x-exts))
(/ (interval-length (second x-exts)) 2)
(cond ((and (ly:stencil-empty? (car all-stils))
(negative? (car (second x-exts))))
(car (second x-exts)))
((negative? (car (first x-exts)))
(car (first x-exts)))
(else 0)))))))))))))
(set! (ly:music-property dynamic 'tweaks)
(acons 'before-line-breaking
tweak-proc
(ly:music-property dynamic 'tweaks)))
dynamic))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
tst = "foo {mf} poco, poco -{f}- piu ,{p}! {f} {p} {ff} {ppp}"
%tst = "{mf} poco, poco -{f}- piu ,{p}! {f} {p} {ff} {ppp}"
%tst = "some text only"
%tst = "foo"
%tst = "{f} to {p}"
\score {
<<
\new Staff \with { instrumentName = "\\dynamicH" }
{ c'1\dynamicH 4 \tst }
\new Staff \with { instrumentName = "default" }
{ c'1 -$(make-dynamic-script
(make-normal-text-markup
(make-italic-markup "some text only"))) }
\new Staff \with { instrumentName = "default" }
{ c'1 \mf }
\new Staff \with { instrumentName = "default" }
{ c'1 \f }
\new Staff \with { instrumentName = "default" }
{ c'1 \p }
\new Staff \with { instrumentName = "default" }
{ c'1 \ff }
%% helper for better viewing
\addlyrics \with { \override LyricText.parent-alignment-X = #LEFT }
{ \markup \with-dimensions #'(0 . 0) #'(0 . 0) \draw-line #'(0 . 300) }
>>
\layout {
%% DynamicText may be customized with overrides like below
%% Currently given are the defaults
%
\override DynamicText.details.separator-pair = #(cons #\{ #\})
%% first value of the pair used to render dynamics, second for other text
\override DynamicText.details.markup-commands =
#(cons make-dynamic-markup make-italic-markup)
% \override DynamicText.details.markup-commands =
% #(cons
% (lambda (arg) (make-normal-text-markup (make-box-markup arg)))
% make-underline-markup)
% \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)))
%% first value of the pair used to determine fontsize of dynamics, second
%% for other text
%\override DynamicText.details.dyn-rest-font-sizes = #'(10 . -5)
%\override DynamicText.details.inner-x-space = #'(1 . 1)
%\override DynamicText.details.outer-x-space = #'(4 . 2)
\override DynamicText.after-line-breaking =
#(lambda (grob)
(ly:grob-set-property! grob 'stencil
(box-stencil
(ly:grob-property grob 'stencil)
0
0)))
}
}
%
%
% \markup \box
% $(make-line-markup (list-insert-separator (list "a" "b") (make-simple-markup " ")))
%
% \void \displayScheme #(string? " ")
% \void \displayScheme #(markup? " ")
%
%#(pretty-print
%(filter
% string?
% (list (make-italic-markup "x") (make-simple-markup "y") "z"))
% )
%
%#(pretty-print
%(filter
% string?
% (list (make-italic-markup "x") "y" "z"))
% )
