On 2018-10-30 9:23 pm, Aaron Hill wrote:
Here's a quick-n-dirty patch to address the issue.
%%%%
\version "2.19.82"
\include "center-lyrics-ignoring-punctuation.ily"
{ d'4 4 4 }
\addlyrics { Å Ɓ† «Ḉ…» }
%%%%
Agh, I goofed. I forgot the logic is that you want to trim the "space"
characters from the ends only. Anything included within the "word" is
okay.
So with two drop-whiles and reverses, here's the patch to my patch,
including a new test document:
%%%%
\version "2.19.82"
\include "center-lyrics-ignoring-punctuation.ily"
{ d'4 4 4 4 }
\addlyrics { Å Ɓ† «Ḉ…» ?Ḓ—Ḛ }
%%%%
-- Aaron Hill\version "2.19.50" %% and higher
%% https://lists.gnu.org/archive/html/lilypond-user/2016-12/msg00382.html
%% http://lsr.di.unimi.it/LSR/Item?id=888
%% Including UTF8 workaround - see the following...
%% http://lists.gnu.org/archive/html/lilypond-user/2018-10/msg00468.html
#(define (utf8->utf32 lst)
"Converts a list of UTF8-encoded characters into UTF32."
(if (null? lst) '()
(let ((ch (char->integer (car lst))))
(cond
;; Characters 0x00-0x7F
((< ch #b10000000) (cons ch (utf8->utf32 (cdr lst))))
;; Characters 0x80-0x7FF
((eqv? (logand ch #b11100000) #b11000000)
(cons (let ((ch2 (char->integer (cadr lst))))
(logior (ash (logand ch #b11111) 6)
(logand ch2 #b111111)))
(utf8->utf32 (cddr lst))))
;; Characters 0x800-0xFFFF
((eqv? (logand ch #b11110000) #b11100000)
(cons (let ((ch2 (char->integer (cadr lst)))
(ch3 (char->integer (caddr lst))))
(logior (ash (logand ch #b1111) 12)
(ash (logand ch2 #b111111) 6)
(logand ch3 #b111111)))
(utf8->utf32 (cdddr lst))))
;; Characters 0x10000-0x10FFFF
((eqv? (logand ch #b111110000) #b11110000)
(cons (let ((ch2 (char->integer (cadr lst)))
(ch3 (char->integer (caddr lst)))
(ch4 (char->integer (cadddr lst))))
(logior (ash (logand ch #b111) 18)
(ash (logand ch2 #b111111) 12)
(ash (logand ch3 #b111111) 6)
(logand ch4 #b111111)))
(utf8->utf32 (cddddr lst))))
;; Ignore orphaned continuation characters
((eqv? (logand ch #b11000000) #b10000000) (utf8->utf32 (cdr lst)))
;; Error on all else
(else (error "Unexpected character:" ch))))))
#(define (utf32->utf8 lst)
"Converts a list of UTF32-encoded characters into UTF8."
(if (null? lst) '()
(let ((ch (car lst)))
(append (cond
;; Characters 0x00-0x7F
((< ch #x80) (list (integer->char ch)))
;; Characters 0x80-0x7FF
((< ch #x800) (list
(integer->char (logior #b11000000 (logand (ash ch -6) #b11111)))
(integer->char (logior #b10000000 (logand ch #b111111)))))
;; Characters 0x800-0xFFFF
((< ch #x10000) (list
(integer->char (logior #b11100000 (logand (ash ch -12) #b1111)))
(integer->char (logior #b10000000 (logand (ash ch -6) #b111111)))
(integer->char (logior #b10000000 (logand ch #b111111)))))
;; Characters 0x10000-0x10FFFF
(else (list
(integer->char (logior #b11110000 (logand (ash ch -18) #b111)))
(integer->char (logior #b10000000 (logand (ash ch -12) #b111111)))
(integer->char (logior #b10000000 (logand (ash ch -6) #b111111)))
(integer->char (logior #b10000000 (logand ch #b111111))))))
(utf32->utf8 (cdr lst))))))
#(define (string->utf32 s) (utf8->utf32 (string->list s)))
#(define (utf32->string l) (list->string (utf32->utf8 l)))
#(define space-set (string->utf32
".?-;,:ââââ«»â¹âºããããââââââ
*/()[]{}|<>!`~&â¦â â¡"))
#(define (is-space? x) (member x space-set))
#(define (width grob text)
(let* ((X-extent
(ly:stencil-extent (grob-interpret-markup grob text) X)))
(if (interval-empty? X-extent)
0
(cdr X-extent))))
#(define (remove-suspended-note-heads stem note-heads)
(let* ((nc (ly:grob-common-refpoint stem (car note-heads) X))
(stem-coord
(ly:grob-relative-coordinate stem stem X))
(half-stem-thick
(/ (ly:grob-property stem 'thickness) 2))
(stem-dir (ly:grob-property stem 'direction)))
(remove
(lambda (nh)
(if (positive? stem-dir)
(> (ly:grob-relative-coordinate nh nc X)
stem-coord)
(< (ly:grob-relative-coordinate nh nc X)
(- stem-coord half-stem-thick))))
note-heads)))
#(define (make-center-on-word-callback grob center-on-chords)
(let* ((text (ly:grob-property-data grob 'text))
(syllable (markup->string text))
(utf32 (string->utf32 syllable))
(preword (utf32->string (take-while is-space? utf32)))
(word (utf32->string (reverse (drop-while is-space?
(reverse (drop-while is-space? utf32))))))
(preword-width (width grob preword))
(word-width (width grob (if (string-null? syllable) text word)))
(note-column (ly:grob-parent grob X))
(stem (ly:grob-object note-column 'stem))
(stem-dir (ly:grob-property stem 'direction))
(sys (ly:grob-system grob))
(nh-ls
(if (ly:grob-array? (ly:grob-object note-column 'note-heads))
(ly:grob-array->list (ly:grob-object note-column 'note-heads))
'()))
(full-column-width
(interval-length (ly:relative-group-extent nh-ls note-column X)))
(note-column-width
(interval-length
(ly:relative-group-extent
(remove-suspended-note-heads stem nh-ls) note-column X))))
(-
(*
(/ (if center-on-chords
(if (positive? stem-dir)
(- full-column-width word-width)
(- (* 2 note-column-width) full-column-width word-width))
(- note-column-width word-width))
2)
(1+ (ly:grob-property-data grob 'self-alignment-X)))
preword-width)))
#(define (center-on-word grob) (make-center-on-word-callback grob #f))
#(define (center-on-word-on-chords grob) (make-center-on-word-callback grob #t))
\layout {
\context {
\Lyrics
\override LyricText #'X-offset = #center-on-word-on-chords
}
}
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
