On 2020-09-28 10:43 pm, Andrew Bernard wrote:
Since these markings would presumably be infrequent in your scores,
sticking with dots for the moment, you could always make a markup
consisting of the character in a column with a dot/etc glyph. Roll
your own. Tedious yes. You could write a markup function to do it (ask
me, if you think this is viable). In fact, I can't think of any other
way of doing it at the moment.
I could not resist. (:
The new \text-emphasis markup command mostly maps to the CSS style of
the same name but does not have full feature parity. Of note, the
markup command will apply the emphasis mark to any character, whereas
the CSS standard says to omit marks for certain character classes (Z*
and P*, in particular).
Usage should be straightforward:
%%%%
\markup \concat { これは \text-emphasis 日本語 の文章です。 }
%%%%
Attached you will find a more complex series of tests and usage
examples.
(I had to include my UTF8 string splitting code in order to handle CJK
characters properly, so you will need to scroll down a bit to get to the
markup command itself.)
-- Aaron Hill
\version "2.20.0"
#(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-markup-command
(text-emphasis layout props arg)
(markup?)
#:properties ((style 'dot)
(filled #f)
(position 'over)
(mark-color #f)
(mark-size -6)
(mark-padding 0.2)
(mark-offset 0))
(define (mark-char)
(case style
((dot) (if filled #x2022 #x25e6))
((circle) (if filled #x25cf #x25cb))
((double-circle) (if filled #x25c9 #x25ce))
((triangle) (if filled #x25b2 #x25b3))
((sesame) (if filled #xfe45 #xfe46))
(else
(if (string? style)
(first (string->utf32 style))
(ly:error "text-emphasis: unknown style ~s" style)))))
(if (list? arg)
(set! arg
(let loop ((m arg))
(cond ((null? m) '())
((list? m) (map loop m))
((string? m) (list text-emphasis-markup m))
(else m)))))
(if (string? arg)
(let* ((mark (mark-char))
(elems (map (lambda (u) (utf32->string (list u)))
(string->utf32 arg)))
(stens (map (lambda (e) (interpret-markup layout props e))
elems))
(ctr-axis (case position ((over under) X) ((left right) Y)))
(ctr-exts (map (lambda (s) (ly:stencil-extent s ctr-axis))
stens))
(ctrs (map (lambda (i) (interval-index i CENTER))
ctr-exts))
(off-axis (case position ((over under) Y) ((left right) X)))
(off-dir (case position ((over right) UP) ((under left) DOWN)))
(off-sel (if (> 0 off-dir) car cdr))
(off-cmp (if (> 0 off-dir) min max))
(off-exts (map (lambda (s)
(off-sel (ly:stencil-extent s off-axis)))
stens))
(off (off-cmp (+ (* off-dir mark-padding)
(apply off-cmp off-exts))
mark-offset)))
(set! mark
(list fontsize-markup mark-size
(list upright-markup
(list medium-markup
(list char-markup mark)))))
(if (color? mark-color)
(set! mark (list with-color-markup mark-color mark)))
(set! elems
(map (lambda (elem ctr)
(list combine-markup elem
(list translate-markup
((if (eq? X off-axis) cons xcons) off ctr)
(list general-align-markup
off-axis (- off-dir)
(list general-align-markup
ctr-axis CENTER mark)))))
elems ctrs))
(set! arg (list concat-markup elems))))
(interpret-markup layout props arg))
\markup {
\vcenter
\override #'(baseline-skip . 3.6)
\column {
\line {
\text-emphasis qxb
\box \huge \bold \text-emphasis qxb
\text-emphasis \concat \circle \teeny \italic { q x b }
\override #'(filled . #t)
\override #'(style . circle)
\override #'(mark-padding . 1)
\text-emphasis { _ . : | }
\override #'(style . "ð¤")
\override #'(mark-size . -3)
\override #'(mark-offset . 2)
\text-emphasis { | : . _ }
}
\override #'(filled . #t)
\override #'(style . triangle)
\override #'(position . under)
\override #'(mark-color . (0.2 0.4 1))
\concat { çä¾ï¼ä»å½·ä½ç¨ \text-emphasis ä¸åé»ç¼ç ç§èã }
}
\vcenter
\override #'(baseline-skip . 2.4)
\override #'(position . right)
\override #'(mark-padding . 0)
\column {
\text-emphasis { ã ã } ã
\override #'(filled . #t)
\override #'(style . sesame)
\override #'(mark-size . -3)
\text-emphasis { 強 調 }
}
}
