Hello Werner, there is no real need to butcher the parser for this (which would then be unflexible and unaccessible). You can achieve something like tremolo modifiers simly like this, which is easily adaptable and expandable and does not require us to mess with the parser.
Cheers, Valentin Am Donnerstag, 26. Jänner 2023, 14:16:12 CET schrieb Werner LEMBERG: > > jetéMarkup = > > > > \markup \undertie \pad-x #0.3 > > \pattern #4 #X #0.1 \musicglyph "dots.dot" > > > Note that this kind of markup is not only used for jeté but also for > staccati under a slur if the note has a stem tremolo, as shown in the > attached image. > > Ideally, it would be very nice if we could add 'modifiers' to ':'; the > attached image could be then represented as `d'4.:.(8`, for example. > No idea whether this would work out syntax-wise... > > > Werner
% Supported characters: . (staccato) > (accent) - (tenuto) _ (filler, normal)
#(define trem-mod-chars
(list #\. #\> #\- #\_))
% Aliases . = s, > = a, - = t, _ = n
#(define trem-mod-char-aliases
(list #\s #\a #\t #\n))
#(define trem-mod-char-all
(append trem-mod-chars trem-mod-char-aliases))
#(define trem-mod-syms
(map symbol trem-mod-chars))
#(define trem-mod-syms-aliases
(map symbol trem-mod-char-aliases))
#(define trem-mod-syms-star
(map (lambda (x) (symbol x #\*)) trem-mod-chars))
#(define trem-mod-syms-star-aliases
(map (lambda (x) (symbol x #\*)) trem-mod-char-aliases))
#(define trem-mod-syms-all-base
(append trem-mod-syms trem-mod-syms-aliases))
#(define trem-mod-syms-all-star
(append trem-mod-syms-star trem-mod-syms-star-aliases))
#(define trem-mod-syms-all
(append trem-mod-syms-all-base trem-mod-syms-all-star))
#(define trem-mod-sym-table
`(
(,'. . ,(markup #:pad-x 0.1 #:musicglyph "dots.dot"))
(> . ,(markup #:pad-x 0.2 #:scale '(0.7 . 1) #:musicglyph "scripts.sforzato"))
(- . ,(markup #:pad-x 0.2 #:scale '(0.7 . 1) #:musicglyph "scripts.tenuto"))
(_ . ,(markup #:pad-x 0.2 #:path 0.15 '((moveto 0 0.1) (lineto 0 -0.2) (lineto 0.5 -0.2) (lineto 0.5 0.1))))
))
#(define (string->tremmods str)
(define (char-list-to-units l cur)
(if (null? l)
(if (> (length cur) 0)
(list (apply symbol (reverse cur)))
'())
(if (member (car l) trem-mod-char-all)
(let* ((pos (list-index (lambda (x) (equal? x (car l))) trem-mod-char-aliases))
(char (if pos (list-ref trem-mod-chars pos) (car l))))
(if (> (length cur) 0)
(cons (apply symbol (reverse cur))
(char-list-to-units (cdr l)
(list char)))
(char-list-to-units (cdr l) (cons char cur))))
(if (equal? (car l) #\*)
(if (> (length cur) 0)
(cons (apply symbol (reverse (cons (car l) cur)))
(char-list-to-units (cdr l) '()))
(error "illegal tremolo modifier"))
(error "illegal tremolo modifier")))))
(define (string-split-to-units str)
(char-list-to-units (string->list str) '()))
(define (split-open s closepar)
(let* ((split (string-split s #\())
(split (map (lambda (x)
(if (= (string-length x) 0)
'()
(string-split-to-units x)))
split)))
(if closepar
(if (= (length split) 2)
(append (car split) (list (cadr split)))
(error "illegal tremolo modifier"))
(if (= (length split) 1)
(car split)
(error "illegal tremolo modifier")))))
(define (map-split-open list)
(if (null? (cdr list))
(split-open (car list) #f)
(append (split-open (car list) #t) (map-split-open (cdr list)))))
(let* ((splits (string-split str #\)))
(splits (map-split-open splits))
(splits (filter (lambda (x) (or (not (list? x)) (not (null? x)))) splits)))
splits))
#(define (validate-tremolo-modifier l)
(define (valid-sym x)
(member x trem-mod-syms-all))
(define (star-sym x)
(member x trem-mod-syms-all-star))
(and (fold (lambda (x y) (and y (or (and (list? x) (fold (lambda (x y) (and y (valid-sym x))) #t x)) (valid-sym x))))
#t l)
(< (fold (lambda (x y) (+ y (if (list? x) (fold (lambda (x y) (+ y (if (star-sym x) 1 0))) 0 x) (if (star-sym x) 1 0))))
0 l)
2)))
#(define (tremolo-modifier-length l)
(define (not-star-sym x)
(member x trem-mod-syms-all-base))
(fold (lambda (x y) (+ y (if (list? x) (fold (lambda (x y) (+ y (if (not-star-sym x) 1 0))) 0 x) (if (not-star-sym x) 1 0))))
0 l))
#(define (tremolo-modifier-length-exand l)
(define (star-sym x)
(member x trem-mod-syms-all-star))
(fold (lambda (x y) (or y (if (list? x) (fold (lambda (x y) (or y (star-sym x))) #f x) (star-sym x))))
#f l))
#(define (tremolo-modifier-length-exand-position l)
(define (star-sym x)
(member x trem-mod-syms-all-star))
(define (impl l count)
(if (null? l)
0
(if (list? (car l))
(let ((pos (impl (car l) 1)))
(if (> pos 0)
(cons count pos)
(impl (cdr l) (1+ count))))
(if (star-sym (car l))
count
(impl (cdr l) (1+ count))))))
(impl l 1))
#(define (list-or-string? x) (or (list? x) (string? x)))
#(define-markup-command (tremolo-modifier layout props times mod) (number? list-or-string?)
(define (unstar sym)
(let* ((str (symbol->string sym))
(chars (string->list str))
(chars (delete #\* chars)))
(apply symbol chars)))
(define (sym->markup sym)
(let* ((pos (list-index (lambda (x) (equal? x sym)) trem-mod-syms-aliases))
(sym (if pos (list-ref trem-mod-syms pos) sym)))
(assoc-get sym trem-mod-sym-table)))
(define (format-parts p pos exp-pos exp-times)
(if (null? p)
p
(append
(if (list? (car p))
(let ((part (format-parts (car p) 1
(if (and (pair? exp-pos) (= (car exp-pos) pos))
(cdr exp-pos) 0)
exp-times)))
(if (> (length part) 1)
(list #{
\markup\undertie\pad-x #0.2 \concat #part
#})
part))
(if (and (not (pair? exp-pos)) (= exp-pos pos))
(make-list exp-times (sym->markup (unstar (car p))))
(list (sym->markup (car p)))))
(format-parts (cdr p) (1+ pos) exp-pos exp-times))))
(if (string? mod)
(set! mod (string->tremmods mod)))
(let* ((len (tremolo-modifier-length mod))
(times (if (< times 0) len times))
(exp? (tremolo-modifier-length-exand mod))
(exp-pos (tremolo-modifier-length-exand-position mod))
(exp-times (- times len)))
(if (or (> len times) (and (< len times) (not exp?)))
(error "tremolo modifier is not of correct length"))
(interpret-markup layout props
#{ \markup\concat #(format-parts mod 1 exp-pos exp-times) #})))
\layout {
\context {
\Score
scriptDefinitions =
#(acons 'tremoloModifier
`((padding . 0.5)
(direction . ,DOWN)
(stencil . ,ly:text-interface::print)
(text . ,(lambda (grob)
(let* ((dir (ly:grob-property grob 'direction))
(det (ly:grob-property grob 'details))
(mod (assoc-get 'trem-mod det))
(times (assoc-get 'trem-mod-times det #f))
(supports (ly:grob-object grob 'side-support-elements))
(supports (ly:grob-array->list supports))
(heads (filter (lambda (x) (member 'rhythmic-head-interface (ly:grob-interfaces x))) supports))
(stem (filter (lambda (x) (member 'stem-interface (ly:grob-interfaces x))) supports))
(trem (filter (lambda (x) (member 'stem-tremolo-interface (ly:grob-interfaces x))) supports))
(killed #f))
(if (not times)
(if (or (null? stem) (null? trem))
(begin
(ly:warning "tremolo modifier was given without times but either no stem or no tremolo was found")
(ly:grob-suicide! grob)
(set! killed #t))
(let* ((stem-cause (ly:grob-property (car stem) 'cause))
(stem-cause-cause (ly:grob-property stem-cause 'cause))
(dur (ly:event-property stem-cause-cause 'duration))
(trem-beams (ly:grob-property (car trem) 'flag-count))
(dlog (ly:duration-log dur))
(ddot (ly:duration-dot-count dur))
(trem-dlog (+ trem-beams 2 (max 0 (- dlog 2))))
(unit (expt 2 (- trem-dlog dlog)))
(dots-factor (- 2 (expt 1/2 ddot)))
(tremreps (* unit dots-factor)))
(if (not (exact? tremreps))
(begin
(warning "tremolo flag and dots do not match!")
(set! tremreps (round tremreps))))
(set! times tremreps))))
(if (not killed)
(if (= DOWN dir)
#{
\markup \tremolo-modifier #times #mod
#}
#{
\markup \scale #'(1 . -1) \tremolo-modifier #times #mod
#})
empty-markup)))))
default-script-alist)
}
}
tremMod =
#(define-music-function (times mod) ((number? #f) list-or-string?)
(if (string? mod)
(set! mod (string->tremmods mod)))
(make-music 'ArticulationEvent
'articulation-type
'tremoloModifier
'tweaks
(cons (cons (list #t 'details 'trem-mod) mod)
(if times (list #t (cons (list 'details 'trem-mod-times) times)) '()))
))
\markup \justify {
A tremolo modifier may consist of the characters ., >, -, _, *, (, and )
or the aliases s, a, t, n. . and s will result in a staccato:
\typewriter "\\tremolo-modifier #-1 \".s\"" ~ \tremolo-modifier #-1 ".s" \hspace #2 > or a will result in an accent:
\typewriter "\\tremolo-modifier #-1 \">a\"" ~ \tremolo-modifier #-1 ">a" \hspace #2 - or t will result in a tenuto:
\typewriter "\\tremolo-modifier #-1 \"-t\"" ~\tremolo-modifier #-1 "-t" \hspace #2 _ or n will result in a placeholder:
\typewriter "\\tremolo-modifier #-1 \"_n\"" ~ \tremolo-modifier #-1 "_n". \hspace #2 Parentheses can be used to add slurs under groups:
\typewriter "\\tremolo-modifier #-1 \"(>__)(>.)\"" ~ \tremolo-modifier #-1 "(>__)(>.)" . \hspace #2 * will signify that the previous
symbol is to be repeated to fill up:
\typewriter "\\tremolo-modifier #5 \"(.*)(..)\"" \tremolo-modifier #5 "(.*)(..)" . \hspace #2 A mod string may only contain one
instance of *. A mod string has to specify the requested number of modifiers, unless a * is used. In this case
the string may specify at most the requested number of modifiers. When used in a music context like
\typewriter "\\tremMod \"...\"" the number of modifiers is determined from duration and tremolo beam count if not specified
by \typewriter "\\tremMod n \"...\"".
}
{
4.:8\tremMod "(.*)"
8:16\tremMod ">."
2:16\tweak parent-alignment-X #RIGHT \tremMod "(.*)(...)" |
1:8\tweak parent-alignment-X #RIGHT \tremMod "(_.)(_.)(_.)(_.)"
c''4:8\tremMod "(.-)" 4:8^\tremMod "(.-)"
2:16\tweak parent-alignment-X #RIGHT ^\tremMod "(_*)(___)"
}
signature.asc
Description: This is a digitally signed message part.
