X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-markup-commands.scm;h=0f5329658430ebd23b7efb41f20e81348126b6f4;hb=32a34dcef0c0041c6d62677487a380b5c8b85712;hp=804c59570c31786e272be80e4e56fe456b7e5550;hpb=6f845a1465904a366645c573c981d4e463387fe6;p=lilypond.git diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index 804c59570c..0f53296584 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -1,14 +1,109 @@ -;;;; define-markup-commands.scm -- markup commands +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 2000--2007 Han-Wen Nienhuys +;;;; Copyright (C) 2000--2012 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen - - -;;; markup commands -;;; * each markup function should have a doc string with -;; syntax, description and example. +;;;; +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . + +;;; +;;; Markup commands and markup-list commands definitions. +;;; +;;; Markup commands which are part of LilyPond, are defined +;;; in the (lily) module, which is the current module in this file, +;;; using the `define-markup-command' macro. +;;; +;;; Usage: +;;; +;;; (define-markup-command (command-name layout props args...) +;;; args-signature +;;; [ #:category category ] +;;; [ #:properties property-bindings ] +;;; documentation-string +;;; ..body..) +;;; +;;; with: +;;; command-name +;;; the name of the markup command +;;; +;;; layout and props +;;; arguments that are automatically passed to the command when it +;;; is interpreted. +;;; `layout' is an output def, which properties can be accessed +;;; using `ly:output-def-lookup'. +;;; `props' is a list of property settings which can be accessed +;;; using `chain-assoc-get' (more on that below) +;;; +;;; args... +;;; 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 +;;; are used to type check the arguments, and also to define the general +;;; argument types (markup, markup-list, scheme) that the command is +;;; expecting. +;;; For instance, if a command expects a number, then a markup, the +;;; signature would be: (number? markup?) +;;; +;;; category +;;; for documentation purpose, builtin markup commands are grouped by +;;; 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 +;;; (property-name default-value) +;;; or (property-name) +;;; 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 +;;; used instead. +;;; Thus, using the following property bindings: +;;; ((thickness 0.1) +;;; (font-size 0)) +;;; is equivalent to writing: +;;; (let ((thickness (chain-assoc-get 'thickness props 0.1)) +;;; (font-size (chain-assoc-get 'font-size props 0))) +;;; ..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 +;;; 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. +;;; +;;; Each markup command definition shall have a documentation string +;;; with description, syntax and example. (use-modules (ice-9 regex)) @@ -23,10 +118,10 @@ ;; geometric shapes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (draw-line layout props dest) +(define-markup-command (draw-line layout props dest) (number-pair?) - graphic - ((thickness 1)) + #:category graphic + #:properties ((thickness 1)) " @cindex drawing lines within text @@ -42,22 +137,41 @@ A simple line. thickness)) (x (car dest)) (y (cdr dest))) - (ly:make-stencil - `(draw-line - ,th - 0 0 - ,x ,y) - (cons (min x 0) (max x 0)) - (cons (min y 0) (max y 0))))) - -(define-builtin-markup-command (draw-circle layout props radius thickness fill) - (number? number? boolean?) - graphic + (make-line-stencil th 0 0 x y))) + +(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 " @cindex drawing circles within text -A circle of radius @var{radius}, thickness @var{thickness} and +A circle of radius @var{radius} and thickness @var{thickness}, optionally filled. @lilypond[verbatim,quote] @@ -67,14 +181,14 @@ optionally filled. \\draw-circle #2 #0 ##t } @end lilypond" - (make-circle-stencil radius thickness fill)) + (make-circle-stencil radius thickness filled)) -(define-builtin-markup-command (triangle layout props filled) +(define-markup-command (triangle layout props filled) (boolean?) - graphic - ((thickness 0.1) - (font-size 0) - (baseline-skip 2)) + #:category graphic + #:properties ((thickness 0.1) + (font-size 0) + (baseline-skip 2)) " @cindex drawing triangles within text @@ -98,12 +212,12 @@ A triangle, either filled or empty. (cons 0 ex) (cons 0 (* .86 ex))))) -(define-builtin-markup-command (circle layout props arg) +(define-markup-command (circle layout props arg) (markup?) - graphic - ((thickness 1) - (font-size 0) - (circle-padding 0.2)) + #:category graphic + #:properties ((thickness 1) + (font-size 0) + (circle-padding 0.2)) " @cindex circling text @@ -112,7 +226,11 @@ Draw a circle around @var{arg}. Use @code{thickness}, thickness and padding around the markup. @lilypond[verbatim,quote] -\\markup \\circle { Hi } +\\markup { + \\circle { + Hi + } +} @end lilypond" (let ((th (* (ly:output-def-lookup layout 'line-thickness) thickness)) @@ -120,10 +238,9 @@ thickness and padding around the markup. (m (interpret-markup layout props arg))) (circle-stencil m th pad))) -(define-builtin-markup-command (with-url layout props url arg) +(define-markup-command (with-url layout props url arg) (string? markup?) - graphic - () + #:category graphic " @cindex inserting URL links into text @@ -132,8 +249,10 @@ the PDF backend. @lilypond[verbatim,quote] \\markup { - \\with-url #\"http://lilypond.org/web/\" { - LilyPond ... \\italic { music notation for everyone } + \\with-url #\"http://lilypond.org/\" { + LilyPond ... \\italic { + music notation for everyone + } } } @end lilypond" @@ -145,23 +264,80 @@ the PDF backend. (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil))) -(define-builtin-markup-command (beam layout props width slope thickness) +(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?) - graphic - () + #:category graphic " @cindex drawing beams within text Create a beam with the specified parameters. @lilypond[verbatim,quote] -\\markup \\beam #5 #1 #2 +\\markup { + \\beam #5 #1 #2 +} @end lilypond" (let* ((y (* slope width)) (yext (cons (min 0 y) (max 0 y))) (half (/ thickness 2))) (ly:make-stencil - `(polygon ',(list + `(polygon ',(list 0 (/ thickness -2) width (+ (* width slope) (/ thickness -2)) width (+ (* width slope) (/ thickness 2)) @@ -172,39 +348,42 @@ Create a beam with the specified parameters. (cons (+ (- half) (car yext)) (+ half (cdr yext)))))) -(define-builtin-markup-command (underline layout props arg) +(define-markup-command (underline layout props arg) (markup?) - font - ((thickness 1)) + #:category font + #: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 \\override #'(thickness . 2) \\underline { - CONTENTS +\\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 (ly:make-stencil - `(draw-line ,thick ,x1 ,y ,x2 ,y) - (cons (min x1 0) (max x2 0)) - (cons thick thick)))) + (y (* thick (- offset))) + (line (make-line-stencil underline-thick x1 y x2 y))) (ly:stencil-add markup line))) -(define-builtin-markup-command (box layout props arg) +(define-markup-command (box layout props arg) (markup?) - font - ((thickness 1) - (font-size 0) - (box-padding 0.2)) + #:category font + #:properties ((thickness 1) + (font-size 0) + (box-padding 0.2)) " @cindex enclosing text within a box @@ -225,10 +404,9 @@ thickness and padding around the markup. (m (interpret-markup layout props arg))) (box-stencil m th pad))) -(define-builtin-markup-command (filled-box layout props xext yext blot) +(define-markup-command (filled-box layout props xext yext blot) (number-pair? number-pair? number?) - graphic - () + #:category graphic " @cindex drawing solid boxes within text @cindex drawing boxes with rounded corners @@ -240,7 +418,7 @@ Draw a box with rounded corners of dimensions @var{xext} and @end verbatim creates a box extending horizontally from -0.3 to 1.8 and vertically from -0.3 up to 1.8, with corners formed from a -circle of diameter@tie{}0 (i.e. sharp corners). +circle of diameter@tie{}0 (i.e., sharp corners). @lilypond[verbatim,quote] \\markup { @@ -254,24 +432,28 @@ circle of diameter@tie{}0 (i.e. sharp corners). (ly:round-filled-box xext yext blot)) -(define-builtin-markup-command (rounded-box layout props arg) +(define-markup-command (rounded-box layout props arg) (markup?) - graphic - ((thickness 1) - (corner-radius 1) - (font-size 0) - (box-padding 0.5)) - "@cindex enclosing text in a bow with rounded corners + #:category graphic + #:properties ((thickness 1) + (corner-radius 1) + (font-size 0) + (box-padding 0.5)) + "@cindex enclosing text in a box with rounded corners @cindex drawing boxes with rounded corners around text Draw a box with rounded corners around @var{arg}. Looks at @code{thickness}, @code{box-padding} and @code{font-size} properties to determine line thickness and padding around the markup; the @code{corner-radius} property -makes possible to define another shape for the corners (default is 1). +makes it possible to define another shape for the corners (default is 1). -@lilypond[quote,verbatim,fragment,relative=2] -c^\\markup \\rounded-box { Overtura } +@lilypond[quote,verbatim,relative=2] +c4^\\markup { + \\rounded-box { + Overtura + } +} c,8. c16 c4 r -@end lilypond" +@end lilypond" (let ((th (* (ly:output-def-lookup layout 'line-thickness) thickness)) (pad (* (magstep font-size) box-padding)) @@ -279,36 +461,66 @@ c,8. c16 c4 r (ly:stencil-add (rounded-box-stencil m th pad corner-radius) m))) -(define-builtin-markup-command (rotate layout props ang arg) +(define-markup-command (rotate layout props ang arg) (number? markup?) - align - () + #:category align " @cindex rotating text -Rotate object with @var{ang} degrees around its center." +Rotate object with @var{ang} degrees around its center. + +@lilypond[verbatim,quote] +\\markup { + default + \\hspace #2 + \\rotate #45 + \\line { + rotated 45° + } +} +@end lilypond" (let* ((stil (interpret-markup layout props arg))) (ly:stencil-rotate stil ang 0 0))) -(define-builtin-markup-command (whiteout layout props arg) +(define-markup-command (whiteout layout props arg) (markup?) - other - () + #:category other " @cindex adding a white background to text -Provide a white background for @var{arg}." +Provide a white background for @var{arg}. + +@lilypond[verbatim,quote] +\\markup { + \\combine + \\filled-box #'(-1 . 10) #'(-3 . 4) #1 + \\whiteout whiteout +} +@end lilypond" (stencil-whiteout (interpret-markup layout props arg))) -(define-builtin-markup-command (pad-markup layout props padding arg) +(define-markup-command (pad-markup layout props amount arg) (number? markup?) - align - () + #:category align " @cindex padding text @cindex putting space around text -Add space around a markup object." +Add space around a markup object. + +@lilypond[verbatim,quote] +\\markup { + \\box { + default + } + \\hspace #2 + \\box { + \\pad-markup #1 { + padded + } + } +} +@end lilypond" (let* ((stil (interpret-markup layout props arg)) (xext (ly:stencil-extent stil X)) @@ -316,17 +528,16 @@ Add space around a markup object." (ly:make-stencil (ly:stencil-expr stil) - (interval-widen xext padding) - (interval-widen yext padding)))) + (interval-widen xext amount) + (interval-widen yext amount)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; space ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (strut layout props) - () - other +(define-markup-command (strut layout props) () + #:category other " @cindex creating vertical spaces in text @@ -338,22 +549,14 @@ Create a box of the same height as the space in the current font." ))) ;; todo: fix negative space -(define-builtin-markup-command (hspace layout props amount) +(define-markup-command (hspace layout props amount) (number?) - align - () + #:category align + #:properties ((word-space)) " @cindex creating horizontal spaces in text -This produces an invisible object taking horizontal space. For example, - -@example -\\markup @{ A \\hspace #2.0 B @} -@end example - -@noindent -puts extra space between A and@tie{}B, on top of the space that is -normally inserted before elements on a line. +Create an invisible object taking up horizontal space @var{amount}. @lilypond[verbatim,quote] \\markup { @@ -364,23 +567,55 @@ normally inserted before elements on a line. three } @end lilypond" - (if (> amount 0) - (ly:make-stencil "" (cons 0 amount) '(-1 . 1)) - (ly:make-stencil "" (cons amount amount) '(-1 . 1)))) + (let ((corrected-space (- amount word-space))) + (if (> corrected-space 0) + (ly:make-stencil "" (cons 0 corrected-space) '(0 . 0)) + (ly:make-stencil "" (cons corrected-space corrected-space) '(0 . 0))))) + +;; todo: fix negative space +(define-markup-command (vspace layout props amount) + (number?) + #:category align + " +@cindex creating vertical spaces in text + +Create an invisible object taking up vertical space +of @var{amount} multiplied by 3. + +@lilypond[verbatim,quote] +\\markup { + \\center-column { + one + \\vspace #2 + two + \\vspace #5 + three + } +} +@end lilypond" + (let ((amount (* amount 3.0))) + (if (> amount 0) + (ly:make-stencil "" (cons 0 0) (cons 0 amount)) + (ly:make-stencil "" (cons 0 0) (cons amount amount))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; importing graphics. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (stencil layout props stil) +(define-markup-command (stencil layout props stil) (ly:stencil?) - other - () + #:category other " @cindex importing stencils into text -Use a stencil as markup." +Use a stencil as markup. + +@lilypond[verbatim,quote] +\\markup { + \\stencil #(make-circle-stencil 2 0 #t) +} +@end lilypond" stil) (define bbox-regexp @@ -390,18 +625,17 @@ Use a stencil as markup." "Extract the bbox from STRING, or return #f if not present." (let* ((match (regexp-exec bbox-regexp string))) - + (if match (map (lambda (x) (string->number (match:substring match x))) (cdr (iota 5))) - + #f))) -(define-builtin-markup-command (epsfile layout props axis size file-name) +(define-markup-command (epsfile layout props axis size file-name) (number? number? string?) - graphic - () + #:category graphic " @cindex inlining an Encapsulated PostScript image @@ -421,69 +655,38 @@ Inline an EPS image. The image is scaled along @var{axis} to (eps-file->stencil axis size file-name) )) -(define-builtin-markup-command (postscript layout props str) +(define-markup-command (postscript layout props str) (string?) - graphic - () + #:category graphic " @cindex inserting PostScript directly into text - This inserts @var{str} directly into the output as a PostScript -command string. Due to technicalities of the output backends, -different scales should be used for the @TeX{} and PostScript backend, -selected with @code{-f}. - -For the @TeX{} backend, the following string prints a rotated text - -@example -0 0 moveto /ecrm10 findfont -1.75 scalefont setfont 90 rotate (hello) show -@end example - -@noindent -The magical constant 1.75 scales from LilyPond units (staff spaces) to -@TeX{} dimensions. - -For the postscript backend, use the following - -@example -gsave /ecrm10 findfont - 10.0 output-scale div - scalefont setfont 90 rotate (hello) show grestore -@end example +command string. @lilypond[verbatim,quote] -eyeglassesps = #\" +ringsps = #\" 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 + 0.9 0.6 moveto + 0.4 0.6 0.5 0 361 arc stroke - 1.45 0.85 0.30 0 180 arc + 1.0 0.6 0.5 0 361 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\" + \" -eyeglasses = \\markup { - \\with-dimensions #'(0 . 4.4) #'(0 . 2.5) - \\postscript #eyeglassesps +rings = \\markup { + \\with-dimensions #'(-0.2 . 1.6) #'(0 . 1.2) + \\postscript #ringsps } -\\relative c'' { c2^\\eyeglasses a_\\eyeglasses } +\\relative c'' { + c2^\\rings + a2_\\rings +} @end lilypond" ;; FIXME (ly:make-stencil (list 'embedded-ps - (format " + (format #f " gsave currentpoint translate 0.1 setlinewidth ~a @@ -492,10 +695,141 @@ grestore str)) '(0 . 0) '(0 . 0))) -(define-builtin-markup-command (score layout props score) +(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?) - music - () + #:category music + #:properties ((baseline-skip)) " @cindex inserting music into text @@ -528,38 +862,43 @@ 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 } } } } @end lilypond" - (let* ((output (ly:score-embedded-format score layout))) + (let ((output (ly:score-embedded-format score layout))) (if (ly:music-output? output) - (paper-system-stencil - (vector-ref (ly:paper-score-paper-systems output) 0)) + (stack-stencils Y DOWN baseline-skip + (map paper-system-stencil + (vector->list + (ly:paper-score-paper-systems output)))) (begin (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?")) empty-stencil)))) -(define-builtin-markup-command (null layout props) - () - other +(define-markup-command (null layout props) () + #:category other " @cindex creating empty text objects An empty markup with extents of a single point. @lilypond[verbatim,quote] -\\markup \\null +\\markup { + \\null +} @end lilypond" point-stencil) @@ -567,16 +906,18 @@ An empty markup with extents of a single point. ;; basic formatting. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (simple layout props str) +(define-markup-command (simple layout props str) (string?) - font - () + #:category font " @cindex simple text strings A simple text string; @code{\\markup @{ foo @}} is equivalent with @code{\\markup @{ \\simple #\"foo\" @}}. +Note: for creating standard text markup or defining new markup commands, +the use of @code{\\simple} is unnecessary. + @lilypond[verbatim,quote] \\markup { \\simple #\"simple\" @@ -586,149 +927,187 @@ A simple text string; @code{\\markup @{ foo @}} is equivalent with @end lilypond" (interpret-markup layout props str)) -(define-builtin-markup-command (tied-lyric layout props str) +(define-markup-command (tied-lyric layout props str) (string?) - music - () + #: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) '()) - + ;; special case first padding ((= (length text-widths) word-count) - (cons + (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)))))) - -(define-builtin-markup-command (fill-line layout props markups) + (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?) - align - ((text-direction RIGHT) - (word-space 1) - (line-width #f)) + #:category align + #: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 spaced or flushed to fill the entire line. If there are no arguments, return an empty stencil. @lilypond[verbatim,quote] -\\markup \\column { - \\fill-line { - Words evenly spaced across the page +\\markup { + \\column { + \\fill-line { + Words evenly spaced across the page + } + \\null + \\fill-line { + \\line { Text markups } + \\line { + \\italic { evenly spaced } + } + \\line { across the page } + } } - \\null - \\fill-line { - \\line { Text markups } - \\line \\italic { evenly spaced } - \\line { across the page } - } -} -@end lilypond" - (let* ((orig-stencils (interpret-markup-list layout props markups)) - (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)) - (prop-line-width (chain-assoc-get 'line-width props #f)) - (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))) +} +@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)))) + + (line-contents (if (= word-count 1) + (list + point-stencil + (car stencils) + point-stencil) + stencils))) (if (null? (remove ly:stencil-empty? orig-stencils)) - empty-stencil - (stack-stencils-padding-list X - RIGHT fill-space-normal line-stencils)))) - -(define-builtin-markup-command (line layout props args) + 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?) - align - ((word-space) - (text-direction RIGHT)) + #:category align + #:properties ((word-space) + (text-direction RIGHT)) "Put @var{args} in a horizontal line. The property @code{word-space} -determines the space between each markup in @var{args}. +determines the space between markups in @var{args}. @lilypond[verbatim,quote] -\\markup \\line { - A simple line of text +\\markup { + \\line { + one two three + } } @end lilypond" (let ((stencils (interpret-markup-list layout props args))) @@ -738,25 +1117,24 @@ determines the space between each markup in @var{args}. word-space (remove ly:stencil-empty? stencils)))) -(define-builtin-markup-command (concat layout props args) +(define-markup-command (concat layout props args) (markup-list?) - align - () + #:category align " @cindex concatenating text @cindex ligatures in text -Concatenate @var{args} in a horizontal line, without spaces inbetween. +Concatenate @var{args} in a horizontal line, without spaces in between. Strings and simple markups are concatenated on the input level, allowing ligatures. For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is equivalent to @code{\"fi\"}. @lilypond[verbatim,quote] -\\markup \\bold { - au +\\markup { \\concat { - Mouv - \\super t + one + two + three } } @end lilypond" @@ -781,7 +1159,7 @@ equivalent to @code{\"fi\"}. (define (wordwrap-stencils stencils justify base-space line-width text-dir) - "Perform simple wordwrap, return stencil of each line." + "Perform simple wordwrap, return stencil of each line." (define space (if justify ;; justify only stretches lines. (* 0.7 base-space) @@ -811,7 +1189,7 @@ equivalent to @code{\"fi\"}. 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. + ;; hmmm . bug - will overstretch the last line in some case. ((null? (cdr line-break)) base-space) ((null? line-stencils) 0.0) @@ -833,11 +1211,11 @@ equivalent to @code{\"fi\"}. X))) (reverse (cons line lines))))))) -(define-builtin-markup-list-command (wordwrap-internal layout props justify args) +(define-markup-list-command (wordwrap-internal layout props justify args) (boolean? markup-list?) - ((line-width #f) - (word-space) - (text-direction RIGHT)) + #:properties ((line-width #f) + (word-space) + (text-direction RIGHT)) "Internal markup list command used to define @code{\\justify} and @code{\\wordwrap}." (wordwrap-stencils (remove ly:stencil-empty? (interpret-markup-list layout props args)) @@ -847,35 +1225,57 @@ equivalent to @code{\"fi\"}. (ly:output-def-lookup layout 'line-width)) text-direction)) -(define-builtin-markup-command (justify layout props args) +(define-markup-command (justify layout props args) (markup-list?) - align - ((baseline-skip) - wordwrap-internal-markup-list) + #:category align + #:properties ((baseline-skip) + wordwrap-internal-markup-list) " @cindex justifying text -Like wordwrap, but with lines stretched to justify the margins. +Like @code{\\wordwrap}, but with lines stretched to justify the margins. Use @code{\\override #'(line-width . @var{X})} to set the line width; -@var{X}@tie{}is the number of staff spaces." +@var{X}@tie{}is the number of staff spaces. + +@lilypond[verbatim,quote] +\\markup { + \\justify { + 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. + } +} +@end lilypond" (stack-lines DOWN 0.0 baseline-skip (wordwrap-internal-markup-list layout props #t args))) -(define-builtin-markup-command (wordwrap layout props args) +(define-markup-command (wordwrap layout props args) (markup-list?) - align - ((baseline-skip) - wordwrap-internal-markup-list) + #:category align + #:properties ((baseline-skip) + wordwrap-internal-markup-list) "Simple wordwrap. Use @code{\\override #'(line-width . @var{X})} to set -the line width, where @var{X} is the number of staff spaces." +the line width, where @var{X} is the number of staff spaces. + +@lilypond[verbatim,quote] +\\markup { + \\wordwrap { + 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. + } +} +@end lilypond" (stack-lines DOWN 0.0 baseline-skip (wordwrap-internal-markup-list layout props #f args))) -(define-builtin-markup-list-command (wordwrap-string-internal layout props justify arg) +(define-markup-list-command (wordwrap-string-internal layout props justify arg) (boolean? string?) - ((line-width) - (word-space) - (text-direction RIGHT)) + #:properties ((line-width) + (word-space) + (text-direction RIGHT)) "Internal markup list command used to define @code{\\justify-string} and @code{\\wordwrap-string}." (let* ((para-strings (regexp-split @@ -898,106 +1298,208 @@ the line width, where @var{X} is the number of staff spaces." list-para-words))) (apply append para-lines))) -(define-builtin-markup-command (wordwrap-string layout props arg) +(define-markup-command (wordwrap-string layout props arg) (string?) - align - ((baseline-skip) - wordwrap-string-internal-markup-list) - "Wordwrap a string. Paragraphs may be separated with double newlines." + #:category align + #:properties ((baseline-skip) + wordwrap-string-internal-markup-list) + "Wordwrap a string. Paragraphs may be separated with double newlines. + +@lilypond[verbatim,quote] +\\markup { + \\override #'(line-width . 40) + \\wordwrap-string #\"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. + + + Excepteur sint occaecat cupidatat non proident, sunt in culpa + qui officia deserunt mollit anim id est laborum\" +} +@end lilypond" (stack-lines DOWN 0.0 baseline-skip (wordwrap-string-internal-markup-list layout props #f arg))) -(define-builtin-markup-command (justify-string layout props arg) +(define-markup-command (justify-string layout props arg) (string?) - align - ((baseline-skip) - wordwrap-string-internal-markup-list) - "Justify a string. Paragraphs may be separated with double newlines" + #:category align + #:properties ((baseline-skip) + wordwrap-string-internal-markup-list) + "Justify a string. Paragraphs may be separated with double newlines + +@lilypond[verbatim,quote] +\\markup { + \\override #'(line-width . 40) + \\justify-string #\"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. + + + Excepteur sint occaecat cupidatat non proident, sunt in culpa + qui officia deserunt mollit anim id est laborum\" +} +@end lilypond" (stack-lines DOWN 0.0 baseline-skip (wordwrap-string-internal-markup-list layout props #t arg))) -(define-builtin-markup-command (wordwrap-field layout props symbol) +(define-markup-command (wordwrap-field layout props symbol) (symbol?) - align - () - "Wordwrap the data which has been assigned to @var{symbol}." + #:category align + "Wordwrap the data which has been assigned to @var{symbol}. + +@lilypond[verbatim,quote] +\\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.\" +} + +\\paper { + bookTitleMarkup = \\markup { + \\column { + \\fill-line { \\fromproperty #'header:title } + \\null + \\wordwrap-field #'header:myText + } + } +} + +\\markup { + \\null +} +@end lilypond" (let* ((m (chain-assoc-get symbol props))) (if (string? m) (wordwrap-string-markup layout props m) empty-stencil))) -(define-builtin-markup-command (justify-field layout props symbol) +(define-markup-command (justify-field layout props symbol) (symbol?) - align - () - "Justify the data which has been assigned to @var{symbol}." + #:category align + "Justify the data which has been assigned to @var{symbol}. + +@lilypond[verbatim,quote] +\\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.\" +} + +\\paper { + bookTitleMarkup = \\markup { + \\column { + \\fill-line { \\fromproperty #'header:title } + \\null + \\justify-field #'header:myText + } + } +} + +\\markup { + \\null +} +@end lilypond" (let* ((m (chain-assoc-get symbol props))) (if (string? m) (justify-string-markup layout props m) empty-stencil))) -(define-builtin-markup-command (combine layout props m1 m2) +(define-markup-command (combine layout props arg1 arg2) (markup? markup?) - align - () + #:category align " @cindex merging text 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 + @lilypond[verbatim,quote] \\markup { \\fontsize #5 \\override #'(thickness . 2) \\combine - \\draw-line #'(0 . 4) - \\arrow-head #Y #DOWN ##f + \\draw-line #'(0 . 4) + \\arrow-head #Y #DOWN ##f } @end lilypond" - (let* ((s1 (interpret-markup layout props m1)) - (s2 (interpret-markup layout props m2))) + (let* ((s1 (interpret-markup layout props arg1)) + (s2 (interpret-markup layout props arg2))) (ly:stencil-add s1 s2))) ;; ;; TODO: should extract baseline-skip from each argument somehow.. -;; -(define-builtin-markup-command (column layout props args) +;; +(define-markup-command (column layout props args) (markup-list?) - align - ((baseline-skip)) + #:category align + #:properties ((baseline-skip)) " @cindex stacking text in a column Stack the markups in @var{args} vertically. The property -@code{baseline-skip} determines the space between each -markup in @var{args}. +@code{baseline-skip} determines the space between markups +in @var{args}. @lilypond[verbatim,quote] -\\markup \\column { - one - two - three +\\markup { + \\column { + one + two + three + } } @end lilypond" (let ((arg-stencils (interpret-markup-list layout props args))) (stack-lines -1 0.0 baseline-skip (remove ly:stencil-empty? arg-stencils)))) -(define-builtin-markup-command (dir-column layout props args) +(define-markup-command (dir-column layout props args) (markup-list?) - align - ((direction) - (baseline-skip)) + #:category align + #:properties ((direction) + (baseline-skip)) " @cindex changing direction of text columns -Make a column of args, going up or down, depending on the setting -of the @code{#'direction} layout property. +Make a column of @var{args}, going up or down, depending on the +setting of the @code{direction} layout property. @lilypond[verbatim,quote] \\markup { - \\override #'(direction . 1) - \\dir-column { going up } - \\dir-column { going down } + \\override #`(direction . ,UP) { + \\dir-column { + going up + } + } + \\hspace #1 + \\dir-column { + going down + } + \\hspace #1 + \\override #'(direction . 1) { + \\dir-column { + going up + } + } } @end lilypond" (stack-lines (if (number? direction) direction -1) @@ -1005,160 +1507,262 @@ of the @code{#'direction} layout property. baseline-skip (interpret-markup-list layout props args))) -(define-builtin-markup-command (center-align layout props args) +(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)) + (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?) - align - ((baseline-skip)) + #:category align + #:properties ((baseline-skip)) " @cindex centering a column of text Put @code{args} in a centered column. @lilypond[verbatim,quote] -\\markup \\center-align { - one - two - three +\\markup { + \\center-column { + one + two + three + } } @end lilypond" - (let* ((mols (interpret-markup-list layout props args)) - (cmols (map (lambda (x) (ly:stencil-aligned-to x X CENTER)) mols))) - (stack-lines -1 0.0 baseline-skip cmols))) + (general-column CENTER baseline-skip (interpret-markup-list layout props args))) -(define-builtin-markup-command (vcenter layout props arg) - (markup?) - align - () - " -@cindex vertically centering text +(define-markup-command (left-column layout props args) + (markup-list?) + #:category align + #:properties ((baseline-skip)) + " +@cindex text columns, left-aligned -Align @code{arg} to its Y@tie{}center. +Put @code{args} in a left-aligned column. @lilypond[verbatim,quote] \\markup { - \\arrow-head #X #RIGHT ##f - \\vcenter - Centered - \\arrow-head #X #LEFT ##f + \\left-column { + one + two + three + } } @end lilypond" - (let* ((mol (interpret-markup layout props arg))) - (ly:stencil-aligned-to mol Y CENTER))) + (general-column LEFT baseline-skip (interpret-markup-list layout props args))) -(define-builtin-markup-command (hcenter layout props arg) +(define-markup-command (right-column layout props args) + (markup-list?) + #:category align + #:properties ((baseline-skip)) + " +@cindex text columns, right-aligned + +Put @code{args} in a right-aligned column. + +@lilypond[verbatim,quote] +\\markup { + \\right-column { + one + two + three + } +} +@end lilypond" + (general-column RIGHT baseline-skip (interpret-markup-list layout props args))) + +(define-markup-command (vcenter layout props arg) (markup?) - align - () + #:category align + " +@cindex vertically centering text + +Align @code{arg} to its Y@tie{}center. + +@lilypond[verbatim,quote] +\\markup { + one + \\vcenter + two + three +} +@end lilypond" + (let* ((mol (interpret-markup layout props arg))) + (ly:stencil-aligned-to mol Y CENTER))) + +(define-markup-command (center-align layout props arg) + (markup?) + #:category align " @cindex horizontally centering text Align @code{arg} to its X@tie{}center. @lilypond[verbatim,quote] -\\markup \\column { - ↓ - \\hcenter - centered +\\markup { + \\column { + one + \\center-align + two + three + } } @end lilypond" (let* ((mol (interpret-markup layout props arg))) (ly:stencil-aligned-to mol X CENTER))) -(define-builtin-markup-command (right-align layout props arg) +(define-markup-command (right-align layout props arg) (markup?) - align - () + #:category align " @cindex right aligning text Align @var{arg} on its right edge. @lilypond[verbatim,quote] -\\markup \\column { - ↓ - \\right-align - right-aligned +\\markup { + \\column { + one + \\right-align + two + three + } } @end lilypond" (let* ((m (interpret-markup layout props arg))) (ly:stencil-aligned-to m X RIGHT))) -(define-builtin-markup-command (left-align layout props arg) +(define-markup-command (left-align layout props arg) (markup?) - align - () + #:category align " @cindex left aligning text Align @var{arg} on its left edge. @lilypond[verbatim,quote] -\\markup \\column { - ↓ - \\left-align - left-aligned +\\markup { + \\column { + one + \\left-align + two + three + } } @end lilypond" (let* ((m (interpret-markup layout props arg))) (ly:stencil-aligned-to m X LEFT))) -(define-builtin-markup-command (general-align layout props axis dir arg) +(define-markup-command (general-align layout props axis dir arg) (integer? number? markup?) - align - () + #:category align " @cindex controlling general text alignment -Align @var{arg} in @var{axis} direction to the @var{dir} side." +Align @var{arg} in @var{axis} direction to the @var{dir} side. + +@lilypond[verbatim,quote] +\\markup { + \\column { + one + \\general-align #X #LEFT + two + three + \\null + one + \\general-align #X #CENTER + two + three + \\null + \\line { + one + \\general-align #Y #UP + two + three + } + \\null + \\line { + one + \\general-align #Y #3.2 + two + three + } + } +} +@end lilypond" (let* ((m (interpret-markup layout props arg))) (ly:stencil-aligned-to m axis dir))) -(define-builtin-markup-command (halign layout props dir arg) +(define-markup-command (halign layout props dir arg) (number? markup?) - align - () + #:category align " @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. @lilypond[verbatim,quote] -\\markup \\column { - ↓ - \\halign #LEFT - Left - ↓ - \\halign #CENTER - Center - ↓ - \\halign #RIGHT - Right - ↓ - \\halign #1.2 - \\line { Arbitrary alignment } +\\markup { + \\column { + one + \\halign #LEFT + two + three + \\null + one + \\halign #CENTER + two + three + \\null + one + \\halign #RIGHT + two + three + \\null + one + \\halign #-5 + two + three + } } @end lilypond" (let* ((m (interpret-markup layout props arg))) (ly:stencil-aligned-to m X dir))) -(define-builtin-markup-command (with-dimensions layout props x y arg) +(define-markup-command (with-dimensions layout props x y arg) (number-pair? number-pair? markup?) - other - () + #:category other " @cindex setting extent of text objects -Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}." +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))) -(define-builtin-markup-command (pad-around layout props amount arg) +(define-markup-command (pad-around layout props amount arg) (number? markup?) - align - () - "Add padding @var{amount} all around @var{arg}." + #:category align + "Add padding @var{amount} all around @var{arg}. + +@lilypond[verbatim,quote] +\\markup { + \\box { + default + } + \\hspace #2 + \\box { + \\pad-around #0.5 { + padded + } + } +} +@end lilypond" (let* ((m (interpret-markup layout props arg)) (x (ly:stencil-extent m X)) (y (ly:stencil-extent m Y))) @@ -1166,14 +1770,27 @@ Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}." (interval-widen x amount) (interval-widen y amount)))) -(define-builtin-markup-command (pad-x layout props amount arg) +(define-markup-command (pad-x layout props amount arg) (number? markup?) - align - () + #:category align " @cindex padding text horizontally -Add padding @var{amount} around @var{arg} in the X@tie{}direction." +Add padding @var{amount} around @var{arg} in the X@tie{}direction. + +@lilypond[verbatim,quote] +\\markup { + \\box { + default + } + \\hspace #4 + \\box { + \\pad-x #2 { + padded + } + } +} +@end lilypond" (let* ((m (interpret-markup layout props arg)) (x (ly:stencil-extent m X)) (y (ly:stencil-extent m Y))) @@ -1181,30 +1798,49 @@ Add padding @var{amount} around @var{arg} in the X@tie{}direction." (interval-widen x amount) y))) -(define-builtin-markup-command (put-adjacent layout props arg1 axis dir arg2) - (markup? integer? ly:dir? markup?) - align - () +(define-markup-command (put-adjacent layout props axis dir arg1 arg2) + (integer? ly:dir? markup? markup?) + #:category align "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}." (let ((m1 (interpret-markup layout props arg1)) (m2 (interpret-markup layout props arg2))) (ly:stencil-combine-at-edge m1 axis dir m2 0.0))) -(define-builtin-markup-command (transparent layout props arg) +(define-markup-command (transparent layout props arg) (markup?) - other - () - "Make the argument transparent." + #:category other + "Make @var{arg} transparent. + +@lilypond[verbatim,quote] +\\markup { + \\transparent { + invisible text + } +} +@end lilypond" (let* ((m (interpret-markup layout props arg)) (x (ly:stencil-extent m X)) (y (ly:stencil-extent m Y))) (ly:make-stencil "" x y))) -(define-builtin-markup-command (pad-to-box layout props x-ext y-ext arg) +(define-markup-command (pad-to-box layout props x-ext y-ext arg) (number-pair? number-pair? markup?) - align - () - "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space." + #:category align + "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space. + +@lilypond[verbatim,quote] +\\markup { + \\box { + default + } + \\hspace #4 + \\box { + \\pad-to-box #'(0 . 10) #'(0 . 3) { + padded + } + } +} +@end lilypond" (let* ((m (interpret-markup layout props arg)) (x (ly:stencil-extent m X)) (y (ly:stencil-extent m Y))) @@ -1212,38 +1848,78 @@ Add padding @var{amount} around @var{arg} in the X@tie{}direction." (interval-union x-ext x) (interval-union y-ext y)))) -(define-builtin-markup-command (hcenter-in layout props length arg) +(define-markup-command (hcenter-in layout props length arg) (number? markup?) - align - () + #:category align "Center @var{arg} horizontally within a box of extending -@var{length}/2 to the left and right." +@var{length}/2 to the left and right. + +@lilypond[quote,verbatim] +\\new StaffGroup << + \\new Staff { + \\set Staff.instrumentName = \\markup { + \\hcenter-in #12 + Oboe + } + c''1 + } + \\new Staff { + \\set Staff.instrumentName = \\markup { + \\hcenter-in #12 + Bassoon + } + \\clef tenor + c'1 + } +>> +@end lilypond" (interpret-markup layout props (make-pad-to-box-markup (cons (/ length -2) (/ length 2)) '(0 . 0) - (make-hcenter-markup arg)))) + (make-center-align-markup arg)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; property ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (fromproperty layout props symbol) +(define-markup-command (property-recursive layout props symbol) (symbol?) - other - () + #: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 "Read the @var{symbol} from property settings, and produce a stencil from the markup contained within. If @var{symbol} is not defined, it -returns an empty markup." +returns an empty markup. + +@lilypond[verbatim,quote] +\\header { + myTitle = \"myTitle\" + title = \\markup { + from + \\italic + \\fromproperty #'header:myTitle + } +} +\\markup { + \\null +} +@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-builtin-markup-command (on-the-fly layout props procedure arg) - (symbol? markup?) - other - () +(define-markup-command (on-the-fly layout props procedure arg) + (procedure? markup?) + #:category other "Apply the @var{procedure} markup command to @var{arg}. @var{procedure} should take a single argument." (let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg)))) @@ -1252,34 +1928,138 @@ returns an empty markup." (list markup?)) (interpret-markup layout props (list anonymous-with-signature arg)))) -(define-builtin-markup-command (override layout props new-prop 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?) - other - () + #:category other " @cindex overriding properties within text markup -Add the first argument in to the property list. Properties may be -any sort of property supported by @rinternals{font-interface} and -@rinternals{text-interface}, for example +Add the argument @var{new-prop} to the property list. Properties +may be any property supported by @rinternals{font-interface}, +@rinternals{text-interface} and +@rinternals{instrument-specific-markup-interface}. -@example -\\override #'(font-family . married) \"bla\" -@end example" +@lilypond[verbatim,quote] +\\markup { + \\line { + \\column { + default + baseline-skip + } + \\hspace #2 + \\override #'(baseline-skip . 4) { + \\column { + increased + baseline-skip + } + } + } +} +@end lilypond" (interpret-markup layout (cons (list new-prop) props) arg)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (verbatim-file layout props name) +(define-markup-command (verbatim-file layout props name) (string?) - other - () - "Read the contents of a file, and include it verbatim. + #:category other + "Read the contents of file @var{name}, and include it verbatim. @lilypond[verbatim,quote] -\\markup \\verbatim-file #\"simple.ly\" +\\markup { + \\verbatim-file #\"simple.ly\" +} @end lilypond" (interpret-markup layout props (if (ly:get-option 'safe) @@ -1293,43 +2073,32 @@ any sort of property supported by @rinternals{font-interface} and ;; fonts. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (bigger layout props arg) - (markup?) - font - () - "Increase the font size relative to current setting. -@lilypond[verbatim,quote] -\\markup \\bigger { - Voici venir les temps où vibrant sur sa tige -} -@end lilypond" - (interpret-markup layout props - `(,fontsize-markup 1 ,arg))) - -(define-builtin-markup-command (smaller layout props arg) +(define-markup-command (smaller layout props arg) (markup?) - font - () - "Decrease the font size relative to current setting. - + #:category font + "Decrease the font size relative to the current setting. + @lilypond[verbatim,quote] -\\markup \\fontsize #3 { - some large text - \\hspace #2 - \\smaller { - a bit smaller +\\markup { + \\fontsize #3.5 { + some large text + \\hspace #2 + \\smaller { + a bit smaller + } + \\hspace #2 + more large text } } @end lilypond" (interpret-markup layout props `(,fontsize-markup -1 ,arg))) -(define-builtin-markup-command (larger layout props arg) +(define-markup-command (larger layout props arg) (markup?) - font - () - "Copy of the @code{\\bigger} command. + #:category font + "Increase the font size relative to the current setting. @lilypond[verbatim,quote] \\markup { @@ -1339,44 +2108,83 @@ any sort of property supported by @rinternals{font-interface} and larger } @end lilypond" - (interpret-markup layout props (make-bigger-markup arg))) + (interpret-markup layout props + `(,fontsize-markup 1 ,arg))) -(define-builtin-markup-command (finger layout props arg) +(define-markup-command (finger layout props arg) (markup?) - font - () - "Set the argument as small numbers. + #:category font + "Set @var{arg} as small numbers. + @lilypond[verbatim,quote] -\\markup \\finger { - 1 2 3 4 5 +\\markup { + \\finger { + 1 2 3 4 5 + } } @end lilypond" (interpret-markup layout - (cons '((font-size . -5) (font-encoding . fetaNumber)) props) + (cons '((font-size . -5) (font-encoding . fetaText)) props) arg)) -(define-builtin-markup-command (fontsize layout props increment arg) +(define-markup-command (abs-fontsize layout props size arg) (number? markup?) - font - ((font-size 0) - (word-space 1) - (baseline-skip 2)) - "Add @var{increment} to the font-size. Adjust baseline skip accordingly. + #:category font + "Use @var{size} as the absolute font size to display @var{arg}. +Adjusts @code{baseline-skip} and @code{word-space} accordingly. + @lilypond[verbatim,quote] -\\markup \\fontsize #-1.5 { - Valse mélancolique et langoureux vertige! +\\markup { + default text font size + \\hspace #2 + \\abs-fontsize #16 { text font size 16 } + \\hspace #2 + \\abs-fontsize #12 { text font size 12 } +} +@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))) + +(define-markup-command (fontsize layout props increment arg) + (number? markup?) + #:category font + #:properties ((font-size 0) + (word-space 1) + (baseline-skip 2)) + "Add @var{increment} to the font-size. Adjusts @code{baseline-skip} +accordingly. + +@lilypond[verbatim,quote] +\\markup { + default + \\hspace #2 + \\fontsize #-1.5 + 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-builtin-markup-command (magnify layout props sz arg) +(define-markup-command (magnify layout props sz arg) (number? markup?) - font - () + #:category font " @cindex magnifying text @@ -1400,29 +2208,30 @@ Use @code{\\fontsize} otherwise. } @end lilypond" (interpret-markup - layout + layout (prepend-alist-chain 'font-size (magnification->font-size sz) props) arg)) -(define-builtin-markup-command (bold layout props arg) +(define-markup-command (bold layout props arg) (markup?) - font - () + #:category font "Switch to bold font-series. - + @lilypond[verbatim,quote] -\\markup \\bold { - Chaque fleur s'évapore ainsi qu'un encensoir +\\markup { + default + \\hspace #2 + \\bold + bold } @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg)) -(define-builtin-markup-command (sans layout props arg) +(define-markup-command (sans layout props arg) (markup?) - font - () - "Switch to the sans serif family. - + #:category font + "Switch to the sans serif font family. + @lilypond[verbatim,quote] \\markup { default @@ -1434,44 +2243,45 @@ Use @code{\\fontsize} otherwise. @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg)) -(define-builtin-markup-command (number layout props arg) +(define-markup-command (number layout props arg) (markup?) - font - () + #:category font "Set font family to @code{number}, which yields the font used for -time signatures and fingerings. This font only contains numbers and -some punctuation. It doesn't have any letters. +time signatures and fingerings. This font contains numbers and +some punctuation; it has no letters. @lilypond[verbatim,quote] -\\markup \\number { - 0 1 2 3 4 5 6 7 8 9 . , +\\markup { + \\number { + 0 1 2 3 4 5 6 7 8 9 . , + } } @end lilypond" - (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaNumber props) arg)) + (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaText props) arg)) -(define-builtin-markup-command (roman layout props arg) +(define-markup-command (roman layout props arg) (markup?) - font - () + #:category font "Set font family to @code{roman}. - + @lilypond[verbatim,quote] -\\markup \\sans \\bold { - bold sans serif - \\hspace #2 - \\roman { - text in roman font family +\\markup { + \\sans \\bold { + sans serif, bold + \\hspace #2 + \\roman { + text in roman font family + } + \\hspace #2 + return to sans } - \\hspace #2 - return to sans } @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg)) -(define-builtin-markup-command (huge layout props arg) +(define-markup-command (huge layout props arg) (markup?) - font - () + #:category font "Set font size to +2. @lilypond[verbatim,quote] @@ -1484,10 +2294,9 @@ some punctuation. It doesn't have any letters. @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg)) -(define-builtin-markup-command (large layout props arg) +(define-markup-command (large layout props arg) (markup?) - font - () + #:category font "Set font size to +1. @lilypond[verbatim,quote] @@ -1500,31 +2309,31 @@ some punctuation. It doesn't have any letters. @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg)) -(define-builtin-markup-command (normalsize layout props arg) +(define-markup-command (normalsize layout props arg) (markup?) - font - () + #:category font "Set font size to default. - + @lilypond[verbatim,quote] -\\markup \\teeny { - this is very small - \\hspace #1 - \\normalsize { - revert to normal size +\\markup { + \\teeny { + this is very small + \\hspace #2 + \\normalsize { + normal size + } + \\hspace #2 + teeny again } - \\hspace #1 - teeny again } @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg)) -(define-builtin-markup-command (small layout props arg) +(define-markup-command (small layout props arg) (markup?) - font - () + #:category font "Set font size to -1. - + @lilypond[verbatim,quote] \\markup { default @@ -1535,12 +2344,11 @@ some punctuation. It doesn't have any letters. @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg)) -(define-builtin-markup-command (tiny layout props arg) +(define-markup-command (tiny layout props arg) (markup?) - font - () + #:category font "Set font size to -2. - + @lilypond[verbatim,quote] \\markup { default @@ -1551,12 +2359,11 @@ some punctuation. It doesn't have any letters. @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg)) -(define-builtin-markup-command (teeny layout props arg) +(define-markup-command (teeny layout props arg) (markup?) - font - () + #:category font "Set font size to -3. - + @lilypond[verbatim,quote] \\markup { default @@ -1567,18 +2374,19 @@ some punctuation. It doesn't have any letters. @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg)) -(define-builtin-markup-command (fontCaps layout props arg) +(define-markup-command (fontCaps layout props arg) (markup?) - font - () - "Set @code{font-shape} to @code{caps}" + #:category font + "Set @code{font-shape} to @code{caps} + +Note: @code{\\fontCaps} requires the installation and selection of +fonts which support the @code{caps} font shape." (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg)) ;; Poor man's caps -(define-builtin-markup-command (smallCaps layout props text) +(define-markup-command (smallCaps layout props arg) (markup?) - font - () + #:category font "Emit @var{arg} as small caps. Note: @code{\\smallCaps} does not support accented characters. @@ -1619,50 +2427,57 @@ Note: @code{\\smallCaps} does not support accented characters. currents current-is-lower) prev-result))))))) (interpret-markup layout props - (if (string? text) - (make-small-caps (string->list text) (list) #f (list)) - text))) + (if (string? arg) + (make-small-caps (string->list arg) (list) #f (list)) + arg))) -(define-builtin-markup-command (caps layout props arg) +(define-markup-command (caps layout props arg) (markup?) - font - () + #:category font "Copy of the @code{\\smallCaps} command. @lilypond[verbatim,quote] -\\markup \\caps { - Les sons et les parfums tournent dans l'air du soir +\\markup { + default + \\hspace #2 + \\caps { + Text in small caps + } } @end lilypond" (interpret-markup layout props (make-smallCaps-markup arg))) -(define-builtin-markup-command (dynamic layout props arg) +(define-markup-command (dynamic layout props arg) (markup?) - font - () + #:category font "Use the dynamic font. This font only contains @b{s}, @b{f}, @b{m}, @b{z}, @b{p}, and @b{r}. When producing phrases, like @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be done in a different font. The recommended font for this is bold and italic. @lilypond[verbatim,quote] -\\markup \\dynamic { sfzp } +\\markup { + \\dynamic { + sfzp + } +} @end lilypond" (interpret-markup - layout (prepend-alist-chain 'font-encoding 'fetaDynamic props) arg)) + layout (prepend-alist-chain 'font-encoding 'fetaText props) arg)) -(define-builtin-markup-command (text layout props arg) +(define-markup-command (text layout props arg) (markup?) - font - () + #:category font "Use a text font instead of music symbol or music alphabet font. - + @lilypond[verbatim,quote] -\\markup \\number { - 1, 2, - \\text { - three, four, +\\markup { + \\number { + 1, 2, + \\text { + three, four, + } + 5 } - 5 } @end lilypond" @@ -1670,25 +2485,26 @@ done in a different font. The recommended font for this is bold and italic. (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props) arg)) -(define-builtin-markup-command (italic layout props arg) +(define-markup-command (italic layout props arg) (markup?) - font - () + #:category font "Use italic @code{font-shape} for @var{arg}. @lilypond[verbatim,quote] -\\markup \\italic { - scherzando e leggiero +\\markup { + default + \\hspace #2 + \\italic + italic } @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg)) -(define-builtin-markup-command (typewriter layout props arg) +(define-markup-command (typewriter layout props arg) (markup?) - font - () + #:category font "Use @code{font-family} typewriter for @var{arg}. - + @lilypond[verbatim,quote] \\markup { default @@ -1700,62 +2516,66 @@ done in a different font. The recommended font for this is bold and italic. (interpret-markup layout (prepend-alist-chain 'font-family 'typewriter props) arg)) -(define-builtin-markup-command (upright layout props arg) +(define-markup-command (upright layout props arg) (markup?) - font - () - "Set font shape to @code{upright}. This is the opposite of @code{italic}. + #:category font + "Set @code{font-shape} to @code{upright}. This is the opposite +of @code{italic}. @lilypond[verbatim,quote] -\\markup \\italic { - italic text - \\hspace #2 - \\upright { - upright text +\\markup { + \\italic { + italic text + \\hspace #2 + \\upright { + upright text + } + \\hspace #2 + italic again } - \\hspace #2 - italic again } @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-shape 'upright props) arg)) -(define-builtin-markup-command (medium layout props arg) +(define-markup-command (medium layout props arg) (markup?) - font - () - "Switch to medium font series (in contrast to bold). + #:category font + "Switch to medium font-series (in contrast to bold). @lilypond[verbatim,quote] -\\markup \\bold { - some bold text - \\hspace #2 - \\medium { - medium font series +\\markup { + \\bold { + some bold text + \\hspace #2 + \\medium { + medium font series + } + \\hspace #2 + bold again } - \\hspace #2 - bold again } @end lilypond" (interpret-markup layout (prepend-alist-chain 'font-series 'medium props) arg)) -(define-builtin-markup-command (normal-text layout props arg) +(define-markup-command (normal-text layout props arg) (markup?) - font - () + #:category font "Set all font related properties (except the size) to get the default normal text font, no matter what font was used earlier. @lilypond[verbatim,quote] -\\markup \\huge \\bold \\sans \\caps { - Some text with font overrides - \\hspace #2 - \\normal-text { - Default text, same font-size +\\markup { + \\huge \\bold \\sans \\caps { + huge bold sans caps + \\hspace #2 + \\normal-text { + huge normal + } + \\hspace #2 + as before } - \\hspace #2 - More text } @end lilypond" ;; ugh - latin1 @@ -1769,203 +2589,228 @@ normal text font, no matter what font was used earlier. ;; symbols. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (doublesharp layout props) - () - music +(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 "Draw a double sharp symbol. @lilypond[verbatim,quote] -\\markup { \\doublesharp } +\\markup { + \\doublesharp +} @end lilypond" (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist "")))) -(define-builtin-markup-command (sesquisharp layout props) - () - music +(define-markup-command (sesquisharp layout props) () + #:category music "Draw a 3/2 sharp symbol. @lilypond[verbatim,quote] -\\markup { \\sesquisharp } +\\markup { + \\sesquisharp +} @end lilypond" - (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist "")))) + (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist "")))) -(define-builtin-markup-command (sharp layout props) - () - music +(define-markup-command (sharp layout props) () + #:category music "Draw a sharp symbol. @lilypond[verbatim,quote] -\\markup { \\sharp } +\\markup { + \\sharp +} @end lilypond" (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist "")))) -(define-builtin-markup-command (semisharp layout props) +(define-markup-command (semisharp layout props) () - music - () - "Draw a semi sharp symbol. + #:category music + "Draw a semisharp symbol. @lilypond[verbatim,quote] -\\markup { \\semisharp } +\\markup { + \\semisharp +} @end lilypond" (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist "")))) -(define-builtin-markup-command (natural layout props) - () - music +(define-markup-command (natural layout props) () + #:category music "Draw a natural symbol. @lilypond[verbatim,quote] -\\markup { \\natural } +\\markup { + \\natural +} @end lilypond" (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist "")))) -(define-builtin-markup-command (semiflat layout props) - () - music +(define-markup-command (semiflat layout props) () + #:category music "Draw a semiflat symbol. @lilypond[verbatim,quote] -\\markup { \\semiflat } +\\markup { + \\semiflat +} @end lilypond" (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist "")))) -(define-builtin-markup-command (flat layout props) - () - music +(define-markup-command (flat layout props) () + #:category music "Draw a flat symbol. @lilypond[verbatim,quote] -\\markup { \\flat } +\\markup { + \\flat +} @end lilypond" (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist "")))) -(define-builtin-markup-command (sesquiflat layout props) - () - music +(define-markup-command (sesquiflat layout props) () + #:category music "Draw a 3/2 flat symbol. @lilypond[verbatim,quote] -\\markup { \\sesquiflat } +\\markup { + \\sesquiflat +} @end lilypond" (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist "")))) -(define-builtin-markup-command (doubleflat layout props) - () - music +(define-markup-command (doubleflat layout props) () + #:category music "Draw a double flat symbol. @lilypond[verbatim,quote] -\\markup { \\doubleflat } +\\markup { + \\doubleflat +} @end lilypond" (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist "")))) -(define-builtin-markup-command (with-color layout props color arg) +(define-markup-command (with-color layout props color arg) (color? markup?) - other - () + #:category other " @cindex coloring text -Draw @var{arg} in color specified by @var{color}." +Draw @var{arg} in color specified by @var{color}. + +@lilypond[verbatim,quote] +\\markup { + \\with-color #red + red + \\hspace #2 + \\with-color #green + green + \\hspace #2 + \\with-color #blue + blue +} +@end lilypond" (let ((stil (interpret-markup layout props arg))) (ly:make-stencil (list 'color color (ly:stencil-expr stil)) (ly:stencil-extent stil X) (ly:stencil-extent stil Y)))) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; glyphs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (arrow-head layout props axis direction filled) +(define-markup-command (arrow-head layout props axis dir filled) (integer? ly:dir? boolean?) - graphic - () + #:category graphic "Produce an arrow head in specified direction and axis. Use the filled head if @var{filled} is specified. @lilypond[verbatim,quote] \\markup { - \\fontsize #5 - \\general-align #Y #DOWN { - \\arrow-head #Y #UP ##t - \\arrow-head #Y #DOWN ##f - \\hspace #2 - \\arrow-head #X #RIGHT ##f - \\arrow-head #X #LEFT ##f + \\fontsize #5 { + \\general-align #Y #DOWN { + \\arrow-head #Y #UP ##t + \\arrow-head #Y #DOWN ##f + \\hspace #2 + \\arrow-head #X #RIGHT ##f + \\arrow-head #X #LEFT ##f + } } } @end lilypond" (let* - ((name (format "arrowheads.~a.~a~a" + ((name (format #f "arrowheads.~a.~a~a" (if filled "close" "open") axis - direction))) + dir))) (ly:font-get-glyph (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props)) name))) -(define-builtin-markup-command (musicglyph layout props glyph-name) +(define-markup-command (lookup layout props glyph-name) (string?) - 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. + #:category other + "Lookup a glyph by name. @lilypond[verbatim,quote] \\markup { - \\musicglyph #\"f\" - \\musicglyph #\"rests.2\" - \\musicglyph #\"clefs.G_change\" + \\override #'(font-encoding . fetaBraces) { + \\lookup #\"brace200\" + \\hspace #2 + \\rotate #180 + \\lookup #\"brace180\" + } } @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)) + (ly:font-get-glyph (ly:paper-get-font layout props) + glyph-name)) +(define-markup-command (char layout props num) + (integer?) + #:category other + "Produce a single character. Characters encoded in hexadecimal +format require the prefix @code{#x}. -(define-builtin-markup-command (lookup layout props glyph-name) - (string?) - other - () - "Lookup a glyph by name. - @lilypond[verbatim,quote] -\\markup \\override #'(font-encoding . fetaBraces) { - \\lookup #\"brace200\" - \\hspace #2 - \\rotate #180 - \\lookup #\"brace180\" +\\markup { + \\char #65 \\char ##x00a9 } @end lilypond" - (ly:font-get-glyph (ly:paper-get-font layout props) - glyph-name)) - -(define-builtin-markup-command (char layout props num) - (integer?) - other - () - "Produce a single character. For example, @code{\\char #65} produces the -letter @q{A}." (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num))) (define number->mark-letter-vector (make-vector 25 #\A)) @@ -1984,16 +2829,15 @@ letter @q{A}." (define (number->markletter-string vec n) "Double letters for big marks." (let* ((lst (vector-length vec))) - + (if (>= n lst) (string-append (number->markletter-string vec (1- (quotient n lst))) (number->markletter-string vec (remainder n lst))) (make-string 1 (vector-ref vec n))))) -(define-builtin-markup-command (markletter layout props num) +(define-markup-command (markletter layout props num) (integer?) - other - () + #:category other "Make a markup letter for @var{num}. The letters start with A to@tie{}Z (skipping letter@tie{}I), and continue with double letters. @@ -2007,10 +2851,9 @@ letter @q{A}." (ly:text-interface::interpret-markup layout props (number->markletter-string number->mark-letter-vector num))) -(define-builtin-markup-command (markalphabet layout props num) +(define-markup-command (markalphabet layout props num) (integer?) - other - () + #:category other "Make a markup letter for @var{num}. The letters start with A to@tie{}Z and continue with double letters. @@ -2025,7 +2868,6 @@ and continue with double letters. (number->markletter-string number->mark-alphabet-vector num))) (define-public (horizontal-slash-interval num forward number-interval mag) - (ly:message "Mag step: ~a" mag) (if forward (cond ;((= num 6) (interval-widen number-interval (* mag 0.5))) ;((= num 5) (interval-widen number-interval (* mag 0.5))) @@ -2062,7 +2904,7 @@ and continue with double letters. ; backward slashes might use slope and point in the other direction! (dy (* mag (if forward 0.4 -0.4))) (number-stencil (interpret-markup layout - (prepend-alist-chain 'font-encoding 'fetaNumber props) + (prepend-alist-chain 'font-encoding 'fetaText props) (number->string num))) (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag)) (center (interval-center (ly:stencil-extent number-stencil Y))) @@ -2071,13 +2913,10 @@ and continue with double letters. (num-y (interval-widen (cons center center) (abs dy))) (is-sane (and (interval-sane? num-x) (interval-sane? num-y))) (slash-stencil (if is-sane - (ly:make-stencil - `(draw-line ,thickness - ,(car num-x) ,(- (interval-center num-y) dy) - ,(cdr num-x) ,(+ (interval-center num-y) dy)) - num-x num-y) + (make-line-stencil thickness + (car num-x) (- (interval-center num-y) dy) + (cdr num-x) (+ (interval-center num-y) dy)) #f))) -(ly:message "Num: ~a, X-interval: ~a" num num-x) (if (ly:stencil? slash-stencil) (begin ; for some numbers we need to shift the slash/backslash up or down to make @@ -2089,11 +2928,11 @@ and continue with double letters. number-stencil)) -(define-builtin-markup-command (slashed-digit layout props num) +(define-markup-command (slashed-digit layout props num) (integer?) - other - ((font-size 0) - (thickness 1.6)) + #:category other + #:properties ((font-size 0) + (thickness 1.6)) " @cindex slashed digits @@ -2108,12 +2947,12 @@ figured bass notation. } @end lilypond" (slashed-digit-internal layout props num #t font-size thickness)) - -(define-builtin-markup-command (backslashed-digit layout props num) + +(define-markup-command (backslashed-digit layout props num) (integer?) - other - ((font-size 0) - (thickness 1.6)) + #:category other + #:properties ((font-size 0) + (thickness 1.6)) " @cindex backslashed digits @@ -2128,52 +2967,154 @@ figured bass notation. } @end lilypond" (slashed-digit-internal layout props num #f font-size thickness)) - + +;; eyeglasses +(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) + () + #:category other + "Prints out eyeglasses, indicating strongly to look at the conductor. +@lilypond[verbatim,quote] +\\markup { \\eyeglasses } +@end lilypond" + (interpret-markup layout props + (make-override-markup '(line-cap-style . butt) + (make-path-markup 0.15 eyeglassespath)))) + +(define-markup-command (left-brace layout props size) + (number?) + #:category other + " +A feta brace in point size @var{size}. + +@lilypond[verbatim,quote] +\\markup { + \\left-brace #35 + \\hspace #2 + \\left-brace #45 +} +@end lilypond" + (let* ((font (ly:paper-get-font layout + (cons '((font-encoding . fetaBraces) + (font-name . #f)) + props))) + (glyph-count (1- (ly:otf-glyph-count font))) + (scale (ly:output-def-lookup layout 'output-scale)) + (scaled-size (/ (ly:pt size) scale)) + (glyph (lambda (n) + (ly:font-get-glyph font (string-append "brace" + (number->string n))))) + (get-y-from-brace (lambda (brace) + (interval-length + (ly:stencil-extent (glyph brace) Y)))) + (find-brace (binary-search 0 glyph-count get-y-from-brace scaled-size)) + (glyph-found (glyph find-brace))) + + (if (or (null? (ly:stencil-expr glyph-found)) + (< scaled-size (interval-length (ly:stencil-extent (glyph 0) Y))) + (> scaled-size (interval-length + (ly:stencil-extent (glyph glyph-count) Y)))) + (begin + (ly:warning (_ "no brace found for point size ~S ") size) + (ly:warning (_ "defaulting to ~S pt") + (/ (* scale (interval-length + (ly:stencil-extent glyph-found Y))) + (ly:pt 1))))) + glyph-found)) + +(define-markup-command (right-brace layout props size) + (number?) + #:category other + " +A feta brace in point size @var{size}, rotated 180 degrees. + +@lilypond[verbatim,quote] +\\markup { + \\right-brace #45 + \\hspace #2 + \\right-brace #35 +} +@end lilypond" + (interpret-markup layout props (markup #:rotate 180 #:left-brace size))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; the note command. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO: better syntax. -(define-builtin-markup-command (note-by-number layout props log dot-count dir) +(define-markup-command (note-by-number layout props log dot-count dir) (number? number? number?) - music - ((font-size 0) - (style '())) + #:category music + #:properties ((font-size 0) + (style '())) " @cindex notes within text by log and dot-count Construct a note symbol, with stem. By using fractional values for -@var{dir}, you can obtain longer or shorter stems. +@var{dir}, longer or shorter stems can be obtained. @lilypond[verbatim,quote] \\markup { \\note-by-number #3 #0 #DOWN - \\hspace #1 + \\hspace #2 \\note-by-number #1 #2 #0.8 } @end lilypond" (define (get-glyph-name-candidates dir log style) (map (lambda (dir-name) - (format "noteheads.~a~a~a" dir-name (min log 2) - (if (and (symbol? style) - (not (equal? 'default style))) - (symbol->string style) - ""))) + (format #f "noteheads.~a~a" dir-name + (if (and (symbol? style) + (not (equal? 'default style))) + (select-head-glyph style (min log 2)) + (min log 2)))) (list (if (= dir UP) "u" "d") "s"))) - + (define (get-glyph-name font cands) (if (null? cands) - "" - (if (ly:stencil-empty? (ly:font-get-glyph font (car cands))) - (get-glyph-name font (cdr cands)) - (car cands)))) - - (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props))) + "" + (if (ly:stencil-empty? (ly:font-get-glyph font (car cands))) + (get-glyph-name font (cdr cands)) + (car cands)))) + + (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) + props))) (size-factor (magstep font-size)) - (stem-length (* size-factor (max 3 (- log 1)))) - (head-glyph-name (get-glyph-name font (get-glyph-name-candidates (sign dir) log style))) + (stem-length (* size-factor (max 3 (- log 1)))) + (head-glyph-name + (let ((result (get-glyph-name font (get-glyph-name-candidates + (sign dir) log style)))) + (if (string-null? result) + ;; If no glyph name can be found, select default heads. 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 + (sign dir) log 'default)) + result))) (head-glyph (ly:font-get-glyph font head-glyph-name)) (attach-indices (ly:note-head::stem-attachment font head-glyph-name)) (stem-thickness (* size-factor 0.13)) @@ -2181,18 +3122,19 @@ Construct a note symbol, with stem. By using fractional values for (attach-off (cons (interval-index (ly:stencil-extent head-glyph X) (* (sign dir) (car attach-indices))) - (* (sign dir) ; fixme, this is inconsistent between X & Y. + (* (sign dir) ; fixme, this is inconsistent between X & Y. (interval-index (ly:stencil-extent head-glyph Y) (cdr attach-indices))))) (stem-glyph (and (> log 0) (ly:round-filled-box (ordered-cons (car attach-off) - (+ (car attach-off) (* (- (sign dir)) stem-thickness))) + (+ (car attach-off) + (* (- (sign dir)) stem-thickness))) (cons (min stemy (cdr attach-off)) (max stemy (cdr attach-off))) (/ stem-thickness 3)))) - + (dot (ly:font-get-glyph font "dots.dot")) (dotwid (interval-length (ly:stencil-extent dot X))) (dots (and (> dot-count 0) @@ -2207,11 +3149,15 @@ Construct a note symbol, with stem. By using fractional values for (string-append "flags." (if (> dir 0) "u" "d") (number->string log))) - (cons (+ (car attach-off) (if (< dir 0) stem-thickness 0)) stemy))))) - - ; If there is a flag on an upstem and the stem is short, move the dots to avoid the flag. - ; 16th notes get a special case because their flags hang lower than any other flags. - (if (and dots (> dir 0) (> log 2) (or (< dir 1.15) (and (= log 4) (< dir 1.3)))) + (cons (+ (car attach-off) (if (< dir 0) + stem-thickness 0)) + stemy))))) + + ;; If there is a flag on an upstem and the stem is short, move the dots + ;; to avoid the flag. 16th notes get a special case because their flags + ;; hang lower than any other flags. + (if (and dots (> dir 0) (> log 2) + (or (< dir 1.15) (and (= log 4) (< dir 1.3)))) (set! dots (ly:stencil-translate-axis dots 0.5 X))) (if flaggl (set! stem-glyph (ly:stencil-add flaggl stem-glyph))) @@ -2228,15 +3174,17 @@ Construct a note symbol, with stem. By using fractional values for stem-glyph))) stem-glyph)) -(define-public log2 +(define-public log2 (let ((divisor (log 2))) (lambda (z) (inexact->exact (/ (log z) divisor))))) (define (parse-simple-duration duration-string) - "Parse the `duration-string', e.g. ''4..'' or ''breve.'', and return a (log dots) list." - (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string))) + "Parse the `duration-string', e.g. ''4..'' or ''breve.'', +and return a (log dots) list." + (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") + duration-string))) (if (and match (string=? duration-string (match:substring match 0))) - (let ((len (match:substring match 1)) + (let ((len (match:substring match 1)) (dots (match:substring match 2))) (list (cond ((string=? len "breve") -1) ((string=? len "longa") -2) @@ -2245,10 +3193,10 @@ Construct a note symbol, with stem. By using fractional values for (if dots (string-length dots) 0))) (ly:error (_ "not a valid duration string: ~a") duration-string)))) -(define-builtin-markup-command (note layout props duration dir) +(define-markup-command (note layout props duration dir) (string? number?) - music - (note-by-number-markup) + #:category music + #:properties (note-by-number-markup) " @cindex notes within text by string @@ -2259,54 +3207,72 @@ a shortened down stem. @lilypond[verbatim,quote] \\markup { - \\override #'(style . cross) - \\note #\"4..\" #UP - \\hspace #1 + \\override #'(style . cross) { + \\note #\"4..\" #UP + } + \\hspace #2 \\note #\"breve\" #0 } @end lilypond" (let ((parsed (parse-simple-duration duration))) (note-by-number-markup layout props (car parsed) (cadr parsed) dir))) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; translating. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (lower layout props amount arg) +(define-markup-command (lower layout props amount arg) (number? markup?) - align - () + #:category align " @cindex lowering text Lower @var{arg} by the distance @var{amount}. -A negative @var{amount} indicates raising; see also @code{\\raise}." +A negative @var{amount} indicates raising; see also @code{\\raise}. + +@lilypond[verbatim,quote] +\\markup { + one + \\lower #3 + two + three +} +@end lilypond" (ly:stencil-translate-axis (interpret-markup layout props arg) (- amount) Y)) -(define-builtin-markup-command (translate-scaled layout props offset arg) +(define-markup-command (translate-scaled layout props offset arg) (number-pair? markup?) - other - ((font-size 0)) + #:category align + #:properties ((font-size 0)) " @cindex translating text @cindex scaling text Translate @var{arg} by @var{offset}, scaling the offset by the -@code{font-size}." +@code{font-size}. + +@lilypond[verbatim,quote] +\\markup { + \\fontsize #5 { + * \\translate #'(2 . 3) translate + \\hspace #2 + * \\translate-scaled #'(2 . 3) translate-scaled + } +} +@end lilypond" (let* ((factor (magstep font-size)) (scaled (cons (* factor (car offset)) (* factor (cdr offset))))) (ly:stencil-translate (interpret-markup layout props arg) scaled))) -(define-builtin-markup-command (raise layout props amount arg) +(define-markup-command (raise layout props amount arg) (number? markup?) - align - () + #:category align " @cindex raising text - + Raise @var{arg} by the distance @var{amount}. A negative @var{amount} indicates lowering, see also @code{\\lower}. @@ -2321,14 +3287,20 @@ positions it next to the staff cancels any shift made with and/or @code{extra-offset} properties. @lilypond[verbatim,quote] -\\markup { C \\small \\raise #1.0 \\bold 9/7+ } +\\markup { + C + \\small + \\bold + \\raise #1.0 + 9/7+ +} @end lilypond" (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y)) -(define-builtin-markup-command (fraction layout props arg1 arg2) +(define-markup-command (fraction layout props arg1 arg2) (markup? markup?) - other - ((font-size 0)) + #:category other + #:properties ((font-size 0)) " @cindex creating text fractions @@ -2361,10 +3333,10 @@ Make a fraction of two markups. ;; empirical anyway (ly:stencil-translate-axis stack offset Y)))) -(define-builtin-markup-command (normal-size-super layout props arg) +(define-markup-command (normal-size-super layout props arg) (markup?) - font - ((baseline-skip)) + #:category font + #:properties ((baseline-skip)) " @cindex setting superscript in standard font size @@ -2382,16 +3354,15 @@ Set @var{arg} in superscript with a normal font size. (interpret-markup layout props arg) (* 0.5 baseline-skip) Y)) -(define-builtin-markup-command (super layout props arg) +(define-markup-command (super layout props arg) (markup?) - font - ((font-size 0) - (baseline-skip)) - " + #:category font + #:properties ((font-size 0) + (baseline-skip)) + " @cindex superscript text -Raising and lowering texts can be done with @code{\\super} and -@code{\\sub}: +Set @var{arg} in superscript. @lilypond[verbatim,quote] \\markup { @@ -2411,41 +3382,44 @@ Raising and lowering texts can be done with @code{\\super} and (* 0.5 baseline-skip) Y)) -(define-builtin-markup-command (translate layout props offset arg) +(define-markup-command (translate layout props offset arg) (number-pair? markup?) - align - () + #:category align " @cindex translating text - -This translates an object. Its first argument is a cons of numbers. -@example -A \\translate #(cons 2 -3) @{ B C @} D -@end example +Translate @var{arg} relative to its surroundings. @var{offset} +is a pair of numbers representing the displacement in the X and Y axis. -This moves @q{B C} 2@tie{}spaces to the right, and 3 down, relative to its -surroundings. This command cannot be used to move isolated scripts -vertically, for the same reason that @code{\\raise} cannot be used for -that." - (ly:stencil-translate (interpret-markup layout props arg) +@lilypond[verbatim,quote] +\\markup { + * + \\translate #'(2 . 3) + \\line { translated two spaces right, three up } +} +@end lilypond" + (ly:stencil-translate (interpret-markup layout props arg) offset)) -(define-builtin-markup-command (sub layout props arg) +(define-markup-command (sub layout props arg) (markup?) - font - ((font-size 0) - (baseline-skip)) + #:category font + #:properties ((font-size 0) + (baseline-skip)) " @cindex subscript text Set @var{arg} in subscript. @lilypond[verbatim,quote] -\\markup \\concat { - H - \\sub 2 - O +\\markup { + \\concat { + H + \\sub { + 2 + } + O + } } @end lilypond" (ly:stencil-translate-axis @@ -2456,14 +3430,14 @@ Set @var{arg} in subscript. (* -0.5 baseline-skip) Y)) -(define-builtin-markup-command (normal-size-sub layout props arg) +(define-markup-command (normal-size-sub layout props arg) (markup?) - font - ((baseline-skip)) + #:category font + #:properties ((baseline-skip)) " @cindex setting subscript in standard font size -Set @var{arg} in subscript, in a normal font size. +Set @var{arg} in subscript with a normal font size. @lilypond[verbatim,quote] \\markup { @@ -2477,57 +3451,109 @@ Set @var{arg} in subscript, in a normal font size. (interpret-markup layout props arg) (* -0.5 baseline-skip) Y)) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; brackets. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (hbracket layout props arg) +(define-markup-command (hbracket layout props arg) (markup?) - graphic - () + #:category graphic " @cindex placing horizontal brackets around text - + Draw horizontal brackets around @var{arg}. @lilypond[verbatim,quote] -\\markup \\hbracket \\line { - one two three +\\markup { + \\hbracket { + \\line { + one two three + } + } } @end lilypond" (let ((th 0.1) ;; todo: take from GROB. (m (interpret-markup layout props arg))) (bracketify-stencil m X th (* 2.5 th) th))) -(define-builtin-markup-command (bracket layout props arg) +(define-markup-command (bracket layout props arg) (markup?) - graphic - () + #:category graphic " @cindex placing vertical brackets around text - + Draw vertical brackets around @var{arg}. @lilypond[verbatim,quote] -\\markup \\bracket \\note #\"2.\" #UP +\\markup { + \\bracket { + \\note #\"2.\" #UP + } +} @end lilypond" (let ((th 0.1) ;; todo: take from GROB. (m (interpret-markup layout props arg))) (bracketify-stencil m Y th (* 2.5 th) th))) - + +(define-markup-command (parenthesize layout props arg) + (markup?) + #:category graphic + #:properties ((angularity 0) + (padding) + (size 1) + (thickness 1) + (width 0.25)) + " +@cindex placing parentheses around text + +Draw parentheses around @var{arg}. This is useful for parenthesizing +a column containing several lines of text. + +@lilypond[verbatim,quote] +\\markup { + \\line { + \\parenthesize { + \\column { + foo + bar + } + } + \\override #'(angularity . 2) { + \\parenthesize { + \\column { + bah + baz + } + } + } + } +} +@end lilypond" + (let* ((markup (interpret-markup layout props arg)) + (scaled-width (* size width)) + (scaled-thickness + (* (chain-assoc-get 'line-thickness props 0.1) + thickness)) + (half-thickness + (min (* size 0.5 scaled-thickness) + (* (/ 4 3.0) scaled-width))) + (padding (chain-assoc-get 'padding props half-thickness))) + (parenthesize-stencil + markup half-thickness scaled-width angularity padding))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Delayed markup evaluation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-builtin-markup-command (page-ref layout props label gauge default) +(define-markup-command (page-ref layout props label gauge default) (symbol? markup? markup?) - other - () + #:category other " @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." @@ -2538,9 +3564,10 @@ when @var{label} is not found." `(delay-stencil-evaluation ,(delay (ly:stencil-expr (let* ((table (ly:output-def-lookup layout 'label-page-table)) - (label-page (and (list? table) (assoc label table))) - (page-number (and label-page (cdr label-page))) - (page-markup (if page-number (format "~a" page-number) default)) + (page-number (if (list? table) + (assoc-get label table) + #f)) + (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))))) @@ -2548,36 +3575,167 @@ when @var{label} is not found." (markup #:concat (#:hspace gap page-markup))))))) 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-public (space-lines baseline stils) - (let space-stil ((prev-stil #f) - (stils stils) + (let space-stil ((stils stils) (result (list))) - (cond ((null? stils) - (reverse! result)) - ((not prev-stil) - (space-stil (car stils) (cdr stils) (list (car stils)))) - (else - (let* ((stil (car stils)) - (dy (max (- baseline - (+ (- (interval-bound (ly:stencil-extent prev-stil Y) DOWN)) - (interval-bound (ly:stencil-extent stil Y) UP))) - 0.0)) - (new-stil (ly:make-stencil - (ly:stencil-expr stil) - (ly:stencil-extent stil X) - (cons (interval-bound (ly:stencil-extent stil Y) DOWN) - (+ (interval-bound (ly:stencil-extent stil Y) UP) dy))))) - (space-stil stil (cdr stils) (cons new-stil result))))))) - -(define-builtin-markup-list-command (justified-lines layout props args) + (if (null? stils) + (reverse! result) + (let* ((stil (car stils)) + (dy-top (max (- (/ baseline 1.5) + (interval-bound (ly:stencil-extent stil Y) UP)) + 0.0)) + (dy-bottom (max (+ (/ baseline 3.0) + (interval-bound (ly:stencil-extent stil Y) DOWN)) + 0.0)) + (new-stil (ly:make-stencil + (ly:stencil-expr stil) + (ly:stencil-extent stil X) + (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN) + dy-bottom) + (+ (interval-bound (ly:stencil-extent stil Y) UP) + dy-top))))) + (space-stil (cdr stils) (cons new-stil result)))))) + +(define-markup-list-command (justified-lines layout props args) (markup-list?) - ((baseline-skip) - wordwrap-internal-markup-list) + #:properties ((baseline-skip) + wordwrap-internal-markup-list) " @cindex justifying lines of text @@ -2588,10 +3746,10 @@ Use @code{\\override-lines #'(line-width . @var{X})} to set the line width; (interpret-markup-list layout props (make-wordwrap-internal-markup-list #t args)))) -(define-builtin-markup-list-command (wordwrap-lines layout props args) +(define-markup-list-command (wordwrap-lines layout props args) (markup-list?) - ((baseline-skip) - wordwrap-internal-markup-list) + #:properties ((baseline-skip) + wordwrap-internal-markup-list) "Like @code{\\wordwrap}, but return a list of lines instead of a single markup. Use @code{\\override-lines #'(line-width . @var{X})} to set the line width, where @var{X} is the number of staff spaces." @@ -2599,16 +3757,15 @@ where @var{X} is the number of staff spaces." (interpret-markup-list layout props (make-wordwrap-internal-markup-list #f args)))) -(define-builtin-markup-list-command (column-lines layout props args) +(define-markup-list-command (column-lines layout props args) (markup-list?) - ((baseline-skip)) + #:properties ((baseline-skip)) "Like @code{\\column}, but return a list of lines instead of a single markup. @code{baseline-skip} determines the space between each markup in @var{args}." - (space-lines (chain-assoc-get 'baseline-skip props) + (space-lines baseline-skip (interpret-markup-list layout props args))) -(define-builtin-markup-list-command (override-lines layout props new-prop args) +(define-markup-list-command (override-lines layout props new-prop args) (pair? markup-list?) - () "Like @code{\\override}, for markup lists." (interpret-markup-list layout (cons (list new-prop) props) args))