X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-markup-commands.scm;h=f4cf31dd3b647910eb84aed42a2ecc0e68bde82a;hb=b3441482bcd6dc5fbef25df7507ba15e1aa887c6;hp=8d4d749770d129975a80113fce9fee9c9d6b5454;hpb=84a060da34d365db97ceade2d87f7bc961b9b7b7;p=lilypond.git diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm old mode 100644 new mode 100755 index 8d4d749770..f4cf31dd3b --- 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--2010 Han-Wen Nienhuys +;;;; Copyright (C) 2000--2012 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify @@ -45,30 +45,22 @@ ;;; using `chain-assoc-get' (more on that below) ;;; ;;; args... -;;; the command arguments. There are restrictions on the -;;; possible arguments for a markup command. -;;; First, arguments are distinguished according to their type: -;;; 1) a markup (or a string), corresponding to type predicate `markup?' -;;; 2) a list of markups, corresponding to type predicate `markup-list?' -;;; 3) any scheme object, corresponding to type predicates such as -;;; `list?', 'number?', 'boolean?', etc. -;;; The supported arrangements of arguments, according to their type, are: -;;; - no argument -;;; - markup -;;; - scheme -;;; - markup, markup -;;; - markup-list -;;; - scheme, scheme -;;; - scheme, markup -;;; - scheme, scheme, markup -;;; - scheme, scheme, markup, markup -;;; - scheme, markup, markup -;;; - scheme, scheme, scheme -;;; This combinations are hard-coded in the lexer and in the parser -;;; (lily/lexer.ll and lily/parser.yy) +;;; the command arguments. +;;; There is no limitation on the order of command arguments. +;;; However, markup functions taking a markup as their last +;;; argument are somewhat special as you can apply them to a +;;; markup list, and the result is a markup list where the +;;; markup function (with the specified leading arguments) has +;;; been applied to every element of the original markup list. +;;; +;;; Since replicating the leading arguments for applying a +;;; markup function to a markup list is cheap mostly for +;;; Scheme arguments, you avoid performance pitfalls by just +;;; using Scheme arguments for the leading arguments of markup +;;; functions that take a markup as their last argument. ;;; ;;; args-signature -;;; the arguments signature, i.e. a list of type predicates which +;;; the arguments signature, i.e., a list of type predicates which ;;; are used to type check the arguments, and also to define the general ;;; argument types (markup, markup-list, scheme) that the command is ;;; expecting. @@ -77,19 +69,19 @@ ;;; ;;; category ;;; for documentation purpose, builtin markup commands are grouped by -;;; category. This can be any symbol. When documentation is generated, +;;; category. This can be any symbol. When documentation is generated, ;;; the symbol is converted to a capitalized string, where hyphens are ;;; replaced by spaces. ;;; ;;; property-bindings ;;; this is used both for documentation generation, and to ease -;;; programming the command itself. It is list of +;;; programming the command itself. It is list of ;;; (property-name default-value) ;;; or (property-name) -;;; elements. Each property is looked-up in the `props' argument, and +;;; elements. Each property is looked-up in the `props' argument, and ;;; the symbol naming the property is bound to its value. ;;; When the property is not found in `props', then the symbol is bound -;;; to the given default value. When no default value is given, #f is +;;; to the given default value. When no default value is given, #f is ;;; used instead. ;;; Thus, using the following property bindings: ;;; ((thickness 0.1) @@ -100,15 +92,15 @@ ;;; ..body..) ;;; When a command `B' internally calls an other command `A', it may ;;; desirable to see in `B' documentation all the properties and -;;; default values used by `A'. In that case, add `A-markup' to the -;;; property-bindings of B. (This is used when generating +;;; default values used by `A'. In that case, add `A-markup' to the +;;; property-bindings of B. (This is used when generating ;;; documentation, but won't create bindings.) ;;; ;;; documentation-string ;;; the command documentation string (used to generate manuals) ;;; ;;; body -;;; the command body. The function is supposed to return a stencil. +;;; the command body. The function is supposed to return a stencil. ;;; ;;; Each markup command definition shall have a documentation string ;;; with description, syntax and example. @@ -147,6 +139,173 @@ A simple line. (y (cdr dest))) (make-line-stencil th 0 0 x y))) +(define-markup-command (draw-dashed-line layout props dest) + (number-pair?) + #:category graphic + #:properties ((thickness 1) + (on 1) + (off 1) + (phase 0) + (full-length #t)) + " +@cindex drawing dashed lines within text + +A dashed line. + +If @code{full-length} is set to #t (default) the dashed-line extends to the +whole length given by @var{dest}, without white space at beginning or end. +@code{off} will then be altered to fit. +To insist on the given (or default) values of @code{on}, @code{off} use +@code{\\override #'(full-length . #f)} +Manual settings for @code{on},@code{off} and @code{phase} are possible. +@lilypond[verbatim,quote] +\\markup { + \\draw-dashed-line #'(5.1 . 2.3) + \\override #'(on . 0.3) + \\override #'(off . 0.5) + \\draw-dashed-line #'(5.1 . 2.3) +} +@end lilypond" + (let* ((line-thickness (ly:output-def-lookup layout 'line-thickness)) + ;; Calculate the thickness to be used. + (th (* line-thickness thickness)) + (half-thick (/ th 2)) + ;; Get the extensions in x- and y-direction. + (x (car dest)) + (y (cdr dest)) + ;; Calculate the length of the dashed line. + (line-length (sqrt (+ (expt x 2) (expt y 2))))) + + (if (and full-length (not (= (+ on off) 0))) + (begin + ;; Add double-thickness to avoid overlapping. + (set! off (+ (* 2 th) off)) + (let* (;; Make a guess how often the off/on-pair should be printed + ;; after the initial `on´. + ;; Assume a minimum of 1 to avoid division by zero. + (guess (max 1 (round (/ (- line-length on) (+ off on))))) + ;; Not sure about the value or why corr is necessary at all, + ;; but it seems to be necessary. + (corr (if (= on 0) + (/ line-thickness 10) + 0)) + ;; Calculate a new value for off to fit the + ;; line-length. + (new-off (/ (- line-length corr (* (1+ guess) on)) guess)) + ) + (cond + + ;; Settings for (= on 0). Resulting in a dotted line. + + ;; If line-length isn't shorter than `th´, change the given + ;; value for `off´ to fit the line-length. + ((and (= on 0) (< th line-length)) + (set! off new-off)) + + ;; If the line-length is shorter than `th´, it makes no + ;; sense to adjust `off´. The rounded edges of the lines + ;; would prevent any nice output. + ;; Do nothing. + ;; This will result in a single dot for very short lines. + ((and (= on 0) (>= th line-length)) + #f) + + ;; Settings for (not (= on 0)). Resulting in a dashed line. + + ;; If line-length isn't shorter than one go of on-off-on, + ;; change the given value for `off´ to fit the line-length. + ((< (+ (* 2 on) off) line-length) + (set! off new-off)) + ;; If the line-length is too short, but greater than + ;; (* 4 th) set on/off to (/ line-length 3) + ((< (* 4 th) line-length) + (set! on (/ line-length 3)) + (set! off (/ line-length 3))) + ;; If the line-length is shorter than (* 4 th), it makes + ;; no sense trying to adjust on/off. The rounded edges of + ;; the lines would prevent any nice output. + ;; Simply set `on´ to line-length. + (else + (set! on line-length)))))) + + ;; If `on´ or `off´ is negative, or the sum of `on' and `off' equals zero a + ;; ghostscript-error occurs while calling + ;; (ly:make-stencil (list 'dashed-line th on off x y phase) x-ext y-ext) + ;; Better be paranoid. + (if (or (= (+ on off) 0) + (negative? on) + (negative? off)) + (begin + (ly:warning "Can't print a line - setting on/off to default") + (set! on 1) + (set! off 1))) + + ;; To give the lines produced by \draw-line and \draw-dashed-line the same + ;; length, half-thick has to be added to the stencil-extensions. + (ly:make-stencil + (list 'dashed-line th on off x y phase) + (interval-widen (ordered-cons 0 x) half-thick) + (interval-widen (ordered-cons 0 y) half-thick)))) + +(define-markup-command (draw-dotted-line layout props dest) + (number-pair?) + #:category graphic + #:properties ((thickness 1) + (off 1) + (phase 0)) + " +@cindex drawing dotted lines within text + +A dotted line. + +The dotted-line always extends to the whole length given by @var{dest}, without +white space at beginning or end. +Manual settings for @code{off} are possible to get larger or smaller space +between the dots. +The given (or default) value of @code{off} will be altered to fit the +line-length. +@lilypond[verbatim,quote] +\\markup { + \\draw-dotted-line #'(5.1 . 2.3) + \\override #'(thickness . 2) + \\override #'(off . 0.2) + \\draw-dotted-line #'(5.1 . 2.3) +} +@end lilypond" + + (let ((new-props (prepend-alist-chain 'on 0 + (prepend-alist-chain 'full-length #t props)))) + + (interpret-markup layout + new-props + (markup #:draw-dashed-line dest)))) + +(define-markup-command (draw-hline layout props) + () + #:category graphic + #:properties ((draw-line-markup) + (line-width) + (span-factor 1)) + " +@cindex drawing a line across a page + +Draws a line across a page, where the property @code{span-factor} +controls what fraction of the page is taken up. +@lilypond[verbatim,quote] +\\markup { + \\column { + \\draw-hline + \\override #'(span-factor . 1/3) + \\draw-hline + } +} +@end lilypond" + (interpret-markup layout + props + (markup #:draw-line (cons (* line-width + span-factor) + 0)))) + (define-markup-command (draw-circle layout props radius thickness filled) (number? number? boolean?) #:category graphic @@ -231,7 +390,7 @@ the PDF backend. @lilypond[verbatim,quote] \\markup { - \\with-url #\"http://lilypond.org/web/\" { + \\with-url #\"http://lilypond.org/\" { LilyPond ... \\italic { music notation for everyone } @@ -246,6 +405,62 @@ the PDF backend. (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil))) +(define-markup-command (page-link layout props page-number arg) + (number? markup?) + #:category other + " +@cindex referencing page numbers in text + +Add a link to the page @var{page-number} around @var{arg}. This only works +in the PDF backend. + +@lilypond[verbatim,quote] +\\markup { + \\page-link #2 { \\italic { This links to page 2... } } +} +@end lilypond" + (let* ((stil (interpret-markup layout props arg)) + (xextent (ly:stencil-extent stil X)) + (yextent (ly:stencil-extent stil Y)) + (old-expr (ly:stencil-expr stil)) + (link-expr (list 'page-link page-number `(quote ,xextent) `(quote ,yextent)))) + + (ly:stencil-add (ly:make-stencil link-expr xextent yextent) stil))) + +(define-markup-command (with-link layout props label arg) + (symbol? markup?) + #:category other + " +@cindex referencing page labels in text + +Add a link to the page holding label @var{label} around @var{arg}. This +only works in the PDF backend. + +@lilypond[verbatim,quote] +\\markup { + \\with-link #'label { + \\italic { This links to the page containing the label... } + } +} +@end lilypond" + (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))) + + (define-markup-command (beam layout props width slope thickness) (number? number? number?) #:category graphic @@ -277,30 +492,31 @@ Create a beam with the specified parameters. (define-markup-command (underline layout props arg) (markup?) #:category font - #:properties ((thickness 1)) + #:properties ((thickness 1) (offset 2)) " @cindex underlining text Underline @var{arg}. Looks at @code{thickness} to determine line -thickness and y-offset. +thickness, and @code{offset} to determine line y-offset. @lilypond[verbatim,quote] -\\markup { - default - \\hspace #2 - \\override #'(thickness . 2) - \\underline { - underline - } +\\markup \\fill-line { + \\underline \"underlined\" + \\override #'(offset . 5) + \\override #'(thickness . 1) + \\underline \"underlined\" + \\override #'(offset . 1) + \\override #'(thickness . 5) + \\underline \"underlined\" } @end lilypond" - (let* ((thick (* (ly:output-def-lookup layout 'line-thickness) - thickness)) + (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))) - (y (* thick -2)) - (line (make-line-stencil thick x1 y x2 y))) + (y (* thick (- offset))) + (line (make-line-stencil underline-thick x1 y x2 y))) (ly:stencil-add markup line))) (define-markup-command (box layout props arg) @@ -473,10 +689,10 @@ Create a box of the same height as the space in the current font." (ly:stencil-extent m X) ))) -;; todo: fix negative space (define-markup-command (hspace layout props amount) (number?) #:category align + #:properties ((word-space)) " @cindex creating horizontal spaces in text @@ -491,11 +707,9 @@ Create an invisible object taking up horizontal space @var{amount}. three } @end lilypond" - (if (> amount 0) - (ly:make-stencil "" (cons 0 amount) '(0 . 0)) - (ly:make-stencil "" (cons amount amount) '(0 . 0)))) + (let ((corrected-space (- amount word-space))) + (ly:make-stencil "" (cons 0 corrected-space) '(0 . 0)))) -;; todo: fix negative space (define-markup-command (vspace layout props amount) (number?) #:category align @@ -517,9 +731,7 @@ of @var{amount} multiplied by 3. } @end lilypond" (let ((amount (* amount 3.0))) - (if (> amount 0) - (ly:make-stencil "" (cons -1 1) (cons 0 amount)) - (ly:make-stencil "" (cons -1 1) (cons amount amount))))) + (ly:make-stencil "" (cons 0 0) (cons 0 amount)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -609,7 +821,7 @@ rings = \\markup { ;; FIXME (ly:make-stencil (list 'embedded-ps - (format " + (format #f " gsave currentpoint translate 0.1 setlinewidth ~a @@ -618,6 +830,137 @@ grestore str)) '(0 . 0) '(0 . 0))) +(define-markup-command (path layout props thickness commands) (number? list?) + #:category graphic + #:properties ((line-cap-style 'round) + (line-join-style 'round) + (filled #f)) + " +@cindex paths, drawing +@cindex drawing paths +Draws a path with line thickness @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 +@code{closepath}. Note that the commands that begin with @emph{r} +are the relative variants of the other three commands. + +The commands @code{moveto}, @code{rmoveto}, @code{lineto}, and +@code{rlineto} take 2 arguments; they are the X and Y coordinates +for the destination point. + +The commands @code{curveto} and @code{rcurveto} create cubic +Bézier curves, and take 6 arguments; the first two are the X and Y +coordinates for the first control point, the second two are the X +and Y coordinates for the second control point, and the last two +are the X and Y coordinates for the destination point. + +The @code{closepath} command takes zero arguments and closes the +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. + +@lilypond[verbatim,quote] +samplePath = + #'((moveto 0 0) + (lineto -1 1) + (lineto 1 1) + (lineto 1 -1) + (curveto -5 -5 -5 5 -1 0) + (closepath)) + +\\markup { + \\path #0.25 #samplePath +} +@end lilypond" + (let* ((half-thickness (/ thickness 2)) + (current-point '(0 . 0)) + (set-point (lambda (lst) (set! current-point lst))) + (relative? (lambda (x) + (string-prefix? "r" (symbol->string (car x))))) + ;; For calculating extents, we want to modify the command + ;; list so that all coordinates are absolute. + (new-commands (map (lambda (x) + (cond + ;; for rmoveto, rlineto + ((and (relative? x) (eq? 3 (length x))) + (let ((cp (cons + (+ (car current-point) + (second x)) + (+ (cdr current-point) + (third x))))) + (set-point cp) + (list (car cp) + (cdr cp)))) + ;; for rcurveto + ((and (relative? x) (eq? 7 (length x))) + (let* ((old-cp current-point) + (cp (cons + (+ (car old-cp) + (sixth x)) + (+ (cdr old-cp) + (seventh x))))) + (set-point cp) + (list (+ (car old-cp) (second x)) + (+ (cdr old-cp) (third x)) + (+ (car old-cp) (fourth x)) + (+ (cdr old-cp) (fifth x)) + (car cp) + (cdr cp)))) + ;; for moveto, lineto + ((eq? 3 (length x)) + (set-point (cons (second x) + (third x))) + (drop x 1)) + ;; for curveto + ((eq? 7 (length x)) + (set-point (cons (sixth x) + (seventh x))) + (drop x 1)) + ;; keep closepath for filtering; + ;; see `without-closepath'. + (else x))) + commands)) + ;; path-min-max does not accept 0-arg lists, + ;; and since closepath does not affect extents, filter + ;; out those commands here. + (without-closepath (filter (lambda (x) + (not (equal? 'closepath (car x)))) + new-commands)) + (extents (path-min-max + ;; set the origin to the first moveto + (list (list-ref (car without-closepath) 0) + (list-ref (car without-closepath) 1)) + without-closepath)) + (X-extent (cons (list-ref extents 0) (list-ref extents 1))) + (Y-extent (cons (list-ref extents 2) (list-ref extents 3))) + (command-list (fold-right append '() commands))) + + ;; account for line thickness + (set! X-extent (interval-widen X-extent half-thickness)) + (set! Y-extent (interval-widen Y-extent half-thickness)) + + (ly:make-stencil + `(path ,thickness `(,@',command-list) + ',line-cap-style ',line-join-style ,filled) + X-extent + Y-extent))) + (define-markup-command (score layout props score) (ly:score?) #:category music @@ -654,13 +997,15 @@ Inline an image of music. indent = 0.0\\cm \\context { \\Score - \\override RehearsalMark #'break-align-symbols = - #'(time-signature key-signature) - \\override RehearsalMark #'self-alignment-X = #LEFT + \\override RehearsalMark + #'break-align-symbols = #'(time-signature key-signature) + \\override RehearsalMark + #'self-alignment-X = #LEFT } \\context { \\Staff - \\override TimeSignature #'break-align-anchor-alignment = #LEFT + \\override TimeSignature + #'break-align-anchor-alignment = #LEFT } } } @@ -720,45 +1065,67 @@ the use of @code{\\simple} is unnecessary. (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 { - \\tied-lyric #\"Lasciate~i monti\" +\\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" - (if (string-contains str "~") - (let* - ((parts (string-split str #\~)) - (tie-str (ly:wide-char->utf-8 #x203f)) - (joined (list-join parts tie-str)) - (join-stencil (interpret-markup layout props tie-str)) - ) + (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 - (prepend-alist-chain - 'word-space - (/ (interval-length (ly:stencil-extent join-stencil X)) -3.5) - props) - (make-line-markup joined))) - ;(map (lambda (s) (interpret-markup layout props s)) parts)) - (interpret-markup layout props str))) + (interpret-markup layout + props + (replace-short str (markup)))) (define-public empty-markup (make-simple-markup "")) ;; helper for justifying lines. -(define (get-fill-space word-count line-width text-widths) +(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. - Return a list of paddings." + 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." (cond ((null? text-widths) '()) @@ -767,23 +1134,27 @@ Like simple-markup, but use tie characters for @q{~} tilde symbols. (cons (- (- (/ line-width (1- word-count)) (car text-widths)) (/ (car (cdr text-widths)) 2)) - (get-fill-space word-count line-width (cdr text-widths)))) + (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 - (cons - (- (/ line-width (1- word-count)) - (/ (+ (car text-widths) (car (cdr text-widths))) 2)) - (get-fill-space word-count line-width (cdr text-widths)))))) + (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))))))) (define-markup-command (fill-line layout props args) (markup-list?) #:category align #:properties ((text-direction RIGHT) - (word-space 1) - (line-width #f)) + (word-space 0.6) + (line-width #f)) "Put @var{markups} in a horizontal line of width @var{line-width}. The markups are spaced or flushed to fill the entire line. If there are no arguments, return an empty stencil. @@ -806,55 +1177,58 @@ 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 text-widths)))) - (fill-space-normal - (map (lambda (x) - (if (< x word-space) - word-space - x)) - fill-space)) - - (line-stencils (if (= word-count 1) - (list - point-stencil - (car stencils) - point-stencil) - stencils))) - - (if (= text-direction LEFT) - (set! line-stencils (reverse line-stencils))) + (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)))) + + (line-contents (if (= word-count 1) + (list + point-stencil + (car stencils) + point-stencil) + stencils))) (if (null? (remove ly:stencil-empty? orig-stencils)) - empty-stencil - (ly:stencil-translate-axis - (stack-stencils-padding-list X - RIGHT fill-space-normal line-stencils) - (- (car (ly:stencil-extent (car stencils) X))) - X)))) + 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) (markup-list?) @@ -1120,9 +1494,10 @@ the line width, where @var{X} is the number of staff spaces. \\header { title = \"My title\" myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing - elit, sed do eiusmod tempor incididunt ut labore et dolore magna - aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco - laboris nisi ut aliquip ex ea commodo consequat.\" + elit, sed do eiusmod tempor incididunt ut labore et dolore + magna aliqua. Ut enim ad minim veniam, quis nostrud + exercitation ullamco laboris nisi ut aliquip ex ea commodo + consequat.\" } \\paper { @@ -1270,8 +1645,10 @@ setting of the @code{direction} layout property. (define (general-column align-dir baseline mols) "Stack @var{mols} vertically, aligned to @var{align-dir} horizontally." - (let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols))) - (stack-lines -1 0.0 baseline aligned-mols))) + (let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols)) + (stacked-stencil (stack-lines -1 0.0 baseline aligned-mols)) + (stacked-extent (ly:stencil-extent stacked-stencil X))) + (ly:stencil-translate-axis stacked-stencil (- (car stacked-extent)) X ))) (define-markup-command (center-column layout props args) (markup-list?) @@ -1461,7 +1838,7 @@ Align @var{arg} in @var{axis} direction to the @var{dir} side. " @cindex setting horizontal text alignment -Set horizontal alignment. If @var{dir} is @code{-1}, then it is +Set horizontal alignment. If @var{dir} is @w{@code{-1}}, then it is left-aligned, while @code{+1} is right. Values in between interpolate alignment accordingly. @@ -1641,6 +2018,14 @@ Add padding @var{amount} around @var{arg} in the X@tie{}direction. ;; property ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-markup-command (property-recursive layout props symbol) + (symbol?) + #:category other + "Print out a warning when a header field markup contains some recursive +markup definition." + (ly:warning "Recursive definition of property ~a detected!" symbol) + empty-stencil) + (define-markup-command (fromproperty layout props symbol) (symbol?) #:category other @@ -1663,11 +2048,12 @@ returns an empty markup. @end lilypond" (let ((m (chain-assoc-get symbol props))) (if (markup? m) - (interpret-markup layout props m) + ;; prevent infinite loops by clearing the interpreted property: + (interpret-markup layout (cons (list (cons symbol `(,property-recursive-markup ,symbol))) props) m) empty-stencil))) (define-markup-command (on-the-fly layout props procedure arg) - (symbol? markup?) + (procedure? markup?) #:category other "Apply the @var{procedure} markup command to @var{arg}. @var{procedure} should take a single argument." @@ -1677,6 +2063,95 @@ returns an empty markup. (list markup?)) (interpret-markup layout props (list anonymous-with-signature arg)))) +(define-markup-command (footnote layout props mkup note) + (markup? markup?) + #:category other + "Have footnote @var{note} act as an annotation to the markup @var{mkup}. + +@lilypond[verbatim,quote] +\\markup { + \\auto-footnote a b + \\override #'(padding . 0.2) + \\auto-footnote c d +} +@end lilypond +The footnote will not be annotated automatically." + (ly:stencil-combine-at-edge + (interpret-markup layout props mkup) + X + RIGHT + (ly:make-stencil + `(footnote (gensym "footnote") #f ,(interpret-markup layout props note)) + '(0 . 0) + '(0 . 0)) + 0.0)) + +(define-markup-command (auto-footnote layout props mkup note) + (markup? markup?) + #:category other + #:properties ((raise 0.5) + (padding 0.0)) + "Have footnote @var{note} act as an annotation to the markup @var{mkup}. + +@lilypond[verbatim,quote] +\\markup { + \\auto-footnote a b + \\override #'(padding . 0.2) + \\auto-footnote c d +} +@end lilypond +The footnote will be annotated automatically." + (let* ((markup-stencil (interpret-markup layout props mkup)) + (footnote-hash (gensym "footnote")) + (stencil-seed 0) + (gauge-stencil (interpret-markup + layout + props + ((ly:output-def-lookup + layout + 'footnote-numbering-function) + stencil-seed))) + (x-ext (ly:stencil-extent gauge-stencil X)) + (y-ext (ly:stencil-extent gauge-stencil Y)) + (footnote-number + `(delay-stencil-evaluation + ,(delay + (ly:stencil-expr + (let* ((table + (ly:output-def-lookup layout + 'number-footnote-table)) + (footnote-stencil (if (list? table) + (assoc-get footnote-hash + table) + empty-stencil)) + (footnote-stencil (if (ly:stencil? footnote-stencil) + footnote-stencil + (begin + (ly:programming-error +"Cannot find correct footnote for a markup object.") + empty-stencil))) + (gap (- (interval-length x-ext) + (interval-length + (ly:stencil-extent footnote-stencil X)))) + (y-trans (- (+ (cdr y-ext) + raise) + (cdr (ly:stencil-extent footnote-stencil + Y))))) + (ly:stencil-translate footnote-stencil + (cons gap y-trans))))))) + (main-stencil (ly:stencil-combine-at-edge + markup-stencil + X + RIGHT + (ly:make-stencil footnote-number x-ext y-ext) + padding))) + (ly:stencil-add + main-stencil + (ly:make-stencil + `(footnote ,footnote-hash #t ,(interpret-markup layout props note)) + '(0 . 0) + '(0 . 0))))) + (define-markup-command (override layout props new-prop arg) (pair? markup?) #:category other @@ -1803,16 +2278,18 @@ Adjusts @code{baseline-skip} and @code{word-space} accordingly. } @end lilypond" (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12)) - (text-props (list (ly:output-def-lookup layout 'text-font-defaults))) - (ref-word-space (chain-assoc-get 'word-space text-props 0.6)) - (ref-baseline (chain-assoc-get 'baseline-skip text-props 3)) - (magnification (/ size ref-size))) - (interpret-markup layout - (cons `((baseline-skip . ,(* magnification ref-baseline)) - (word-space . ,(* magnification ref-word-space)) - (font-size . ,(magnification->font-size magnification))) - props) - arg))) + (text-props (list (ly:output-def-lookup layout 'text-font-defaults))) + (ref-word-space (chain-assoc-get 'word-space text-props 0.6)) + (ref-baseline (chain-assoc-get 'baseline-skip text-props 3)) + (magnification (/ size ref-size))) + (interpret-markup + layout + (cons + `((baseline-skip . ,(* magnification ref-baseline)) + (word-space . ,(* magnification ref-word-space)) + (font-size . ,(magnification->font-size magnification))) + props) + arg))) (define-markup-command (fontsize layout props increment arg) (number? markup?) @@ -1831,11 +2308,14 @@ accordingly. smaller } @end lilypond" - (let ((entries (list - (cons 'baseline-skip (* baseline-skip (magstep increment))) - (cons 'word-space (* word-space (magstep increment))) - (cons 'font-size (+ font-size increment))))) - (interpret-markup layout (cons entries props) arg))) + (interpret-markup + layout + (cons + `((baseline-skip . ,(* baseline-skip (magstep increment))) + (word-space . ,(* word-space (magstep increment))) + (font-size . ,(+ font-size increment))) + props) + arg)) (define-markup-command (magnify layout props sz arg) (number? markup?) @@ -2223,13 +2703,13 @@ normal text font, no matter what font was used earlier. @lilypond[verbatim,quote] \\markup { \\huge \\bold \\sans \\caps { - Some text with font overrides + huge bold sans caps \\hspace #2 \\normal-text { - Default text, same font-size + huge normal } \\hspace #2 - More text as before + as before } } @end lilypond" @@ -2244,6 +2724,32 @@ normal text font, no matter what font was used earlier. ;; symbols. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-markup-command (musicglyph layout props glyph-name) + (string?) + #:category music + "@var{glyph-name} is converted to a musical symbol; for example, +@code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from +the music font. See @ruser{The Feta font} for a complete listing of +the possible glyphs. + +@lilypond[verbatim,quote] +\\markup { + \\musicglyph #\"f\" + \\musicglyph #\"rests.2\" + \\musicglyph #\"clefs.G_change\" +} +@end lilypond" + (let* ((font (ly:paper-get-font layout + (cons '((font-encoding . fetaMusic) + (font-name . #f)) + + props))) + (glyph (ly:font-get-glyph font glyph-name))) + (if (null? (ly:stencil-expr glyph)) + (ly:warning (_ "Cannot find glyph ~a") glyph-name)) + + glyph)) + (define-markup-command (doublesharp layout props) () #:category music @@ -2400,7 +2906,7 @@ Use the filled head if @var{filled} is specified. } @end lilypond" (let* - ((name (format "arrowheads.~a.~a~a" + ((name (format #f "arrowheads.~a.~a~a" (if filled "close" "open") @@ -2411,33 +2917,6 @@ Use the filled head if @var{filled} is specified. props)) name))) -(define-markup-command (musicglyph layout props glyph-name) - (string?) - #:category music - "@var{glyph-name} is converted to a musical symbol; for example, -@code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from -the music font. See @ruser{The Feta font} for a complete listing of -the possible glyphs. - -@lilypond[verbatim,quote] -\\markup { - \\musicglyph #\"f\" - \\musicglyph #\"rests.2\" - \\musicglyph #\"clefs.G_change\" -} -@end lilypond" - (let* ((font (ly:paper-get-font layout - (cons '((font-encoding . fetaMusic) - (font-name . #f)) - - props))) - (glyph (ly:font-get-glyph font glyph-name))) - (if (null? (ly:stencil-expr glyph)) - (ly:warning (_ "Cannot find glyph ~a") glyph-name)) - - glyph)) - - (define-markup-command (lookup layout props glyph-name) (string?) #:category other @@ -2625,25 +3104,28 @@ figured bass notation. (slashed-digit-internal layout props num #f font-size thickness)) ;; eyeglasses -(define eyeglassesps - "0.15 setlinewidth - -0.9 0 translate - 1.1 1.1 scale - 1.2 0.7 moveto - 0.7 0.7 0.5 0 361 arc - stroke - 2.20 0.70 0.50 0 361 arc - stroke - 1.45 0.85 0.30 0 180 arc - stroke - 0.20 0.70 moveto - 0.80 2.00 lineto - 0.92 2.26 1.30 2.40 1.15 1.70 curveto - stroke - 2.70 0.70 moveto - 3.30 2.00 lineto - 3.42 2.26 3.80 2.40 3.65 1.70 curveto - stroke") +(define eyeglassespath + '((moveto 0.42 0.77) + (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55) + (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55) + (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55) + (rcurveto 0.304 0 0.55 0.246 0.55 0.55) + (closepath) + (moveto 2.07 0.77) + (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55) + (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55) + (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55) + (rcurveto 0.304 0 0.55 0.246 0.55 0.55) + (closepath) + (moveto 1.025 0.935) + (rcurveto 0 0.182 -0.148 0.33 -0.33 0.33) + (rcurveto -0.182 0 -0.33 -0.148 -0.33 -0.33) + (moveto -0.68 0.77) + (rlineto 0.66 1.43) + (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33) + (moveto 2.07 0.77) + (rlineto 0.66 1.43) + (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33))) (define-markup-command (eyeglasses layout props) () @@ -2653,8 +3135,8 @@ figured bass notation. \\markup { \\eyeglasses } @end lilypond" (interpret-markup layout props - (make-with-dimensions-markup '(-0.61 . 3.22) '(0.2 . 2.41) - (make-postscript-markup eyeglassesps)))) + (make-override-markup '(line-cap-style . butt) + (make-path-markup 0.15 eyeglassespath)))) (define-markup-command (left-brace layout props size) (number?) @@ -2738,7 +3220,7 @@ Construct a note symbol, with stem. By using fractional values for @end lilypond" (define (get-glyph-name-candidates dir log style) (map (lambda (dir-name) - (format "noteheads.~a~a" dir-name + (format #f "noteheads.~a~a" dir-name (if (and (symbol? style) (not (equal? 'default style))) (select-head-glyph style (min log 2)) @@ -2870,6 +3352,265 @@ a shortened down stem. (let ((parsed (parse-simple-duration duration))) (note-by-number-markup layout props (car parsed) (cadr parsed) dir))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; the rest command. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-markup-command (rest-by-number layout props log dot-count) + (number? number?) + #:category music + #:properties ((font-size 0) + (style '()) + (multi-measure-rest #f)) + " +@cindex rests or multi-measure-rests within text by log and dot-count + +A rest or multi-measure-rest symbol. + +@lilypond[verbatim,quote] +\\markup { + \\rest-by-number #3 #2 + \\hspace #2 + \\rest-by-number #0 #1 + \\hspace #2 + \\override #'(multi-measure-rest . #t) + \\rest-by-number #0 #0 +} +@end lilypond" + + (define (get-glyph-name-candidates log style) + (let* (;; Choose the style-string to be added. + ;; If no glyph exists, select others for the specified styles + ;; otherwise defaulting. + (style-strg + (cond ( + ;; 'baroque needs to be special-cased, otherwise + ;; `select-head-glyph´ would catch neomensural-glyphs for + ;; this style, if (< log 0). + (eq? style 'baroque) + (string-append (number->string log) "")) + ((eq? style 'petrucci) + (string-append (number->string log) "mensural")) + ;; In other cases `select-head-glyph´ from output-lib.scm + ;; works for rest-glyphs, too. + ((and (symbol? style) (not (eq? style 'default))) + (select-head-glyph style log)) + (else log))) + ;; Choose ledgered glyphs for whole and half rest. + ;; Except for the specified styles, logs and MultiMeasureRests. + (ledger-style-rests + (if (and (or (list? style) + (not (member style + '(neomensural mensural petrucci)))) + (not multi-measure-rest) + (or (= log 0) (= log 1))) + "o" + ""))) + (format #f "rests.~a~a" style-strg ledger-style-rests))) + + (define (get-glyph-name font cands) + (if (ly:stencil-empty? (ly:font-get-glyph font cands)) + "" + cands)) + + (let* ((font + (ly:paper-get-font layout + (cons '((font-encoding . fetaMusic)) props))) + (rest-glyph-name + (let ((result + (get-glyph-name font + (get-glyph-name-candidates log style)))) + (if (string-null? result) + ;; If no glyph name can be found, select default rests. Though + ;; this usually means an unsupported style has been chosen, it + ;; also prevents unrelated 'style settings from other grobs + ;; (e.g., TextSpanner and TimeSignature) leaking into markup. + (get-glyph-name font (get-glyph-name-candidates log 'default)) + result))) + (rest-glyph (ly:font-get-glyph font rest-glyph-name)) + (dot (ly:font-get-glyph font "dots.dot")) + (dot-width (interval-length (ly:stencil-extent dot X))) + (dots (and (> dot-count 0) + (apply ly:stencil-add + (map (lambda (x) + (ly:stencil-translate-axis + dot (* 2 x dot-width) X)) + (iota dot-count)))))) + + ;; Apart from mensural-, neomensural- and petrucci-style ledgered + ;; glyphs are taken for whole and half rests. + ;; If they are dotted, move the dots in X-direction to avoid collision. + (if (and dots + (< log 2) + (>= log 0) + (not (member style '(neomensural mensural petrucci)))) + (set! dots (ly:stencil-translate-axis dots dot-width X))) + + ;; Add dots to the rest-glyph. + ;; + ;; Not sure how to vertical align dots. + ;; For now the dots are centered for half, whole or longer rests. + ;; Otherwise placed near the top of the rest. + ;; + ;; Dots for rests with (< log 0) dots are allowed, but not + ;; if multi-measure-rest is set #t. + (if (and (not multi-measure-rest) dots) + (set! rest-glyph + (ly:stencil-add + (ly:stencil-translate + dots + (cons + (+ (cdr (ly:stencil-extent rest-glyph X)) dot-width) + (if (< log 2) + (interval-center (ly:stencil-extent rest-glyph Y)) + (- (interval-end (ly:stencil-extent rest-glyph Y)) + (/ (* 2 dot-width) 3))))) + rest-glyph))) + rest-glyph)) + +(define-markup-command (rest layout props duration) + (string?) + #:category music + #:properties ((style '()) + (multi-measure-rest #f) + (multi-measure-rest-number #t) + (word-space 0.6)) + " +@cindex rests or multi-measure-rests within text by string + +This produces a rest, with the @var{duration} for the rest type and +augmentation dots. +@code{\"breve\"}, @code{\"longa\"} and @code{\"maxima\"} are valid +input-strings. + +Printing MultiMeasureRests could be enabled with +@code{\\override #'(multi-measure-rest . #t)} +If MultiMeasureRests are taken, the MultiMeasureRestNumber is printed above. +This is enabled for all styles using default-glyphs. +Could be disabled with @code{\\override #'(multi-measure-rest-number . #f)} + +@lilypond[verbatim,quote] +\\markup { + \\rest #\"4..\" + \\hspace #2 + \\rest #\"breve\" + \\hspace #2 + \\override #'(multi-measure-rest . #t) + { + \\rest #\"7\" + \\hspace #2 + \\override #'(multi-measure-rest-number . #f) + \\rest #\"7\" + } +} +@end lilypond" + ;; Get the number of mmr-glyphs. + ;; Store them in a list. + ;; example: (mmr-numbers 25) -> '(3 0 0 1) + (define (mmr-numbers nmbr) + (let* ((8-bar-glyph (floor (/ nmbr 8))) + (8-remainder (remainder nmbr 8)) + (4-bar-glyph (floor (/ 8-remainder 4))) + (4-remainder (remainder nmbr 4)) + (2-bar-glyph (floor (/ 4-remainder 2))) + (2-remainder (remainder 4-remainder 2)) + (1-bar-glyph (floor (/ 2-remainder 1)))) + (list 8-bar-glyph 4-bar-glyph 2-bar-glyph 1-bar-glyph))) + + ;; Get the correct mmr-glyphs. + ;; Store them in a list. + ;; example: + ;; (get-mmr-glyphs '(1 0 1 0) '("rests.M3" "rests.M2" "rests.M1" "rests.0")) + ;; -> ("rests.M3" "rests.M1") + (define (get-mmr-glyphs lst1 lst2) + (define (helper l1 l2 l3) + (if (null? l1) + (reverse l3) + (helper (cdr l1) + (cdr l2) + (append (make-list (car l1) (car l2)) l3)))) + (helper lst1 lst2 '())) + + ;; If duration is not valid, print a warning and return empty-stencil + (if (or (and (not (integer? (car (parse-simple-duration duration)))) + (not multi-measure-rest)) + (and (= (string-length (car (string-split duration #\. ))) 1) + (= (string->number (car (string-split duration #\. ))) 0))) + (begin + (ly:warning (_ "not a valid duration string: ~a - ignoring") duration) + empty-stencil) + (let* ( + ;; For simple rests: + ;; Get a (log dots) list. + (parsed (parse-simple-duration duration)) + ;; Create the rest-stencil + (stil + (rest-by-number-markup layout props (car parsed) (cadr parsed))) + ;; For MultiMeasureRests: + ;; Get the duration-part of duration + (dur-part-string (car (string-split duration #\. ))) + ;; Get the duration of MMR: + ;; If not a number (eg. "maxima") calculate it. + (mmr-duration + (or (string->number dur-part-string) (expt 2 (abs (car parsed))))) + ;; Get a list of the correct number of each mmr-glyph. + (count-mmr-glyphs-list (mmr-numbers mmr-duration)) + ;; Create a list of mmr-stencils, + ;; translating the glyph for a whole rest. + (mmr-stils-list + (map + (lambda (x) + (let ((single-mmr-stil + (rest-by-number-markup layout props (* -1 x) 0))) + (if (= x 0) + (ly:stencil-translate-axis + single-mmr-stil + ;; Ugh, hard-coded, why 1? + 1 + Y) + single-mmr-stil))) + (get-mmr-glyphs count-mmr-glyphs-list (reverse (iota 4))))) + ;; Adjust the space between the mmr-glyphs, + ;; if not default-glyphs are used. + (word-space (if (member style + '(neomensural mensural petrucci)) + (/ (* word-space 2) 3) + word-space)) + ;; Create the final mmr-stencil + ;; via `stack-stencil-line´ from /scm/markup.scm + (mmr-stil (stack-stencil-line word-space mmr-stils-list))) + + ;; Print the number above a multi-measure-rest + ;; Depends on duration, style and multi-measure-rest-number set #t + (if (and multi-measure-rest + multi-measure-rest-number + (> mmr-duration 1) + (not (member style '(neomensural mensural petrucci)))) + (let* ((mmr-stil-x-center + (interval-center (ly:stencil-extent mmr-stil X))) + (duration-markup + (markup + #:fontsize -2 + #:override '(font-encoding . fetaText) + (number->string mmr-duration))) + (mmr-number-stil + (interpret-markup layout props duration-markup)) + (mmr-number-stil-x-center + (interval-center (ly:stencil-extent mmr-number-stil X)))) + + (set! mmr-stil (ly:stencil-combine-at-edge + mmr-stil + Y UP + (ly:stencil-translate-axis + mmr-number-stil + (- mmr-stil-x-center mmr-number-stil-x-center) + X) + ;; Ugh, hardcoded + 0.8)))) + (if multi-measure-rest + mmr-stil + stil)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; translating. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3195,7 +3936,7 @@ a column containing several lines of text. (parenthesize-stencil markup half-thickness scaled-width angularity padding))) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Delayed markup evaluation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3206,7 +3947,7 @@ a column containing several lines of text. " @cindex referencing page numbers in text -Reference to a page number. @var{label} is the label set on the referenced +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." @@ -3220,7 +3961,7 @@ when @var{label} is not found." (page-number (if (list? table) (assoc-get label table) #f)) - (page-markup (if page-number (format "~a" page-number) default)) + (page-markup (if page-number (format #f "~a" page-number) default)) (page-stencil (interpret-markup layout props page-markup)) (gap (- (interval-length x-ext) (interval-length (ly:stencil-extent page-stencil X))))) @@ -3229,6 +3970,137 @@ when @var{label} is not found." x-ext y-ext))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; scaling +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-markup-command (scale layout props factor-pair arg) + (number-pair? markup?) + #:category graphic + " +@cindex scaling markup +@cindex mirroring markup + +Scale @var{arg}. @var{factor-pair} is a pair of numbers +representing the scaling-factor in the X and Y axes. +Negative values may be used to produce mirror images. + +@lilypond[verbatim,quote] +\\markup { + \\line { + \\scale #'(2 . 1) + stretched + \\scale #'(1 . -1) + mirrored + } +} +@end lilypond" + (let ((stil (interpret-markup layout props arg)) + (sx (car factor-pair)) + (sy (cdr factor-pair))) + (ly:stencil-scale stil sx sy))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Repeating +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-markup-command (pattern layout props count axis space pattern) + (integer? integer? number? markup?) + #:category other + " +Prints @var{count} times a @var{pattern} markup. +Patterns are spaced apart by @var{space}. +Patterns are distributed on @var{axis}. + +@lilypond[verbatim, quote] +\\markup \\column { + \"Horizontally repeated :\" + \\pattern #7 #X #2 \\flat + \\null + \"Vertically repeated :\" + \\pattern #3 #Y #0.5 \\flat +} +@end lilypond" + (let ((pattern-width (interval-length + (ly:stencil-extent (interpret-markup layout props pattern) X))) + (new-props (prepend-alist-chain 'word-space 0 (prepend-alist-chain 'baseline-skip 0 props)))) + (let loop ((i (1- count)) (patterns (markup))) + (if (zero? i) + (interpret-markup + layout + new-props + (if (= axis X) + (markup patterns pattern) + (markup #:column (patterns pattern)))) + (loop (1- i) + (if (= axis X) + (markup patterns pattern #:hspace space) + (markup #:column (patterns pattern #:vspace space)))))))) + +(define-markup-command (fill-with-pattern layout props space dir pattern left right) + (number? ly:dir? markup? markup? markup?) + #:category align + #:properties ((word-space) + (line-width)) + " +Put @var{left} and @var{right} in a horizontal line of width @code{line-width} +with a line of markups @var{pattern} in between. +Patterns are spaced apart by @var{space}. +Patterns are aligned to the @var{dir} markup. + +@lilypond[verbatim, quote] +\\markup \\column { + \"right-aligned :\" + \\fill-with-pattern #1 #RIGHT . first right + \\fill-with-pattern #1 #RIGHT . second right + \\null + \"center-aligned :\" + \\fill-with-pattern #1.5 #CENTER - left right + \\null + \"left-aligned :\" + \\override #'(line-width . 50) + \\fill-with-pattern #2 #LEFT : left first + \\override #'(line-width . 50) + \\fill-with-pattern #2 #LEFT : left second +} +@end lilypond" + (let* ((pattern-x-extent (ly:stencil-extent (interpret-markup layout props pattern) X)) + (pattern-width (interval-length pattern-x-extent)) + (left-width (interval-length (ly:stencil-extent (interpret-markup layout props left) X))) + (right-width (interval-length (ly:stencil-extent (interpret-markup layout props right) X))) + (middle-width (max 0 (- line-width (+ (+ left-width right-width) (* word-space 2))))) + (period (+ space pattern-width)) + (count (truncate (/ (- middle-width pattern-width) period))) + (x-offset (+ (* (- (- middle-width (* count period)) pattern-width) (/ (1+ dir) 2)) (abs (car pattern-x-extent))))) + (interpret-markup layout props + (markup left + #:with-dimensions (cons 0 middle-width) '(0 . 0) + #:translate (cons x-offset 0) + #:pattern (1+ count) X space pattern + right)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Replacements +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-markup-command (replace layout props replacements arg) + (list? markup?) + #:category font + " +Used to automatically replace a string by another in the markup @var{arg}. +Each pair of the alist @var{replacements} specifies what should be replaced. +The @code{key} is the string to be replaced by the @code{value} string. + +@lilypond[verbatim, quote] +\\markup \\replace #'((\"thx\" . \"Thanks!\")) thx +@end lilypond" + (interpret-markup + layout + (internal-add-text-replacements + props + replacements) + (markup arg))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Markup list commands ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;