[prev in list] [next in list] [prev in thread] [next in thread]
List: lilypond-bug
Subject: Fwd: scheme spanner in input/regression/scheme-text-spanner.ly not quote-proof
From: Reinhold Kainhofer <reinhold () kainhofer ! com>
Date: 2012-07-30 14:19:31
Message-ID: 501697F3.7070804 () kainhofer ! com
[Download RAW message or body]
According to David's response (which I will also forward from -devel),
the problem is that the addQuote (and the part-combiner) use a Global
context from the moment the part-combiner is initialized rather than
when addQuote is called. Thus the Global context is missing information
about the new grob...
We had a similar problem with the RemoveEmptyStaff context, which we
fixed by turning it into a context mod instead, which can later be
inserted into the current context. I suppose a similar solution could
fix this problem, too.
Cheers,
Reinhold
-------- Original Message --------
Subject: scheme spanner in input/regression/scheme-text-spanner.ly not
quote-proof
Date: Thu, 26 Jul 2012 20:10:13 +0200
From: Reinhold Kainhofer <reinhold@kainhofer.com>
Organization: FAM, TU Wien
To: LilyPond Development <lilypond-devel@gnu.org>
The text spanner implemented in scheme (which is also used as a basis
for David's measure counter engraver) seems to work fine in the regtest,
but apparently it is not quote-proof.
In particular, if you try call \addQuote on some music that contains
\schemeTextSpannerStart or \schemeTextSpannerEnd, then you get the
following warnings and the text spanner is not quoted:
scheme-text-spanner.ly:210:5: warning: Event class should be a list
a4
b\schemeTextSpannerStart c d |
scheme-text-spanner.ly:212:7: warning: Event class should be a list
a4 b
c\schemeTextSpannerEnd d |
So apparently the scheme way to add new event classes is not entirely
correct...
Sample file (regtest adapted to quote the music) is attached.
Any idea about the correct fix to this?
Thanks,
Reinhold
--
------------------------------------------------------------------
Reinhold Kainhofer, reinhold@kainhofer.com, http://www.kainhofer.com
* Financial & Actuarial Math., Vienna Univ. of Technology, Austria
* http://www.fam.tuwien.ac.at/, DVR: 0005886
* Edition Kainhofer, Music Publisher, http://www.edition-kainhofer.com
["scheme-text-spanner.ly" (text/x-lilypond)]
\version "2.15.31"
\header {
texidoc = "Use @code{define-event-class}, scheme engraver methods,
and grob creation methods to create a fully functional text spanner
in scheme."
}
#(define my-grob-descriptions '())
#(define my-event-classes (ly:make-context-mod))
defineEventClass =
#(define-void-function (parser location class parent)
(symbol? symbol?)
(ly:add-context-mod
my-event-classes
`(apply
,(lambda (context class parent)
(ly:context-set-property!
context
'EventClasses
(event-class-cons
class
parent
(ly:context-property context 'EventClasses '()))))
,class ,parent)))
\defineEventClass #'scheme-text-span-event #'span-event
#(define (add-grob-definition grob-name grob-entry)
(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? list?)
(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! my-grob-descriptions
(cons (cons grob-name grob-entry)
my-grob-descriptions))))
#(add-grob-definition
'SchemeTextSpanner
`(
(bound-details . ((left . ((Y . 0)
(padding . 0.25)
(attach-dir . ,LEFT)
))
(left-broken . ((end-on-note . #t)))
(right . ((Y . 0)
(padding . 0.25)
))
))
(dash-fraction . 0.2)
(dash-period . 3.0)
(direction . ,UP)
(font-shape . italic)
(left-bound-info . ,ly:line-spanner::calc-left-bound-info)
(outside-staff-priority . 350)
(right-bound-info . ,ly:line-spanner::calc-right-bound-info)
(staff-padding . 0.8)
(stencil . ,ly:line-spanner::print)
(style . dashed-line)
(meta . ((class . Spanner)
(interfaces . (font-interface
line-interface
line-spanner-interface
side-position-interface))))))
#(define scheme-event-spanner-types
'(
(SchemeTextSpanEvent
. ((description . "Used to signal where scheme text spanner brackets
start and stop.")
(types . (general-music scheme-text-span-event span-event event))
))
))
#(set!
scheme-event-spanner-types
(map (lambda (x)
(set-object-property! (car x)
'music-description
(cdr (assq 'description (cdr x))))
(let ((lst (cdr x)))
(set! lst (assoc-set! lst 'name (car x)))
(set! lst (assq-remove! lst 'description))
(hashq-set! music-name-to-property-table (car x) lst)
(cons (car x) lst)))
scheme-event-spanner-types))
#(set! music-descriptions
(append scheme-event-spanner-types music-descriptions))
#(set! music-descriptions
(sort music-descriptions alist<?))
#(define (add-bound-item spanner item)
(if (null? (ly:spanner-bound spanner LEFT))
(ly:spanner-set-bound! spanner LEFT item)
(ly:spanner-set-bound! spanner RIGHT item)))
#(define (axis-offset-symbol axis)
(if (eq? axis X) 'X-offset 'Y-offset))
#(define (set-axis! grob axis)
(if (not (number? (ly:grob-property grob 'side-axis)))
(begin
(set! (ly:grob-property grob 'side-axis) axis)
(ly:grob-chain-callback
grob
(if (eq? axis X)
ly:side-position-interface::x-aligned-side
ly:side-position-interface::y-aligned-side)
(axis-offset-symbol axis)))))
schemeTextSpannerEngraver =
#(lambda (context)
(let ((span '())
(finished '())
(current-event '())
(event-drul '(() . ())))
(make-engraver
(listeners ((scheme-text-span-event engraver event)
(if (= START (ly:event-property event 'span-direction))
(set-car! event-drul event)
(set-cdr! event-drul event))))
(acknowledgers ((note-column-interface engraver grob source-engraver)
(if (ly:spanner? span)
(begin
(ly:pointer-group-interface::add-grob span 'note-columns grob)
(add-bound-item span grob)))
(if (ly:spanner? finished)
(begin
(ly:pointer-group-interface::add-grob finished 'note-columns grob)
(add-bound-item finished grob)))))
((process-music trans)
(if (ly:stream-event? (cdr event-drul))
(if (null? span)
(ly:warning "You're trying to end a scheme text spanner but you haven't started one.")
(begin (set! finished span)
(ly:engraver-announce-end-grob trans finished current-event)
(set! span '())
(set! current-event '())
(set-cdr! event-drul '()))))
(if (ly:stream-event? (car event-drul))
(begin (set! current-event (car event-drul))
(set! span (ly:engraver-make-grob trans 'SchemeTextSpanner current-event))
(set-axis! span Y)
(set-car! event-drul '()))))
((stop-translation-timestep trans)
(if (and (ly:spanner? span)
(null? (ly:spanner-bound span LEFT)))
(set! (ly:spanner-bound span LEFT)
(ly:context-property context 'currentMusicalColumn)))
(if (ly:spanner? finished)
(begin
(if (null? (ly:spanner-bound finished RIGHT))
(set! (ly:spanner-bound finished RIGHT)
(ly:context-property context 'currentMusicalColumn)))
(set! finished '())
(set! event-drul '(() . ())))))
((finalize trans)
(if (ly:spanner? finished)
(begin
(if (null? (ly:spanner-bound finished RIGHT))
(set! (ly:spanner-bound finished RIGHT)
(ly:context-property context 'currentMusicalColumn)))
(set! finished '())))
(if (ly:spanner? span)
(begin
(ly:warning "I think there's a dangling scheme text spanner :-(")
(ly:grob-suicide! span)
(set! span '())))))))
schemeTextSpannerStart =
#(make-span-event 'SchemeTextSpanEvent START)
schemeTextSpannerEnd =
#(make-span-event 'SchemeTextSpanEvent STOP)
\layout {
\context {
\Global
\grobdescriptions #my-grob-descriptions
#my-event-classes
}
\context {
\Voice
\consists \schemeTextSpannerEngraver
}
}
m=\relative c' {
a4 b \schemeTextSpannerStart c d |
a4 b c \schemeTextSpannerEnd d |
}
\addQuote "m" \m
\new StaffGroup <<
\new Staff \m
\new Staff \relative c' {
r4 \quoteDuring #"m" { s2. s1 }
}
>>
["Attached Message Part" (text/plain)]
_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-devel
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic