On 2018-10-30 4:56 pm, Aaron Hill wrote:
On 2018-10-30 10:01 am, Alexander Kobel wrote:
Does anyone have a hint how to approach this one? (Or is the answer
just: be patient and hope for Guile v2?)
The only hint here is to replace the built-in functions with ones
which understand UTF8 encoding and can perform the work needed. There
very well might be someone online who has already done this work,
which would save on having to do it yourself.
Otherwise, the basic strategy is to replace string->list with a
version that decodes UTF8 and returns a list of integers (essentially
UTF32). Then, all of the string work is being done with these lists
of integers instead. (The character set would also just be a set of
integers representing the unique Unicode code points.) After you find
the subsets of the list that are interesting to measure, you'll then
need to convert the list back into a string. This means encoding back
into UTF8 and emitting a string.
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 { Å Ɓ† «Ḉ…» }
%%%%
-- 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 (take-while (lambda (x) (not (is-space? x)))
(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
