[prev in list] [next in list] [prev in thread] [next in thread]
List: lilypond-user
Subject: Re: =?UTF-8?B?amV0w6ksUmU6IGpldMOp?=
From: Valentin Petzel <valentin () petzel ! at>
Date: 2023-01-27 20:36:16
Message-ID: 2133086.irdbgypaU6 () archbox
[Download RAW message or body]
[Attachment #2 (multipart/mixed)]
I did of course mess up the alignment part.
Cheers,
Valentin
Am Freitag, 27. Jänner 2023, 21:08:47 CET schrieb Valentin Petzel:
> 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
["trem-mod.ly" (trem-mod.ly)]
% 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 self-alignment-X #-0.5 \tremMod "(.*)(...)" |
1:8\tweak self-alignment-X #-0.7 \tremMod "(_.)(_.)(_.)(_.)"
c''4:8\tremMod "(.-)" 4:8^\tremMod "(.-)"
2:16\tweak parent-alignment-X #RIGHT ^\tremMod "(_*)(___)"
}
["signature.asc" (application/pgp-signature)]
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic