X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-markup-commands.scm;h=57e2e8893a26334a2d5af498ba518668b158ed03;hb=a3c3c447d0359c501e8971418f23af38b0fd3117;hp=d5aef111407ef761df49a63e72154294b9cfa883;hpb=a349a341d0ed42002048be28b948c1bb1503bc6b;p=lilypond.git diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index d5aef11140..57e2e8893a 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2000--2012 Han-Wen Nienhuys +;;;; Copyright (C) 2000--2015 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify @@ -115,6 +115,31 @@ empty-interval empty-interval)) (define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; line has to come early since it is often used implicitly from the +;; markup macro since \markup { a b c } -> \markup \line { a b c } +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-markup-command (line layout props args) + (markup-list?) + #:category align + #:properties ((word-space) + (text-direction RIGHT)) + "Put @var{args} in a horizontal line. The property @code{word-space} +determines the space between markups in @var{args}. + +@lilypond[verbatim,quote] +\\markup { + \\line { + one two three + } +} +@end lilypond" + (let ((stencils (interpret-markup-list layout props args))) + (if (= text-direction LEFT) + (set! stencils (reverse stencils))) + (stack-stencil-line word-space stencils))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; geometric shapes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -418,7 +443,7 @@ line thickness and padding around the markup. " @cindex drawing oval around text -Draw a oval around @var{arg}. Use @code{thickness}, +Draw an oval around @var{arg}. Use @code{thickness}, @code{x-padding}, @code{x-padding} and @code{font-size} properties to determine line thickness and padding around the markup. @@ -484,6 +509,16 @@ in the PDF backend. (ly:stencil-add (ly:make-stencil link-expr xextent yextent) stil))) +(define-public (book-first-page layout props) + "Return the @code{'first-page-number} of the entire book" + (define (ancestor layout) + "Return the topmost layout ancestor" + (let ((parent (ly:output-def-parent layout))) + (if (not (ly:output-def? parent)) + layout + (ancestor parent)))) + (ly:output-def-lookup (ancestor layout) 'first-page-number)) + (define-markup-command (with-link layout props label arg) (symbol? markup?) #:category other @@ -503,20 +538,24 @@ only works in the PDF backend. (let* ((arg-stencil (interpret-markup layout props arg)) (x-ext (ly:stencil-extent arg-stencil X)) (y-ext (ly:stencil-extent arg-stencil Y))) - (ly:make-stencil - `(delay-stencil-evaluation - ,(delay (ly:stencil-expr - (let* ((table (ly:output-def-lookup layout 'label-page-table)) - (page-number (if (list? table) - (assoc-get label table) - #f)) - (link-expr (list 'page-link page-number - `(quote ,x-ext) `(quote ,y-ext)))) - (ly:stencil-add (ly:make-stencil link-expr x-ext y-ext) - arg-stencil))))) - x-ext - y-ext))) - + (ly:stencil-add + (ly:make-stencil + `(delay-stencil-evaluation + ,(delay (let* ((table (ly:output-def-lookup layout 'label-page-table)) + (table-page-number + (if (list? table) + (assoc-get label table) + #f)) + (first-page-number (book-first-page layout props)) + (current-page-number + (if table-page-number + (1+ (- table-page-number first-page-number)) + #f))) + (list 'page-link current-page-number + `(quote ,x-ext) `(quote ,y-ext))))) + x-ext + y-ext) + arg-stencil))) (define-markup-command (beam layout props width slope thickness) (number? number? number?) @@ -569,12 +608,12 @@ thickness, and @code{offset} to determine line y-offset. @end lilypond" (let* ((thick (ly:output-def-lookup layout 'line-thickness)) (underline-thick (* thickness thick)) - (markup (interpret-markup layout props arg)) - (x1 (car (ly:stencil-extent markup X))) - (x2 (cdr (ly:stencil-extent markup X))) + (m (interpret-markup layout props arg)) + (x1 (car (ly:stencil-extent m X))) + (x2 (cdr (ly:stencil-extent m X))) (y (* thick (- offset))) (line (make-line-stencil underline-thick x1 y x2 y))) - (ly:stencil-add markup line))) + (ly:stencil-add m line))) (define-markup-command (box layout props arg) (markup?) @@ -683,6 +722,7 @@ Rotate object with @var{ang} degrees around its center. (define-markup-command (whiteout layout props arg) (markup?) #:category other + #:properties ((thickness 3)) " @cindex adding a white background to text @@ -692,10 +732,34 @@ Provide a white background for @var{arg}. \\markup { \\combine \\filled-box #'(-1 . 10) #'(-3 . 4) #1 - \\whiteout whiteout + \\override #'(thickness . 1.5) \\whiteout whiteout } @end lilypond" - (stencil-whiteout (interpret-markup layout props arg))) + (stencil-whiteout + (interpret-markup layout props arg) + (* thickness + (ly:output-def-lookup layout 'line-thickness)))) + +(define-markup-command (whiteout-box layout props arg) + (markup?) + #:category other + #:properties ((thickness 0)) + " +@cindex adding a rectangular white background to text + +Provide a rectangular white background for @var{arg}. + +@lilypond[verbatim,quote] +\\markup { + \\combine + \\filled-box #'(-1 . 10) #'(-3 . 4) #1 + \\override #'(thickness . 1.5) \\whiteout-box whiteout-box +} +@end lilypond" + (stencil-whiteout-box + (interpret-markup layout props arg) + (* thickness + (ly:output-def-lookup layout 'line-thickness)))) (define-markup-command (pad-markup layout props amount arg) (number? markup?) @@ -705,6 +769,7 @@ Provide a white background for @var{arg}. @cindex putting space around text Add space around a markup object. +Identical to @code{pad-around}. @lilypond[verbatim,quote] \\markup { @@ -719,15 +784,11 @@ Add space around a markup object. } } @end lilypond" - (let* - ((stil (interpret-markup layout props arg)) - (xext (ly:stencil-extent stil X)) - (yext (ly:stencil-extent stil Y))) - - (ly:make-stencil - (ly:stencil-expr stil) - (interval-widen xext amount) - (interval-widen yext amount)))) + (let* ((m (interpret-markup layout props arg)) + (x (interval-widen (ly:stencil-extent m X) amount)) + (y (interval-widen (ly:stencil-extent m Y) amount))) + (ly:stencil-add (make-transparent-box-stencil x y) + m))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; space @@ -893,21 +954,11 @@ grestore " @cindex paths, drawing @cindex drawing paths -Draws a path with line thickness @var{thickness} according to the +Draws a path with line @var{thickness} according to the directions given in @var{commands}. @var{commands} is a list of lists where the @code{car} of each sublist is a drawing command and the @code{cdr} comprises the associated arguments for each command. -Line-cap styles and line-join styles may be customized by -overriding the @code{line-cap-style} and @code{line-join-style} -properties, respectively. Available line-cap styles are -@code{'butt}, @code{'round}, and @code{'square}. Available -line-join styles are @code{'miter}, @code{'round}, and -@code{'bevel}. - -The property @code{filled} specifies whether or not the path is -filled with color. - There are seven commands available to use in the list @code{commands}: @code{moveto}, @code{rmoveto}, @code{lineto}, @code{rlineto}, @code{curveto}, @code{rcurveto}, and @@ -930,6 +981,16 @@ current subpath in the active path. Note that a sequence of commands @emph{must} begin with a @code{moveto} or @code{rmoveto} to work with the SVG output. +Line-cap styles and line-join styles may be customized by +overriding the @code{line-cap-style} and @code{line-join-style} +properties, respectively. Available line-cap styles are +@code{'butt}, @code{'round}, and @code{'square}. Available +line-join styles are @code{'miter}, @code{'round}, and +@code{'bevel}. + +The property @code{filled} specifies whether or not the path is +filled with color. + @lilypond[verbatim,quote] samplePath = #'((moveto 0 0) @@ -941,6 +1002,10 @@ samplePath = \\markup { \\path #0.25 #samplePath + + \\override #'(line-join-style . miter) \\path #0.25 #samplePath + + \\override #'(filled . #t) \\path #0.25 #samplePath } @end lilypond" (let* ((half-thickness (/ thickness 2)) @@ -1018,13 +1083,9 @@ samplePath = (define-markup-list-command (score-lines layout props score) (ly:score?) - " -This is the same as the @code{\\score} markup but delivers its -systems as a list of lines. This is not usually called directly by -the user. Instead, it is called when the parser encounters -@code{\\score} in a context where only markup lists are allowed. When -used as the argument of a toplevel @code{\\markuplist}, the result can -be split across pages." + "This is the same as the @code{\\score} markup but delivers its +systems as a list of lines. Its @var{score} argument is entered in +braces like it would be for @code{\\score}." (let ((output (ly:score-embedded-format score layout))) (if (ly:music-output? output) @@ -1136,92 +1197,148 @@ the use of @code{\\simple} is unnecessary. @end lilypond" (interpret-markup layout props str)) -(define-markup-command (tied-lyric layout props str) - (string?) - #:category music - #:properties ((word-space)) - " -@cindex simple text strings with tie characters - -Like simple-markup, but use tie characters for @q{~} tilde symbols. +(define-markup-command (first-visible layout props args) + (markup-list?) + #:category other + "Use the first markup in @var{args} that yields a non-empty stencil +and ignore the rest. @lilypond[verbatim,quote] -\\markup \\column { - \\tied-lyric #\"Siam navi~all'onde~algenti Lasciate~in abbandono\" - \\tied-lyric #\"Impetuosi venti I nostri~affetti sono\" - \\tied-lyric #\"Ogni diletto~e scoglio Tutta la vita~e~un mar.\" +\\markup { + \\first-visible { + \\fromproperty #'header:composer + \\italic Unknown + } } @end lilypond" - (define (replace-ties tie str) - (if (string-contains str "~") - (let* - ((half-space (/ word-space 2)) - (parts (string-split str #\~)) - (tie-str (markup #:hspace half-space - #:musicglyph tie - #:hspace half-space)) - (joined (list-join parts tie-str))) - (make-concat-markup joined)) - str)) - - (define short-tie-regexp (make-regexp "~[^.]~")) - (define (match-short str) (regexp-exec short-tie-regexp str)) - - (define (replace-short str mkp) - (let ((match (match-short str))) - (if (not match) - (make-concat-markup (list - mkp - (replace-ties "ties.lyric.default" str))) - (let ((new-str (match:suffix match)) - (new-mkp (make-concat-markup (list - mkp - (replace-ties "ties.lyric.default" - (match:prefix match)) - (replace-ties "ties.lyric.short" - (match:substring match)))))) - (replace-short new-str new-mkp))))) - - (interpret-markup layout - props - (replace-short str (markup)))) + (define (false-if-empty stencil) + (if (ly:stencil-empty? stencil) #f stencil)) + (or + (any + (lambda (m) + (if (markup? m) + (false-if-empty (interpret-markup layout props m)) + (any false-if-empty (interpret-markup-list layout props (list m))))) + args) + empty-stencil)) (define-public empty-markup (make-simple-markup "")) ;; helper for justifying lines. -(define (get-fill-space word-count line-width word-space text-widths) - "Calculate the necessary paddings between each two adjacent texts. - The lengths of all texts are stored in @var{text-widths}. - The normal formula for the padding between texts a and b is: - padding = line-width/(word-count - 1) - (length(a) + length(b))/2 - The first and last padding have to be calculated specially using the - whole length of the first or last text. - All paddings are checked to be at least word-space, to ensure that - no texts collide. - Return a list of paddings." +(define (get-fill-space + word-count line-width word-space text-widths constant-space?) + "Calculate the necessary paddings between adjacent texts in a +single justified line. The lengths of all texts are stored in +@var{text-widths}. +When @var{constant-space?} is @code{#t}, the formula for the padding +between texts is: +padding = (line-width - total-text-width)/(word-count - 1) +When @var{constant-space?} is @code{#f}, the formula for the +padding between interior texts a and b is: +padding = line-width/(word-count - 1) - (length(a) + length(b))/2 +In this case, the first and last padding have to be calculated +specially using the whole length of the first or last text. +All paddings are checked to be at least word-space, to ensure that +no texts collide. +Return a list of paddings." (cond - ((null? text-widths) '()) - - ;; special case first padding - ((= (length text-widths) word-count) - (cons - (- (- (/ line-width (1- word-count)) (car text-widths)) - (/ (car (cdr text-widths)) 2)) - (get-fill-space word-count line-width word-space (cdr text-widths)))) - ;; special case last padding - ((= (length text-widths) 2) - (list (- (/ line-width (1- word-count)) - (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0)) - (else - (let ((default-padding - (- (/ line-width (1- word-count)) - (/ (+ (car text-widths) (car (cdr text-widths))) 2)))) - (cons - (if (> word-space default-padding) - word-space - default-padding) - (get-fill-space word-count line-width word-space (cdr text-widths))))))) + ((null? text-widths) '()) + (constant-space? + (make-list + (1- word-count) + ;; Ensure that space between words cannot be + ;; less than word-space. + (max + word-space + (/ (- line-width (apply + text-widths)) + (1- word-count))))) + + ;; special case first padding + ((= (length text-widths) word-count) + (cons + (- (- (/ line-width (1- word-count)) (car text-widths)) + (/ (cadr text-widths) 2)) + (get-fill-space + word-count line-width word-space (cdr text-widths) + constant-space?))) + ;; special case last padding + ((= (length text-widths) 2) + (list (- (/ line-width (1- word-count)) + (+ (/ (car text-widths) 2) (cadr text-widths))) + 0)) + (else + (let ((default-padding + (- (/ line-width (1- word-count)) + (/ (+ (car text-widths) (cadr text-widths)) 2)))) + (cons + (if (> word-space default-padding) + word-space + default-padding) + (get-fill-space + word-count line-width word-space (cdr text-widths) + constant-space?)))))) + +(define (justify-line-helper + layout props args text-direction word-space line-width constant-space?) + "Return a stencil which spreads @var{args} along a line of width +@var{line-width}. If @var{constant-space?} is set to @code{#t}, the +space between words is constant. If @code{#f}, the distance between +words varies according to their relative lengths." + (let* ((orig-stencils (interpret-markup-list layout props args)) + (stencils + (map (lambda (stc) + (if (ly:stencil-empty? stc X) + (ly:make-stencil (ly:stencil-expr stc) + '(0 . 0) (ly:stencil-extent stc Y)) + stc)) + orig-stencils)) + (text-widths + (map (lambda (stc) + (interval-length (ly:stencil-extent stc X))) + stencils)) + (text-width (apply + text-widths)) + (word-count (length stencils)) + (line-width (or line-width (ly:output-def-lookup layout 'line-width))) + (fill-space + (cond + ((= word-count 1) + (list + (/ (- line-width text-width) 2) + (/ (- line-width text-width) 2))) + ((= word-count 2) + (list + (- line-width text-width))) + (else + (get-fill-space + word-count line-width word-space text-widths + constant-space?)))) + (line-contents (if (= word-count 1) + (list + point-stencil + (car stencils) + point-stencil) + stencils))) + + (if (null? (remove ly:stencil-empty? orig-stencils)) + empty-stencil + (begin + (if (= text-direction LEFT) + (set! line-contents (reverse line-contents))) + (set! line-contents + (stack-stencils-padding-list + X RIGHT fill-space line-contents)) + (if (> word-count 1) + ;; shift s.t. stencils align on the left edge, even if + ;; first stencil had negative X-extent (e.g. center-column) + ;; (if word-count = 1, X-extents are already normalized in + ;; the definition of line-contents) + (set! line-contents + (ly:stencil-translate-axis + line-contents + (- (car (ly:stencil-extent (car stencils) X))) + X))) + line-contents)))) (define-markup-command (fill-line layout props args) (markup-list?) @@ -1250,79 +1367,28 @@ If there are no arguments, return an empty stencil. } } @end lilypond" - (let* ((orig-stencils (interpret-markup-list layout props args)) - (stencils - (map (lambda (stc) - (if (ly:stencil-empty? stc) - point-stencil - stc)) orig-stencils)) - (text-widths - (map (lambda (stc) - (if (ly:stencil-empty? stc) - 0.0 - (interval-length (ly:stencil-extent stc X)))) - stencils)) - (text-width (apply + text-widths)) - (word-count (length stencils)) - (line-width (or line-width (ly:output-def-lookup layout 'line-width))) - (fill-space - (cond - ((= word-count 1) - (list - (/ (- line-width text-width) 2) - (/ (- line-width text-width) 2))) - ((= word-count 2) - (list - (- line-width text-width))) - (else - (get-fill-space word-count line-width word-space text-widths)))) + (justify-line-helper + layout props args text-direction word-space line-width #f)) - (line-contents (if (= word-count 1) - (list - point-stencil - (car stencils) - point-stencil) - stencils))) - - (if (null? (remove ly:stencil-empty? orig-stencils)) - empty-stencil - (begin - (if (= text-direction LEFT) - (set! line-contents (reverse line-contents))) - (set! line-contents - (stack-stencils-padding-list - X RIGHT fill-space line-contents)) - (if (> word-count 1) - ;; shift s.t. stencils align on the left edge, even if - ;; first stencil had negative X-extent (e.g. center-column) - ;; (if word-count = 1, X-extents are already normalized in - ;; the definition of line-contents) - (set! line-contents - (ly:stencil-translate-axis - line-contents - (- (car (ly:stencil-extent (car stencils) X))) - X))) - line-contents)))) - -(define-markup-command (line layout props args) +(define-markup-command (justify-line layout props args) (markup-list?) #:category align - #:properties ((word-space) - (text-direction RIGHT)) - "Put @var{args} in a horizontal line. The property @code{word-space} -determines the space between markups in @var{args}. + #:properties ((text-direction RIGHT) + (word-space 0.6) + (line-width #f)) + "Put @var{markups} in a horizontal line of width @var{line-width}. +The markups are spread to fill the entire line and separated by equal +space. If there are no arguments, return an empty stencil. @lilypond[verbatim,quote] \\markup { - \\line { - one two three + \\justify-line { + Space between neighboring words is constant } } @end lilypond" - (let ((stencils (interpret-markup-list layout props args))) - (if (= text-direction LEFT) - (set! stencils (reverse stencils))) - (stack-stencil-line word-space stencils))) + (justify-line-helper + layout props args text-direction word-space line-width #t)) (define-markup-command (concat layout props args) (markup-list?) @@ -1375,67 +1441,91 @@ equivalent to @code{\"fi\"}. ;; justify only stretches lines. (* 0.7 base-space) base-space)) - (define (stencil-space stencil line-start) - (if (ly:stencil-empty? stencil X) - 0 - (cdr (ly:stencil-extent - (ly:stencil-stack (if line-start - empty-stencil - point-stencil) - X RIGHT stencil) - X)))) - (define (take-list width space stencils - accumulator accumulated-width) - "Return (head-list . tail) pair, with head-list fitting into width" - (if (null? stencils) - (cons accumulator stencils) - (let* ((first (car stencils)) - (first-wid (stencil-space first (null? accumulator))) - (newwid (+ (if (or (ly:stencil-empty? first Y) - (ly:stencil-empty? first X)) - 0 space) - first-wid accumulated-width))) - (if (or (null? accumulator) - (< newwid width)) - (take-list width space - (cdr stencils) - (cons first accumulator) - newwid) - (cons accumulator stencils))))) - (let loop ((lines '()) - (todo stencils)) - (let* ((line-break (take-list line-width space todo - '() 0.0)) - (line-stencils (car line-break)) - (space-left (- line-width - (stencil-space - (stack-stencil-line 0 line-stencils) - #t))) - (line-words (count (lambda (s) (not (or (ly:stencil-empty? s Y) - (ly:stencil-empty? s X)))) - line-stencils)) - (line-word-space (cond ((not justify) space) - ;; don't stretch last line of paragraph. - ;; hmmm . bug - will overstretch the last line in some case. - ((null? (cdr line-break)) - base-space) - ((< line-words 2) space) - (else (/ space-left (1- line-words))))) - (line (stack-stencil-line line-word-space - (if (= text-dir RIGHT) - (reverse line-stencils) - line-stencils)))) - (if (pair? (cdr line-break)) - (loop (cons line lines) - (cdr line-break)) - (begin - (if (= text-dir LEFT) - (set! line - (ly:stencil-translate-axis - line - (- line-width (interval-end (ly:stencil-extent line X))) - X))) - (reverse (cons line lines))))))) + (define (stencil-len s) + (interval-end (ly:stencil-extent s X))) + (define (maybe-shift line) + (if (= text-dir LEFT) + (ly:stencil-translate-axis + line + (- line-width (stencil-len line)) + X) + line)) + (if (null? stencils) + '() + (let loop ((lines '()) + (todo stencils)) + (let word-loop + ((line (first todo)) + (todo (cdr todo)) + (word-list (list (first todo)))) + (cond + ((pair? todo) + (let ((new (if (= text-dir LEFT) + (ly:stencil-stack (car todo) X RIGHT line space) + (ly:stencil-stack line X RIGHT (car todo) space)))) + (cond + ((<= (stencil-len new) line-width) + (word-loop new (cdr todo) + (cons (car todo) word-list))) + (justify + (let* ((word-list + ;; This depends on stencil stacking being + ;; associative so that stacking + ;; left-to-right and right-to-left leads to + ;; the same result + (if (= text-dir LEFT) + word-list + (reverse! word-list))) + (len (stencil-len line)) + (stretch (- line-width len)) + (spaces + (- (stencil-len + (stack-stencils X RIGHT (1+ space) word-list)) + len))) + (if (zero? spaces) + ;; Uh oh, nothing to fill. + (loop (cons (maybe-shift line) lines) todo) + (loop (cons + (stack-stencils X RIGHT + (+ space (/ stretch spaces)) + word-list) + lines) + todo)))) + (else ;; not justify + (loop (cons (maybe-shift line) lines) todo))))) + ;; todo is null + (justify + ;; Now we have the last line assembled with space + ;; which is compressed. We want to use the + ;; uncompressed version instead if it fits, and the + ;; justified version if it doesn't. + (let* ((word-list + ;; This depends on stencil stacking being + ;; associative so that stacking + ;; left-to-right and right-to-left leads to + ;; the same result + (if (= text-dir LEFT) + word-list + (reverse! word-list))) + (big-line (stack-stencils X RIGHT base-space word-list)) + (big-len (stencil-len big-line)) + (len (stencil-len line))) + (reverse! lines + (list + (if (> big-len line-width) + (stack-stencils X RIGHT + (/ + (+ + (* (- big-len line-width) + space) + (* (- line-width len) + base-space)) + (- big-len len)) + word-list) + (maybe-shift big-line)))))) + (else ;; not justify + (reverse! lines (list (maybe-shift line))))))))) + (define-markup-list-command (wordwrap-internal layout props justify args) (boolean? markup-list?) @@ -1520,7 +1610,7 @@ the line width, where @var{X} is the number of staff spaces. justify word-space line-width text-direction))) list-para-words))) - (apply append para-lines))) + (concatenate para-lines))) (define-markup-command (wordwrap-string layout props arg) (string?) @@ -1650,11 +1740,7 @@ the line width, where @var{X} is the number of staff spaces. Print two markups on top of each other. Note: @code{\\combine} cannot take a list of markups enclosed in -curly braces as an argument; the follow example will not compile: - -@example -\\combine @{ a list @} -@end example +curly braces as an argument; for this purpose use @code{\\overlay} instead. @lilypond[verbatim,quote] \\markup { @@ -1669,6 +1755,27 @@ curly braces as an argument; the follow example will not compile: (s2 (interpret-markup layout props arg2))) (ly:stencil-add s1 s2))) +(define-markup-command (overlay layout props args) + (markup-list?) + #:category align + " +@cindex merging text + +Takes a list of markups combining them. + +@lilypond[verbatim,quote] +\\markup { + \\fontsize #5 + \\override #'(thickness . 2) + \\overlay { + \\draw-line #'(0 . 4) + \\arrow-head #Y #DOWN ##f + \\translate #'(0 . 4)\\arrow-head #Y #UP ##f + } +} +@end lilypond" + (apply ly:stencil-add (interpret-markup-list layout props args))) + ;; ;; TODO: should extract baseline-skip from each argument somehow.. ;; @@ -1965,8 +2072,12 @@ alignment accordingly. @cindex setting extent of text objects Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}." - (let* ((m (interpret-markup layout props arg))) - (ly:make-stencil (ly:stencil-expr m) x y))) + (let* ((expr (ly:stencil-expr (interpret-markup layout props arg)))) + (ly:stencil-add + (make-transparent-box-stencil x y) + (ly:make-stencil + `(delay-stencil-evaluation ,(delay expr)) + x y)))) (define-markup-command (pad-around layout props amount arg) (number? markup?) @@ -1987,11 +2098,10 @@ Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}." } @end lilypond" (let* ((m (interpret-markup layout props arg)) - (x (ly:stencil-extent m X)) - (y (ly:stencil-extent m Y))) - (ly:make-stencil (ly:stencil-expr m) - (interval-widen x amount) - (interval-widen y amount)))) + (x (interval-widen (ly:stencil-extent m X) amount)) + (y (interval-widen (ly:stencil-extent m Y) amount))) + (ly:stencil-add (make-transparent-box-stencil x y) + m))) (define-markup-command (pad-x layout props amount arg) (number? markup?) @@ -2044,7 +2154,7 @@ Add padding @var{amount} around @var{arg} in the X@tie{}direction. (let* ((m (interpret-markup layout props arg)) (x (ly:stencil-extent m X)) (y (ly:stencil-extent m Y))) - (ly:make-stencil "" x y))) + (ly:make-stencil (list 'transparent-stencil (ly:stencil-expr m)) x y))) (define-markup-command (pad-to-box layout props x-ext y-ext arg) (number-pair? number-pair? markup?) @@ -2064,12 +2174,8 @@ Add padding @var{amount} around @var{arg} in the X@tie{}direction. } } @end lilypond" - (let* ((m (interpret-markup layout props arg)) - (x (ly:stencil-extent m X)) - (y (ly:stencil-extent m Y))) - (ly:make-stencil (ly:stencil-expr m) - (interval-union x-ext x) - (interval-union y-ext y)))) + (ly:stencil-add (make-transparent-box-stencil x-ext y-ext) + (interpret-markup layout props arg))) (define-markup-command (hcenter-in layout props length arg) (number? markup?) @@ -2353,7 +2459,7 @@ may be any property supported by @rinternals{font-interface}, (define-markup-command (abs-fontsize layout props size arg) (number? markup?) #:category font - "Use @var{size} as the absolute font size to display @var{arg}. + "Use @var{size} as the absolute font size (in points) to display @var{arg}. Adjusts @code{baseline-skip} and @code{word-space} accordingly. @lilypond[verbatim,quote] @@ -2971,6 +3077,56 @@ Draw @var{arg} in color specified by @var{color}. (ly:stencil-extent stil X) (ly:stencil-extent stil Y)))) +(define-markup-command (tied-lyric layout props str) + (string?) + #:category music + #:properties ((word-space)) + " +@cindex simple text strings with tie characters + +Like simple-markup, but use tie characters for @q{~} tilde symbols. + +@lilypond[verbatim,quote] +\\markup \\column { + \\tied-lyric #\"Siam navi~all'onde~algenti Lasciate~in abbandono\" + \\tied-lyric #\"Impetuosi venti I nostri~affetti sono\" + \\tied-lyric #\"Ogni diletto~e scoglio Tutta la vita~e~un mar.\" +} +@end lilypond" + (define (replace-ties tie str) + (if (string-contains str "~") + (let* + ((half-space (/ word-space 2)) + (parts (string-split str #\~)) + (tie-str (markup #:hspace half-space + #:musicglyph tie + #:hspace half-space)) + (joined (list-join parts tie-str))) + (make-concat-markup joined)) + str)) + + (define short-tie-regexp (make-regexp "~[^.]~")) + (define (match-short str) (regexp-exec short-tie-regexp str)) + + (define (replace-short str mkp) + (let ((match (match-short str))) + (if (not match) + (make-concat-markup (list + mkp + (replace-ties "ties.lyric.default" str))) + (let ((new-str (match:suffix match)) + (new-mkp (make-concat-markup (list + mkp + (replace-ties "ties.lyric.default" + (match:prefix match)) + (replace-ties "ties.lyric.short" + (match:substring match)))))) + (replace-short new-str new-mkp))))) + + (interpret-markup layout + props + (replace-short str (markup)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; glyphs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3300,8 +3456,8 @@ A feta brace in point size @var{size}, rotated 180 degrees. Construct a note symbol, with stem and flag. By using fractional values for @var{dir}, longer or shorter stems can be obtained. Supports all note-head-styles. -Supported flag-styles are @code{default}, @code{old-straight-flag} and -@code{modern-straight-flag}. +Supported flag-styles are @code{default}, @code{old-straight-flag}, +@code{modern-straight-flag} and @code{flat-flag}. @lilypond[verbatim,quote] \\markup { @@ -3362,27 +3518,24 @@ Supported flag-styles are @code{default}, @code{old-straight-flag} and (raw-length (if stem-up upflag-length downflag-length)) (angle (if stem-up upflag-angle downflag-angle)) (flag-length (+ (* raw-length factor) half-stem-thickness)) - (flag-end (polar->rectangular flag-length angle)) + (flag-end (if (= angle 0) + (cons flag-length (* half-stem-thickness dir)) + (polar->rectangular flag-length angle))) (thickness (* flag-thickness factor)) (thickness-offset (cons 0 (* -1 thickness dir))) (spacing (* -1 flag-spacing factor dir)) (start (cons (- half-stem-thickness) (* half-stem-thickness dir))) - ;; The points of a round-filled-polygon need to be given in - ;; clockwise order, otherwise the polygon will be enlarged by - ;; blot-size*2! - (points (if stem-up (list start flag-end - (offset-add flag-end thickness-offset) - (offset-add start thickness-offset)) - (list start - (offset-add start thickness-offset) - (offset-add flag-end thickness-offset) - flag-end))) + (points (list start + flag-end + (offset-add flag-end thickness-offset) + (offset-add start thickness-offset))) (stencil (ly:round-filled-polygon points half-stem-thickness)) ;; Log for 1/8 is 3, so we need to subtract 3 (flag-stencil (buildflags stencil (- log 3) stencil spacing))) flag-stencil)) - (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) + (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic) + (font-name . #f)) props))) (size-factor (magstep font-size)) (blot (ly:output-def-lookup layout 'blot-diameter)) @@ -3437,10 +3590,12 @@ Supported flag-styles are @code{default}, @code{old-straight-flag} and ;; Straight-flags. Values taken from /scm/flag-style.scm (modern-straight-flag (straight-flag-mrkp 0.55 1 -18 1.1 22 1.2 dir)) (old-straight-flag (straight-flag-mrkp 0.55 1 -45 1.2 45 1.4 dir)) + (flat-flag (straight-flag-mrkp 0.55 1.0 0 1.0 0 1.0 dir)) ;; Calculate a corrective to avoid a gap between ;; straight-flags and the stem. (flag-style-Y-corr (if (or (eq? flag-style 'modern-straight-flag) - (eq? flag-style 'old-straight-flag)) + (eq? flag-style 'old-straight-flag) + (eq? flag-style 'flat-flag)) (/ blot 10 (* -1 dir)) 0)) (flaggl (and (> log 2) @@ -3449,6 +3604,8 @@ Supported flag-styles are @code{default}, @code{old-straight-flag} and modern-straight-flag) ((eq? flag-style 'old-straight-flag) old-straight-flag) + ((eq? flag-style 'flat-flag) + flat-flag) (else (ly:font-get-glyph font (format #f (if ancient-flags? @@ -3594,7 +3751,9 @@ A rest or multi-measure-rest symbol. (let* ((font (ly:paper-get-font layout - (cons '((font-encoding . fetaMusic)) props))) + (cons '((font-encoding . fetaMusic) + (font-name . #f)) + props))) (rest-glyph-name (let ((result (get-glyph-name font @@ -3802,7 +3961,7 @@ an inverted glyph. Note that within music, one would usually use the @code{\\fermata} articulation instead of a markup. @lilypond[verbatim,quote] - { c1^\\markup \\fermata d1_\\markup \\fermata } + { c''1^\\markup \\fermata d''1_\\markup \\fermata } \\markup { \\fermata \\override #`(direction . ,DOWN) \\fermata } @end lilypond @@ -3811,7 +3970,7 @@ an inverted glyph. Note that within music, one would usually use the (if (eqv? direction DOWN) (markup #:musicglyph "scripts.dfermata") (markup #:musicglyph "scripts.ufermata")))) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; translating. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3931,7 +4090,7 @@ Make a fraction of two markups. (define-markup-command (normal-size-super layout props arg) (markup?) #:category font - #:properties ((baseline-skip)) + #:properties ((font-size 0)) " @cindex setting superscript in standard font size @@ -3947,13 +4106,12 @@ Set @var{arg} in superscript with a normal font size. @end lilypond" (ly:stencil-translate-axis (interpret-markup layout props arg) - (* 0.5 baseline-skip) Y)) + (* 1.0 (magstep font-size)) Y)) (define-markup-command (super layout props arg) (markup?) #:category font - #:properties ((font-size 0) - (baseline-skip)) + #:properties ((font-size 0)) " @cindex superscript text @@ -3974,7 +4132,7 @@ Set @var{arg} in superscript. layout (cons `((font-size . ,(- font-size 3))) props) arg) - (* 0.5 baseline-skip) + (* 1.0 (magstep font-size)) ; original font-size Y)) (define-markup-command (translate layout props offset arg) @@ -3999,8 +4157,7 @@ is a pair of numbers representing the displacement in the X and Y axis. (define-markup-command (sub layout props arg) (markup?) #:category font - #:properties ((font-size 0) - (baseline-skip)) + #:properties ((font-size 0)) " @cindex subscript text @@ -4022,13 +4179,13 @@ Set @var{arg} in subscript. layout (cons `((font-size . ,(- font-size 3))) props) arg) - (* -0.5 baseline-skip) + (* -0.75 (magstep font-size)) ; original font-size Y)) (define-markup-command (normal-size-sub layout props arg) (markup?) #:category font - #:properties ((baseline-skip)) + #:properties ((font-size 0)) " @cindex setting subscript in standard font size @@ -4044,7 +4201,7 @@ Set @var{arg} in subscript with a normal font size. @end lilypond" (ly:stencil-translate-axis (interpret-markup layout props arg) - (* -0.5 baseline-skip) + (* -0.75 (magstep font-size)) Y)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -4125,7 +4282,7 @@ a column containing several lines of text. } } @end lilypond" - (let* ((markup (interpret-markup layout props arg)) + (let* ((m (interpret-markup layout props arg)) (scaled-width (* size width)) (scaled-thickness (* (chain-assoc-get 'line-thickness props 0.1) @@ -4135,7 +4292,7 @@ a column containing several lines of text. (* (/ 4 3.0) scaled-width))) (padding (chain-assoc-get 'padding props half-thickness))) (parenthesize-stencil - markup half-thickness scaled-width angularity padding))) + m half-thickness scaled-width angularity padding))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -4151,10 +4308,16 @@ a column containing several lines of text. Reference to a page number. @var{label} is the label set on the referenced page (using the @code{\\label} command), @var{gauge} a markup used to estimate the maximum width of the page number, and @var{default} the value to display -when @var{label} is not found." +when @var{label} is not found. + +(If the current book or bookpart is set to use roman numerals for page numbers, +the reference will be formatted accordingly -- in which case the @var{gauge}'s +width may require additional tweaking.)" (let* ((gauge-stencil (interpret-markup layout props gauge)) (x-ext (ly:stencil-extent gauge-stencil X)) (y-ext (ly:stencil-extent gauge-stencil Y))) + (ly:stencil-add + (make-transparent-box-stencil x-ext y-ext)) (ly:make-stencil `(delay-stencil-evaluation ,(delay (ly:stencil-expr @@ -4162,7 +4325,10 @@ when @var{label} is not found." (page-number (if (list? table) (assoc-get label table) #f)) - (page-markup (if page-number (format #f "~a" page-number) default)) + (number-type (ly:output-def-lookup layout 'page-number-type)) + (page-markup (if page-number + (number-format number-type page-number) + default)) (page-stencil (interpret-markup layout props page-markup)) (gap (- (interval-length x-ext) (interval-length (ly:stencil-extent page-stencil X)))))