Am So., 24. Mai 2020 um 16:36 Uhr schrieb Franz-Rudolf Kuhnen
<[email protected]>:
>
> 914/5000
>
> Hi,
>
> I'm in the process of transcribing the suites from Charles Dieupart from the
> original. Like Rameau, Dieupart also uses special ornaments that are aligned
> directly with the notehead. ("Port de voix" and "Pincé").
>
> I found an interesting article about the realization under Lilypond by
> Nicolas Sceaux:
> https://lilypondblog.org/2013/08/adding-ornamentations-to-note-heads-part-1/
>
> This is actually exactly what I need. Unfortunately, this method no longer
> works with lilypond-2.20. Lilypond reports
>
>
> "Warning: Type check for" HeadOrnamation "failed; value" # <Grob_properties>
> "must be of the type" list "
> Interpretation of the music ...
> Programming error: No rough definition found for `HeadOrnamation’.
> Continued, fingers crossed "
>
> Crossing the fingers didn't help. :-(
>
> Maybe someone can help me.
>
> Thank you in advance.
>
>
>
> Regards
>
> Franz-Rudolf
Iirc switch
(set-object-property! grob-name 'translation-type? list?)
to
(set-object-property! grob-name 'translation-type? ly:grob-properties?)
and you're done.
Attached my version of his code working with 2.20.0.
Please compare with his original, I don't remember, if I changed other
things (for testings or the like).
The provided examples are demonstrating some issues ...
Cheers,
Harm
\version "2.19.42"
%% taken from:
%% https://github.com/nsceaux/nenuvar/blob/master/common/side-ornementations.ily
%% and adapted for v2.19.42
%%%
%%% Utilities for defining new grobs, grob properties and music event types
%%% (there should be built-in commands to do that in LilyPond)
%%%
#(define (define-grob-definition grob-name grob-entry)
"Define a new grob and add it to `all-grob-definitions', after
scm/define-grobs.scm fashion.
After grob definitions are added, use:
\\layout {
\\context {
\\Global
\\grobdescriptions #all-grob-descriptions
}
}
to register them."
(let* ((meta-entry (assoc-get 'meta grob-entry))
(class (assoc-get 'class meta-entry))
(ifaces-entry (assoc-get 'interfaces meta-entry)))
(set-object-property! grob-name 'translation-type? ly:grob-properties?)
(set-object-property! grob-name 'is-grob? #t)
(set! ifaces-entry (append (case class
((Item) '(item-interface))
((Spanner) '(spanner-interface))
((Paper_column) '((item-interface
paper-column-interface)))
((System) '((system-interface
spanner-interface)))
(else '(unknown-interface)))
ifaces-entry))
(set! ifaces-entry (uniq-list (sort ifaces-entry symbol<?)))
(set! ifaces-entry (cons 'grob-interface ifaces-entry))
(set! meta-entry (assoc-set! meta-entry 'name grob-name))
(set! meta-entry (assoc-set! meta-entry 'interfaces
ifaces-entry))
(set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
(set! all-grob-descriptions
(cons (cons grob-name grob-entry)
all-grob-descriptions))))
#(define-public (define-grob-property symbol type? description)
"Define a new grob property.
`symbol': the property name
`type?': the type predicate for this property
`description': the type documentation"
(set-object-property! symbol 'backend-type? type?)
(set-object-property! symbol 'backend-doc description)
symbol)
#(define-public (define-music-type type-name properties)
"Add a new music type description to `music-descriptions'
and `music-name-to-property-table'."
(set-object-property! type-name
'music-description
(cdr (assq 'description properties)))
(let ((properties (list-copy properties)))
(set! properties (assoc-set! properties 'name type-name))
(set! properties (assq-remove! properties 'description))
(hashq-set! music-name-to-property-table type-name properties)
(set! music-descriptions
(cons (cons type-name properties)
music-descriptions))))
%%%
%%% HeadOrnementation grob type
%%%
#(define (head-ornementation::print me)
"Prints a HeadOrnementation grob (at a note head side)"
(let* ((notes (ly:grob-object me 'elements))
(staff-pos (ly:grob-staff-position (ly:grob-array-ref notes 0)))
(y-ref (ly:grob-common-refpoint-of-array me notes Y))
(x-ref (ly:grob-common-refpoint-of-array me notes X))
(x-ext (ly:relative-group-extent notes x-ref X))
(y-ext (ly:relative-group-extent notes y-ref Y))
(y-coord (+ (interval-center y-ext)
(if (and (eq? (ly:grob-property me 'shift-when-on-line) #t)
(memq staff-pos '(-2 0 2)))
0.5
0)))
(padding (ly:grob-property me 'padding 0.1))
(direction (ly:grob-property me 'direction LEFT))
(text (ly:text-interface::print me))
(width (/ (interval-length (ly:stencil-extent text X)) 2.0))
(x-coord (if (= direction LEFT)
(- (car x-ext) width padding)
(+ (cdr x-ext) width padding))))
(ly:stencil-translate
text
(cons
(- x-coord (ly:grob-relative-coordinate me x-ref X))
(- y-coord (ly:grob-relative-coordinate me y-ref Y))))))
%% a new grob property (used to shift an ornementation when the
%% note head is on a staff line)
#(define-grob-property 'shift-when-on-line boolean?
"If true, then the ornementation is vertically shifted when
the note head is on a staff line.")
%% HeadOrnemenation grob definition:
%% a piece of text attached to a note head side.
#(define-grob-definition
'HeadOrnementation
`((font-size . 0)
(padding . 0.1)
(shift-when-on-line . #f)
(stencil . ,head-ornementation::print)
(meta . ((class . Item)
(interfaces . (font-interface))))))
\layout {
\context {
\Global
\grobdescriptions #all-grob-descriptions
}
}
%%% Head-ornementation Engraver
%%%
#(define (make-head-ornementation
engraver note-grob markp direction is-inside shift-on-line)
"Creates a HeadOrnementation grob attached to a note head.
`note-grob': the note head the ornementation is attached to
`markp': the ornementation markup
`direction': where the ornementation should be printed (LEFT or RIGHT of the note head)
`is-inside': if true, then the ornemenation is printed between accidental
or dots and the note head (in this case the accidental or dots are shifted
to the outside); otherwise it is printed outside dots or accidentals.
`shift-on-line': if true, and when the note head is on a staff line, then the
ornementation is vertically shifted."
(let ((ornementation (ly:engraver-make-grob engraver
'HeadOrnementation
note-grob)))
(set! (ly:grob-property ornementation 'direction) direction)
(set! (ly:grob-property ornementation 'text) markp)
(set! (ly:grob-property ornementation 'shift-when-on-line) shift-on-line)
(ly:pointer-group-interface::add-grob ornementation 'elements note-grob)
(set! (ly:grob-parent ornementation Y) note-grob)
(set! (ly:grob-property ornementation 'font-size)
(+ (ly:grob-property ornementation 'font-size 0.0)
(ly:grob-property note-grob 'font-size 0.0)))
(let* ((orn-stencil (ly:text-interface::print ornementation))
(orn-width (interval-length (ly:stencil-extent orn-stencil X)))
(note-column (ly:grob-object note-grob 'axis-group-parent-X))
(accidentals (ly:note-column-accidentals note-column))
(dot-column (ly:note-column-dot-column note-column))
(dot-column-x-off
(if (ly:grob? dot-column)
(ly:grob-property dot-column 'X-offset 'foo)
0)))
;(format #t "\naccidentals: ~a" accidentals)
(cond ;((and (= direction LEFT) (ly:grob? accidentals) is-inside)
; ;; if ornementation on the left side of the note is "inside",
; ;; then shift the accidental to the left to make room for
; ;; the ornementation
; (set! ;(ly:grob-property accidentals 'padding)
; (ly:grob-property accidentals 'right-padding)
; ;(ly:grob-property accidentals 'X-offset)
; ;(ly:grob-property note-column 'X-offset)
; (+ orn-width (* 2 (ly:grob-property ornementation 'padding)))))
((and (= direction RIGHT) (ly:grob? dot-column) is-inside)
;; if ornementation on the right side of the note is "inside",
;; then shift the dots to the right to make room for
;; the ornementation
;; see discussion at
;; http://lilypond.1069038.n5.nabble.com/crash-moving-DotColumn-td190493.html
(set! (ly:grob-property dot-column 'positioning-done)
(lambda (grob)
(ly:dot-column::calc-positioning-done grob)
(ly:grob-translate-axis! grob orn-width X)
#t)))))
ornementation))
#(define (head-ornementation-engraver-acknowledge-note-head
engraver note-grob source-engraver)
"Note head acknowledge method for the head ornementation engraver.
When the note head event attached to the note head grob has ornementation
events among its articulations, then create a HeadOrnementation grob"
(let* ((note-event (ly:grob-property note-grob 'cause)))
(for-each (lambda (articulation)
(if (memq 'head-ornementation-event
(ly:event-property articulation 'class))
(begin
(if (markup? (ly:event-property articulation 'text-left))
(make-head-ornementation
engraver
note-grob
(ly:event-property articulation 'text-left)
LEFT
(ly:event-property articulation 'is-inside)
(ly:event-property articulation 'shift-when-on-line)))
(if (markup? (ly:event-property articulation 'text-right))
(make-head-ornementation
engraver
note-grob
(ly:event-property articulation 'text-right)
RIGHT
(ly:event-property articulation 'is-inside)
(ly:event-property articulation 'shift-when-on-line)))
)))
(ly:event-property note-event 'articulations))))
%% The head-ornementation engraver, with its note-head acknowledger
%% (which creates the HeadOrnementation grobs)
#(define head-ornementation-engraver
`((acknowledgers
(note-head-interface
. ,head-ornementation-engraver-acknowledge-note-head))))
\layout {
\context {
\Score
\consists #head-ornementation-engraver
}
}
%%%
%%% HeadOrnementationEvent definition
%%%
#(define-event-class 'head-ornementation-event 'music-event)
%% a post script event for ornementations attached to note heads
#(define-music-type 'HeadOrnementationEvent
'((description . "Print an ornementation at a note head side")
(types . (general-music post-event event head-ornementation-event))))
%%%
%%% Head ornementation music functions
%%%
%% Helper music function for defining head-ornementation events
#(define (make-head-ornementation-event text-left text-right is-inside shift-on-line)
"Makes a head ornementation"
(make-music 'HeadOrnementationEvent
'text-left text-left
'text-right text-right
'is-inside is-inside
'shift-when-on-line shift-on-line))
#(define (make-left-head-ornementation-event text is-inside shift-on-line)
"Makes a head ornementation"
(make-head-ornementation-event text #f is-inside shift-on-line))
#(define (make-right-head-ornementation-event text is-inside shift-on-line)
"Makes a head ornementation"
(make-head-ornementation-event #f text is-inside shift-on-line))
%%%
%%% Ornementation definitions
%%%
%% Parenthesis before note head
parb = #(make-left-head-ornementation-event
(markup #:fontsize -4 #:musicglyph "accidentals.leftparen")
#t #f)
%% Parenthesis after note head
para = #(make-right-head-ornementation-event
(markup #:fontsize -4 #:musicglyph "accidentals.rightparen")
#t #f)
%% Parenthesis before and after note head
parc = #(make-head-ornementation-event
(markup #:fontsize -4 #:musicglyph "accidentals.leftparen")
(markup #:fontsize -4 #:musicglyph "accidentals.rightparen")
#t #f)
%% Prall after note head
pralla = #(make-right-head-ornementation-event
(markup #:concat (#:hspace 0.2 #:musicglyph "scripts.prall"))
#t #t)
%% Prall before note head
prallb = #(make-left-head-ornementation-event
(markup #:concat (#:musicglyph "scripts.prall" #:hspace 0.2))
#t #t)
%% ^ sign after note head
circA = #(make-right-head-ornementation-event
(markup #:concat (#:hspace 1 #:raise 0.5 #:musicglyph "scripts.umarcato"))
#f #f)
%%%%%%%%%%%%
%% TEST
%%%%%%%%%%%%
{
a'4.\para gis'8\parb a'2\parc
}
{
a'4.\pralla
gis'8\prallb
\voiceOne
\textLengthOff
%% TODO: DotColumn is moved too much
<>^\markup { \with-color #red \fontsize #4 "!" }
<
gis'
a'
c''\pralla
e''\pralla
>4.
aes'8\prallb
}
{
a'4.\circA a'
}
%% Your example
\markup "\\shape the Slur"
\relative c'' {
g8 a!16 b^( a4.)\parb \prall b8
}
\markup "In my printed edition (Henle Urtext 1956/1984) it looks more like:"
pard = #(make-left-head-ornementation-event
(markup
#:raise 0.3
#:rotate 80
#:concat (
#:fontsize -4 #:musicglyph "accidentals.leftparen"
#:hspace 0.3
#:raise 0.05
#:fontsize -4 #:musicglyph "accidentals.rightparen"
#:hspace -0.4))
#t #f)
\relative c'' {
g8 a!16 b
\override Staff.NoteColumn.X-offset = #0.5
a4.\pard \prall b8
}
po = #(make-left-head-ornementation-event
(markup #:override '(thickness . 2) #:draw-line '(-1 . -0.5))
#t #f)
{
\key ces \major
%\override HeadOrnementation.padding = 25
\override Score.HeadOrnementation.extra-offset = #'(-4.5 . 0)
%\override Score.HeadOrnementation.padding = 3.5
\override Score.HeadOrnementation.color = #red
%\override Score.HeadOrnementation.X-offset = -3.5
<
cis'
eis'\po
gis'
>\arpeggio
}
