scm/define-markup-commands.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2000--2011  Han-Wen Nienhuys <hanwen@xs4all.nl>
   4 ;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
   5 ;;;;
   6 ;;;; LilyPond is free software: you can redistribute it and/or modify
   7 ;;;; it under the terms of the GNU General Public License as published by
   8 ;;;; the Free Software Foundation, either version 3 of the License, or
   9 ;;;; (at your option) any later version.
  10 ;;;;
  11 ;;;; LilyPond is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;;; GNU General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU General Public License
  17 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 ;;;
  20 ;;; Markup commands and markup-list commands definitions.
  21 ;;;
  22 ;;; Markup commands which are part of LilyPond, are defined
  23 ;;; in the (lily) module, which is the current module in this file,
  24 ;;; using the `define-markup-command' macro.
  25 ;;;
  26 ;;; Usage:
  27 ;;;
  28 ;;; (define-markup-command (command-name layout props args...)
  29 ;;;   args-signature
  30 ;;;   [ #:category category ]
  31 ;;;   [ #:properties property-bindings ]
  32 ;;;   documentation-string
  33 ;;;   ..body..)
  34 ;;;
  35 ;;; with:
  36 ;;;   command-name
  37 ;;;     the name of the markup command
  38 ;;;
  39 ;;;   layout and props
  40 ;;;     arguments that are automatically passed to the command when it
  41 ;;;     is interpreted.
  42 ;;;     `layout' is an output def, which properties can be accessed
  43 ;;;     using `ly:output-def-lookup'.
  44 ;;;     `props' is a list of property settings which can be accessed
  45 ;;;     using `chain-assoc-get' (more on that below)
  46 ;;;
  47 ;;;   args...
  48 ;;;     the command arguments.
  49 ;;;     There is no limitation on the order of command arguments.
  50 ;;;     However, markup functions taking a markup as their last
  51 ;;;     argument are somewhat special as you can apply them to a
  52 ;;;     markup list, and the result is a markup list where the
  53 ;;;     markup function (with the specified leading arguments) has
  54 ;;;     been applied to every element of the original markup list.
  55 ;;;
  56 ;;;     Since replicating the leading arguments for applying a
  57 ;;;     markup function to a markup list is cheap mostly for
  58 ;;;     Scheme arguments, you avoid performance pitfalls by just
  59 ;;;     using Scheme arguments for the leading arguments of markup
  60 ;;;     functions that take a markup as their last argument.
  61 ;;;
  62 ;;;   args-signature
  63 ;;;     the arguments signature, i.e. a list of type predicates which
  64 ;;;     are used to type check the arguments, and also to define the general
  65 ;;;     argument types (markup, markup-list, scheme) that the command is
  66 ;;;     expecting.
  67 ;;;     For instance, if a command expects a number, then a markup, the
  68 ;;;     signature would be: (number? markup?)
  69 ;;;
  70 ;;;   category
  71 ;;;     for documentation purpose, builtin markup commands are grouped by
  72 ;;;     category. This can be any symbol. When documentation is generated,
  73 ;;;     the symbol is converted to a capitalized string, where hyphens are
  74 ;;;     replaced by spaces.
  75 ;;;
  76 ;;;   property-bindings
  77 ;;;     this is used both for documentation generation, and to ease
  78 ;;;     programming the command itself. It is list of
  79 ;;;        (property-name default-value)
  80 ;;;     or (property-name)
  81 ;;;     elements. Each property is looked-up in the `props' argument, and
  82 ;;;     the symbol naming the property is bound to its value.
  83 ;;;     When the property is not found in `props', then the symbol is bound
  84 ;;;     to the given default value. When no default value is given, #f is
  85 ;;;     used instead.
  86 ;;;     Thus, using the following property bindings:
  87 ;;;       ((thickness 0.1)
  88 ;;;        (font-size 0))
  89 ;;;     is equivalent to writing:
  90 ;;;       (let ((thickness (chain-assoc-get 'thickness props 0.1))
  91 ;;;             (font-size (chain-assoc-get 'font-size props 0)))
  92 ;;;         ..body..)
  93 ;;;     When a command `B' internally calls an other command `A', it may
  94 ;;;     desirable to see in `B' documentation all the properties and
  95 ;;;     default values used by `A'. In that case, add `A-markup' to the
  96 ;;;     property-bindings of B. (This is used when generating
  97 ;;;     documentation, but won't create bindings.)
  98 ;;;
  99 ;;;   documentation-string
 100 ;;;     the command documentation string (used to generate manuals)
 101 ;;;
 102 ;;;   body
 103 ;;;     the command body. The function is supposed to return a stencil.
 104 ;;;
 105 ;;; Each markup command definition shall have a documentation string
 106 ;;; with description, syntax and example.
 107
 108 (use-modules (ice-9 regex))
 109
 110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 111 ;; utility functions
 112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 113
 114 (define-public empty-stencil (ly:make-stencil '() '(1 . -1) '(1 . -1)))
 115 (define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
 116
 117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 118 ;; geometric shapes
 119 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 120
 121 (define-markup-command (draw-line layout props dest)
 122   (number-pair?)
 123   #:category graphic
 124   #:properties ((thickness 1))
 125   "
 126 @cindex drawing lines within text
 127
 128 A simple line.
 129 @lilypond[verbatim,quote]
 130 \\markup {
 131   \\draw-line #'(4 . 4)
 132   \\override #'(thickness . 5)
 133   \\draw-line #'(-3 . 0)
 134 }
 135 @end lilypond"
 136   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 137                thickness))
 138         (x (car dest))
 139         (y (cdr dest)))
 140     (make-line-stencil th 0 0 x y)))
 141
 142 (define-markup-command (draw-hline layout props)
 143   ()
 144   #:category graphic
 145   #:properties ((draw-line-markup)
 146                 (line-width)
 147                 (span-factor 1))
 148   "
 149 @cindex drawing a line across a page
 150
 151 Draws a line across a page, where the property @code{span-factor}
 152 controls what fraction of the page is taken up.
 153 @lilypond[verbatim,quote]
 154 \\markup {
 155   \\column {
 156     \\draw-hline
 157     \\override #'(span-factor . 1/3)
 158     \\draw-hline
 159   }
 160 }
 161 @end lilypond"
 162   (interpret-markup layout
 163                     props
 164                     (markup #:draw-line (cons (* line-width
 165                                                   span-factor)
 166                                                0))))
 167
 168 (define-markup-command (draw-circle layout props radius thickness filled)
 169   (number? number? boolean?)
 170   #:category graphic
 171   "
 172 @cindex drawing circles within text
 173
 174 A circle of radius @var{radius} and thickness @var{thickness},
 175 optionally filled.
 176
 177 @lilypond[verbatim,quote]
 178 \\markup {
 179   \\draw-circle #2 #0.5 ##f
 180   \\hspace #2
 181   \\draw-circle #2 #0 ##t
 182 }
 183 @end lilypond"
 184   (make-circle-stencil radius thickness filled))
 185
 186 (define-markup-command (triangle layout props filled)
 187   (boolean?)
 188   #:category graphic
 189   #:properties ((thickness 0.1)
 190                 (font-size 0)
 191                 (baseline-skip 2))
 192   "
 193 @cindex drawing triangles within text
 194
 195 A triangle, either filled or empty.
 196
 197 @lilypond[verbatim,quote]
 198 \\markup {
 199   \\triangle ##t
 200   \\hspace #2
 201   \\triangle ##f
 202 }
 203 @end lilypond"
 204   (let ((ex (* (magstep font-size) 0.8 baseline-skip)))
 205     (ly:make-stencil
 206      `(polygon '(0.0 0.0
 207                      ,ex 0.0
 208                      ,(* 0.5 ex)
 209                      ,(* 0.86 ex))
 210            ,thickness
 211            ,filled)
 212      (cons 0 ex)
 213      (cons 0 (* .86 ex)))))
 214
 215 (define-markup-command (circle layout props arg)
 216   (markup?)
 217   #:category graphic
 218   #:properties ((thickness 1)
 219                 (font-size 0)
 220                 (circle-padding 0.2))
 221   "
 222 @cindex circling text
 223
 224 Draw a circle around @var{arg}.  Use @code{thickness},
 225 @code{circle-padding} and @code{font-size} properties to determine line
 226 thickness and padding around the markup.
 227
 228 @lilypond[verbatim,quote]
 229 \\markup {
 230   \\circle {
 231     Hi
 232   }
 233 }
 234 @end lilypond"
 235   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 236                thickness))
 237          (pad (* (magstep font-size) circle-padding))
 238          (m (interpret-markup layout props arg)))
 239     (circle-stencil m th pad)))
 240
 241 (define-markup-command (with-url layout props url arg)
 242   (string? markup?)
 243   #:category graphic
 244   "
 245 @cindex inserting URL links into text
 246
 247 Add a link to URL @var{url} around @var{arg}.  This only works in
 248 the PDF backend.
 249
 250 @lilypond[verbatim,quote]
 251 \\markup {
 252   \\with-url #\"http://lilypond.org/web/\" {
 253     LilyPond ... \\italic {
 254       music notation for everyone
 255     }
 256   }
 257 }
 258 @end lilypond"
 259   (let* ((stil (interpret-markup layout props arg))
 260          (xextent (ly:stencil-extent stil X))
 261          (yextent (ly:stencil-extent stil Y))
 262          (old-expr (ly:stencil-expr stil))
 263          (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
 264
 265     (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
 266
 267 (define-markup-command (page-link layout props page-number arg)
 268   (number? markup?)
 269   #:category other
 270   "
 271 @cindex referencing page numbers in text
 272
 273 Add a link to the page @var{page-number} around @var{arg}. This only works in
 274 the PDF backend.
 275
 276 @lilypond[verbatim,quote]
 277 \\markup {
 278   \\page-link #2  { \\italic { This links to page 2... } }
 279 }
 280 @end lilypond"
 281   (let* ((stil (interpret-markup layout props arg))
 282          (xextent (ly:stencil-extent stil X))
 283          (yextent (ly:stencil-extent stil Y))
 284          (old-expr (ly:stencil-expr stil))
 285          (link-expr (list 'page-link page-number `(quote ,xextent) `(quote ,yextent))))
 286
 287     (ly:stencil-add (ly:make-stencil link-expr xextent yextent) stil)))
 288
 289 (define-markup-command (with-link layout props label arg)
 290   (symbol? markup?)
 291   #:category other
 292   "
 293 @cindex referencing page labels in text
 294
 295 Add a link to the page holding label @var{label} around @var{arg}. This
 296 only works in the PDF backend.
 297
 298 @lilypond[verbatim,quote]
 299 \\markup {
 300   \\with-link #\"label\" { \\italic { This links to the page containing the label... } }
 301 }
 302 @end lilypond"
 303   (let* ((arg-stencil (interpret-markup layout props arg))
 304          (x-ext (ly:stencil-extent arg-stencil X))
 305          (y-ext (ly:stencil-extent arg-stencil Y)))
 306     (ly:make-stencil
 307      `(delay-stencil-evaluation
 308        ,(delay (ly:stencil-expr
 309                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
 310                        (page-number (if (list? table)
 311                                         (assoc-get label table)
 312                                         #f))
 313                        (link-expr (list 'page-link page-number
 314                                         `(quote ,x-ext) `(quote ,y-ext))))
 315                   (ly:stencil-add (ly:make-stencil link-expr x-ext y-ext)
 316 arg-stencil)))))
 317      x-ext
 318      y-ext)))
 319
 320
 321 (define-markup-command (beam layout props width slope thickness)
 322   (number? number? number?)
 323   #:category graphic
 324   "
 325 @cindex drawing beams within text
 326
 327 Create a beam with the specified parameters.
 328 @lilypond[verbatim,quote]
 329 \\markup {
 330   \\beam #5 #1 #2
 331 }
 332 @end lilypond"
 333   (let* ((y (* slope width))
 334          (yext (cons (min 0 y) (max 0 y)))
 335          (half (/ thickness 2)))
 336
 337     (ly:make-stencil
 338      `(polygon ',(list
 339                   0 (/ thickness -2)
 340                     width (+ (* width slope)  (/ thickness -2))
 341                     width (+ (* width slope)  (/ thickness 2))
 342                     0 (/ thickness 2))
 343                ,(ly:output-def-lookup layout 'blot-diameter)
 344                #t)
 345      (cons 0 width)
 346      (cons (+ (- half) (car yext))
 347            (+ half (cdr yext))))))
 348
 349 (define-markup-command (underline layout props arg)
 350   (markup?)
 351   #:category font
 352   #:properties ((thickness 1) (offset 2))
 353   "
 354 @cindex underlining text
 355
 356 Underline @var{arg}.  Looks at @code{thickness} to determine line
 357 thickness, and @code{offset} to determine line y-offset.
 358
 359 @lilypond[verbatim,quote]
 360 \\markup \\fill-line {
 361   \\underline \"underlined\"
 362   \\override #'(offset . 5)
 363   \\override #'(thickness . 1)
 364   \\underline \"underlined\"
 365   \\override #'(offset . 1)
 366   \\override #'(thickness . 5)
 367   \\underline \"underlined\"
 368 }
 369 @end lilypond"
 370   (let* ((thick (ly:output-def-lookup layout 'line-thickness))
 371          (underline-thick (* thickness thick))
 372          (markup (interpret-markup layout props arg))
 373          (x1 (car (ly:stencil-extent markup X)))
 374          (x2 (cdr (ly:stencil-extent markup X)))
 375          (y (* thick (- offset)))
 376          (line (make-line-stencil underline-thick x1 y x2 y)))
 377     (ly:stencil-add markup line)))
 378
 379 (define-markup-command (box layout props arg)
 380   (markup?)
 381   #:category font
 382   #:properties ((thickness 1)
 383                 (font-size 0)
 384                 (box-padding 0.2))
 385   "
 386 @cindex enclosing text within a box
 387
 388 Draw a box round @var{arg}.  Looks at @code{thickness},
 389 @code{box-padding} and @code{font-size} properties to determine line
 390 thickness and padding around the markup.
 391
 392 @lilypond[verbatim,quote]
 393 \\markup {
 394   \\override #'(box-padding . 0.5)
 395   \\box
 396   \\line { V. S. }
 397 }
 398 @end lilypond"
 399   (let* ((th (* (ly:output-def-lookup layout 'line-thickness)
 400                 thickness))
 401          (pad (* (magstep font-size) box-padding))
 402          (m (interpret-markup layout props arg)))
 403     (box-stencil m th pad)))
 404
 405 (define-markup-command (filled-box layout props xext yext blot)
 406   (number-pair? number-pair? number?)
 407   #:category graphic
 408   "
 409 @cindex drawing solid boxes within text
 410 @cindex drawing boxes with rounded corners
 411
 412 Draw a box with rounded corners of dimensions @var{xext} and
 413 @var{yext}.  For example,
 414 @verbatim
 415 \\filled-box #'(-.3 . 1.8) #'(-.3 . 1.8) #0
 416 @end verbatim
 417 creates a box extending horizontally from -0.3 to 1.8 and
 418 vertically from -0.3 up to 1.8, with corners formed from a
 419 circle of diameter@tie{}0 (i.e., sharp corners).
 420
 421 @lilypond[verbatim,quote]
 422 \\markup {
 423   \\filled-box #'(0 . 4) #'(0 . 4) #0
 424   \\filled-box #'(0 . 2) #'(-4 . 2) #0.4
 425   \\filled-box #'(1 . 8) #'(0 . 7) #0.2
 426   \\with-color #white
 427   \\filled-box #'(-4.5 . -2.5) #'(3.5 . 5.5) #0.7
 428 }
 429 @end lilypond"
 430   (ly:round-filled-box
 431    xext yext blot))
 432
 433 (define-markup-command (rounded-box layout props arg)
 434   (markup?)
 435   #:category graphic
 436   #:properties ((thickness 1)
 437                 (corner-radius 1)
 438                 (font-size 0)
 439                 (box-padding 0.5))
 440   "@cindex enclosing text in a box with rounded corners
 441    @cindex drawing boxes with rounded corners around text
 442 Draw a box with rounded corners around @var{arg}.  Looks at @code{thickness},
 443 @code{box-padding} and @code{font-size} properties to determine line
 444 thickness and padding around the markup; the @code{corner-radius} property
 445 makes it possible to define another shape for the corners (default is 1).
 446
 447 @lilypond[quote,verbatim,relative=2]
 448 c4^\\markup {
 449   \\rounded-box {
 450     Overtura
 451   }
 452 }
 453 c,8. c16 c4 r
 454 @end lilypond"
 455   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 456                thickness))
 457         (pad (* (magstep font-size) box-padding))
 458         (m (interpret-markup layout props arg)))
 459     (ly:stencil-add (rounded-box-stencil m th pad corner-radius)
 460                     m)))
 461
 462 (define-markup-command (rotate layout props ang arg)
 463   (number? markup?)
 464   #:category align
 465   "
 466 @cindex rotating text
 467
 468 Rotate object with @var{ang} degrees around its center.
 469
 470 @lilypond[verbatim,quote]
 471 \\markup {
 472   default
 473   \\hspace #2
 474   \\rotate #45
 475   \\line {
 476     rotated 45°
 477   }
 478 }
 479 @end lilypond"
 480   (let* ((stil (interpret-markup layout props arg)))
 481     (ly:stencil-rotate stil ang 0 0)))
 482
 483 (define-markup-command (whiteout layout props arg)
 484   (markup?)
 485   #:category other
 486   "
 487 @cindex adding a white background to text
 488
 489 Provide a white background for @var{arg}.
 490
 491 @lilypond[verbatim,quote]
 492 \\markup {
 493   \\combine
 494     \\filled-box #'(-1 . 10) #'(-3 . 4) #1
 495     \\whiteout whiteout
 496 }
 497 @end lilypond"
 498   (stencil-whiteout (interpret-markup layout props arg)))
 499
 500 (define-markup-command (pad-markup layout props amount arg)
 501   (number? markup?)
 502   #:category align
 503   "
 504 @cindex padding text
 505 @cindex putting space around text
 506
 507 Add space around a markup object.
 508
 509 @lilypond[verbatim,quote]
 510 \\markup {
 511   \\box {
 512     default
 513   }
 514   \\hspace #2
 515   \\box {
 516     \\pad-markup #1 {
 517       padded
 518     }
 519   }
 520 }
 521 @end lilypond"
 522   (let*
 523       ((stil (interpret-markup layout props arg))
 524        (xext (ly:stencil-extent stil X))
 525        (yext (ly:stencil-extent stil Y)))
 526
 527     (ly:make-stencil
 528      (ly:stencil-expr stil)
 529      (interval-widen xext amount)
 530      (interval-widen yext amount))))
 531
 532 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 533 ;; space
 534 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 535
 536 (define-markup-command (strut layout props)
 537   ()
 538   #:category other
 539   "
 540 @cindex creating vertical spaces in text
 541
 542 Create a box of the same height as the space in the current font."
 543   (let ((m (ly:text-interface::interpret-markup layout props " ")))
 544     (ly:make-stencil (ly:stencil-expr m)
 545                      '(0 . 0)
 546                      (ly:stencil-extent m X)
 547                      )))
 548
 549 ;; todo: fix negative space
 550 (define-markup-command (hspace layout props amount)
 551   (number?)
 552   #:category align
 553   #:properties ((word-space))
 554   "
 555 @cindex creating horizontal spaces in text
 556
 557 Create an invisible object taking up horizontal space @var{amount}.
 558
 559 @lilypond[verbatim,quote]
 560 \\markup {
 561   one
 562   \\hspace #2
 563   two
 564   \\hspace #8
 565   three
 566 }
 567 @end lilypond"
 568   (let ((corrected-space (- amount word-space)))
 569     (if (> corrected-space 0)
 570         (ly:make-stencil "" (cons 0 corrected-space) '(0 . 0))
 571         (ly:make-stencil "" (cons corrected-space corrected-space) '(0 . 0)))))
 572
 573 ;; todo: fix negative space
 574 (define-markup-command (vspace layout props amount)
 575  (number?)
 576  #:category align
 577  "
 578 @cindex creating vertical spaces in text
 579
 580 Create an invisible object taking up vertical space
 581 of @var{amount} multiplied by 3.
 582
 583 @lilypond[verbatim,quote]
 584 \\markup {
 585     \\center-column {
 586     one
 587     \\vspace #2
 588     two
 589     \\vspace #5
 590     three
 591   }
 592 }
 593 @end lilypond"
 594   (let ((amount (* amount 3.0)))
 595     (if (> amount 0)
 596         (ly:make-stencil "" (cons 0 0) (cons 0 amount))
 597         (ly:make-stencil "" (cons 0 0) (cons amount amount)))))
 598
 599
 600 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 601 ;; importing graphics.
 602 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 603
 604 (define-markup-command (stencil layout props stil)
 605   (ly:stencil?)
 606   #:category other
 607   "
 608 @cindex importing stencils into text
 609
 610 Use a stencil as markup.
 611
 612 @lilypond[verbatim,quote]
 613 \\markup {
 614   \\stencil #(make-circle-stencil 2 0 #t)
 615 }
 616 @end lilypond"
 617   stil)
 618
 619 (define bbox-regexp
 620   (make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
 621
 622 (define (get-postscript-bbox string)
 623   "Extract the bbox from STRING, or return #f if not present."
 624   (let*
 625       ((match (regexp-exec bbox-regexp string)))
 626
 627     (if match
 628         (map (lambda (x)
 629                (string->number (match:substring match x)))
 630              (cdr (iota 5)))
 631
 632         #f)))
 633
 634 (define-markup-command (epsfile layout props axis size file-name)
 635   (number? number? string?)
 636   #:category graphic
 637   "
 638 @cindex inlining an Encapsulated PostScript image
 639
 640 Inline an EPS image.  The image is scaled along @var{axis} to
 641 @var{size}.
 642
 643 @lilypond[verbatim,quote]
 644 \\markup {
 645   \\general-align #Y #DOWN {
 646     \\epsfile #X #20 #\"context-example.eps\"
 647     \\epsfile #Y #20 #\"context-example.eps\"
 648   }
 649 }
 650 @end lilypond"
 651   (if (ly:get-option 'safe)
 652       (interpret-markup layout props "not allowed in safe")
 653       (eps-file->stencil axis size file-name)
 654       ))
 655
 656 (define-markup-command (postscript layout props str)
 657   (string?)
 658   #:category graphic
 659   "
 660 @cindex inserting PostScript directly into text
 661 This inserts @var{str} directly into the output as a PostScript
 662 command string.
 663
 664 @lilypond[verbatim,quote]
 665 ringsps = #\"
 666   0.15 setlinewidth
 667   0.9 0.6 moveto
 668   0.4 0.6 0.5 0 361 arc
 669   stroke
 670   1.0 0.6 0.5 0 361 arc
 671   stroke
 672   \"
 673
 674 rings = \\markup {
 675   \\with-dimensions #'(-0.2 . 1.6) #'(0 . 1.2)
 676   \\postscript #ringsps
 677 }
 678
 679 \\relative c'' {
 680   c2^\\rings
 681   a2_\\rings
 682 }
 683 @end lilypond"
 684   ;; FIXME
 685   (ly:make-stencil
 686    (list 'embedded-ps
 687          (format #f "
 688 gsave currentpoint translate
 689 0.1 setlinewidth
 690  ~a
 691 grestore
 692 "
 693                  str))
 694    '(0 . 0) '(0 . 0)))
 695
 696 (define-markup-command (path layout props thickness commands) (number? list?)
 697   #:category graphic
 698   #:properties ((line-cap-style 'round)
 699                 (line-join-style 'round)
 700                 (filled #f))
 701   "
 702 @cindex paths, drawing
 703 @cindex drawing paths
 704 Draws a path with line thickness @var{thickness} according to the
 705 directions given in @var{commands}.  @var{commands} is a list of
 706 lists where the @code{car} of each sublist is a drawing command and
 707 the @code{cdr} comprises the associated arguments for each command.
 708
 709 Line-cap styles and line-join styles may be customized by
 710 overriding the @code{line-cap-style} and @code{line-join-style}
 711 properties, respectively.  Available line-cap styles are
 712 @code{'butt}, @code{'round}, and @code{'square}.  Available
 713 line-join styles are @code{'miter}, @code{'round}, and
 714 @code{'bevel}.
 715
 716 The property @code{filled} specifies whether or not the path is
 717 filled with color.
 718
 719 There are seven commands available to use in the list
 720 @code{commands}: @code{moveto}, @code{rmoveto}, @code{lineto},
 721 @code{rlineto}, @code{curveto}, @code{rcurveto}, and
 722 @code{closepath}.  Note that the commands that begin with @emph{r}
 723 are the relative variants of the other three commands.
 724
 725 The commands @code{moveto}, @code{rmoveto}, @code{lineto}, and
 726 @code{rlineto} take 2 arguments; they are the X and Y coordinates
 727 for the destination point.
 728
 729 The commands @code{curveto} and @code{rcurveto} create cubic
 730 Bézier curves, and take 6 arguments; the first two are the X and Y
 731 coordinates for the first control point, the second two are the X
 732 and Y coordinates for the second control point, and the last two
 733 are the X and Y coordinates for the destination point.
 734
 735 The @code{closepath} command takes zero arguments and closes the
 736 current subpath in the active path.
 737
 738 Note that a sequence of commands @emph{must} begin with a
 739 @code{moveto} or @code{rmoveto} to work with the SVG output.
 740
 741 @lilypond[verbatim,quote]
 742 samplePath =
 743   #'((moveto 0 0)
 744      (lineto -1 1)
 745      (lineto 1 1)
 746      (lineto 1 -1)
 747      (curveto -5 -5 -5 5 -1 0)
 748      (closepath))
 749
 750 \\markup {
 751   \\path #0.25 #samplePath
 752 }
 753 @end lilypond"
 754   (let* ((half-thickness (/ thickness 2))
 755          (current-point '(0 . 0))
 756          (set-point (lambda (lst) (set! current-point lst)))
 757          (relative? (lambda (x)
 758                       (string-prefix? "r" (symbol->string (car x)))))
 759          ;; For calculating extents, we want to modify the command
 760          ;; list so that all coordinates are absolute.
 761          (new-commands (map (lambda (x)
 762                               (cond
 763                                 ;; for rmoveto, rlineto
 764                                 ((and (relative? x) (eq? 3 (length x)))
 765                                  (let ((cp (cons
 766                                              (+ (car current-point)
 767                                                 (second x))
 768                                              (+ (cdr current-point)
 769                                                 (third x)))))
 770                                    (set-point cp)
 771                                    (list (car cp)
 772                                          (cdr cp))))
 773                                 ;; for rcurveto
 774                                 ((and (relative? x) (eq? 7 (length x)))
 775                                  (let* ((old-cp current-point)
 776                                         (cp (cons
 777                                               (+ (car old-cp)
 778                                                  (sixth x))
 779                                               (+ (cdr old-cp)
 780                                                  (seventh x)))))
 781                                    (set-point cp)
 782                                    (list (+ (car old-cp) (second x))
 783                                          (+ (cdr old-cp) (third x))
 784                                          (+ (car old-cp) (fourth x))
 785                                          (+ (cdr old-cp) (fifth x))
 786                                          (car cp)
 787                                          (cdr cp))))
 788                                 ;; for moveto, lineto
 789                                 ((eq? 3 (length x))
 790                                  (set-point (cons (second x)
 791                                                   (third x)))
 792                                  (drop x 1))
 793                                 ;; for curveto
 794                                 ((eq? 7 (length x))
 795                                  (set-point (cons (sixth x)
 796                                                   (seventh x)))
 797                                  (drop x 1))
 798                                 ;; keep closepath for filtering;
 799                                 ;; see `without-closepath'.
 800                                 (else x)))
 801                             commands))
 802          ;; path-min-max does not accept 0-arg lists,
 803          ;; and since closepath does not affect extents, filter
 804          ;; out those commands here.
 805          (without-closepath (filter (lambda (x)
 806                                       (not (equal? 'closepath (car x))))
 807                                     new-commands))
 808          (extents (path-min-max
 809                     ;; set the origin to the first moveto
 810                     (list (list-ref (car without-closepath) 0)
 811                           (list-ref (car without-closepath) 1))
 812                     without-closepath))
 813          (X-extent (cons (list-ref extents 0) (list-ref extents 1)))
 814          (Y-extent (cons (list-ref extents 2) (list-ref extents 3)))
 815          (command-list (fold-right append '() commands)))
 816
 817     ;; account for line thickness
 818     (set! X-extent (interval-widen X-extent half-thickness))
 819     (set! Y-extent (interval-widen Y-extent half-thickness))
 820
 821     (ly:make-stencil
 822       `(path ,thickness `(,@',command-list)
 823              ',line-cap-style ',line-join-style ,filled)
 824       X-extent
 825       Y-extent)))
 826
 827 (define-markup-command (score layout props score)
 828   (ly:score?)
 829   #:category music
 830   #:properties ((baseline-skip))
 831   "
 832 @cindex inserting music into text
 833
 834 Inline an image of music.
 835
 836 @lilypond[verbatim,quote]
 837 \\markup {
 838   \\score {
 839     \\new PianoStaff <<
 840       \\new Staff \\relative c' {
 841         \\key f \\major
 842         \\time 3/4
 843         \\mark \\markup { Allegro }
 844         f2\\p( a4)
 845         c2( a4)
 846         bes2( g'4)
 847         f8( e) e4 r
 848       }
 849       \\new Staff \\relative c {
 850         \\clef bass
 851         \\key f \\major
 852         \\time 3/4
 853         f8( a c a c a
 854         f c' es c es c)
 855         f,( bes d bes d bes)
 856         f( g bes g bes g)
 857       }
 858     >>
 859     \\layout {
 860       indent = 0.0\\cm
 861       \\context {
 862         \\Score
 863         \\override RehearsalMark #'break-align-symbols =
 864           #'(time-signature key-signature)
 865         \\override RehearsalMark #'self-alignment-X = #LEFT
 866       }
 867       \\context {
 868         \\Staff
 869         \\override TimeSignature #'break-align-anchor-alignment = #LEFT
 870       }
 871     }
 872   }
 873 }
 874 @end lilypond"
 875   (let ((output (ly:score-embedded-format score layout)))
 876
 877     (if (ly:music-output? output)
 878         (stack-stencils Y DOWN baseline-skip
 879                         (map paper-system-stencil
 880                              (vector->list
 881                               (ly:paper-score-paper-systems output))))
 882         (begin
 883           (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
 884           empty-stencil))))
 885
 886 (define-markup-command (null layout props)
 887   ()
 888   #:category other
 889   "
 890 @cindex creating empty text objects
 891
 892 An empty markup with extents of a single point.
 893
 894 @lilypond[verbatim,quote]
 895 \\markup {
 896   \\null
 897 }
 898 @end lilypond"
 899   point-stencil)
 900
 901 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 902 ;; basic formatting.
 903 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 904
 905 (define-markup-command (simple layout props str)
 906   (string?)
 907   #:category font
 908   "
 909 @cindex simple text strings
 910
 911 A simple text string; @code{\\markup @{ foo @}} is equivalent with
 912 @code{\\markup @{ \\simple #\"foo\" @}}.
 913
 914 Note: for creating standard text markup or defining new markup commands,
 915 the use of @code{\\simple} is unnecessary.
 916
 917 @lilypond[verbatim,quote]
 918 \\markup {
 919   \\simple #\"simple\"
 920   \\simple #\"text\"
 921   \\simple #\"strings\"
 922 }
 923 @end lilypond"
 924   (interpret-markup layout props str))
 925
 926 (define-markup-command (tied-lyric layout props str)
 927   (string?)
 928   #:category music
 929   "
 930 @cindex simple text strings with tie characters
 931
 932 Like simple-markup, but use tie characters for @q{~} tilde symbols.
 933
 934 @lilypond[verbatim,quote]
 935 \\markup {
 936   \\tied-lyric #\"Lasciate~i monti\"
 937 }
 938 @end lilypond"
 939   (if (string-contains str "~")
 940       (let*
 941           ((parts (string-split str #\~))
 942            (tie-str (ly:wide-char->utf-8 #x203f))
 943            (joined  (list-join parts tie-str))
 944            (join-stencil (interpret-markup layout props tie-str))
 945            )
 946
 947         (interpret-markup layout
 948                           (prepend-alist-chain
 949                            'word-space
 950                            (/ (interval-length (ly:stencil-extent join-stencil X)) -3.5)
 951                            props)
 952                           (make-line-markup joined)))
 953                            ;(map (lambda (s) (interpret-markup layout props s)) parts))
 954       (interpret-markup layout props str)))
 955
 956 (define-public empty-markup
 957   (make-simple-markup ""))
 958
 959 ;; helper for justifying lines.
 960 (define (get-fill-space word-count line-width word-space text-widths)
 961   "Calculate the necessary paddings between each two adjacent texts.
 962   The lengths of all texts are stored in @var{text-widths}.
 963   The normal formula for the padding between texts a and b is:
 964   padding = line-width/(word-count - 1) - (length(a) + length(b))/2
 965   The first and last padding have to be calculated specially using the
 966   whole length of the first or last text.
 967   All paddings are checked to be at least word-space, to ensure that
 968   no texts collide.
 969   Return a list of paddings."
 970   (cond
 971    ((null? text-widths) '())
 972
 973    ;; special case first padding
 974    ((= (length text-widths) word-count)
 975     (cons
 976      (- (- (/ line-width (1- word-count)) (car text-widths))
 977         (/ (car (cdr text-widths)) 2))
 978      (get-fill-space word-count line-width word-space (cdr text-widths))))
 979    ;; special case last padding
 980    ((= (length text-widths) 2)
 981     (list (- (/ line-width (1- word-count))
 982              (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
 983    (else
 984     (let ((default-padding
 985             (- (/ line-width (1- word-count))
 986                (/ (+ (car text-widths) (car (cdr text-widths))) 2))))
 987       (cons
 988        (if (> word-space default-padding)
 989            word-space
 990            default-padding)
 991        (get-fill-space word-count line-width word-space (cdr text-widths)))))))
 992
 993 (define-markup-command (fill-line layout props args)
 994   (markup-list?)
 995   #:category align
 996   #:properties ((text-direction RIGHT)
 997                 (word-space 0.6)
 998                 (line-width #f))
 999   "Put @var{markups} in a horizontal line of width @var{line-width}.
1000 The markups are spaced or flushed to fill the entire line.
1001 If there are no arguments, return an empty stencil.
1002
1003 @lilypond[verbatim,quote]
1004 \\markup {
1005   \\column {
1006     \\fill-line {
1007       Words evenly spaced across the page
1008     }
1009     \\null
1010     \\fill-line {
1011       \\line { Text markups }
1012       \\line {
1013         \\italic { evenly spaced }
1014       }
1015       \\line { across the page }
1016     }
1017   }
1018 }
1019 @end lilypond"
1020   (let* ((orig-stencils (interpret-markup-list layout props args))
1021          (stencils
1022           (map (lambda (stc)
1023                  (if (ly:stencil-empty? stc)
1024                      point-stencil
1025                      stc)) orig-stencils))
1026          (text-widths
1027           (map (lambda (stc)
1028                  (if (ly:stencil-empty? stc)
1029                      0.0
1030                      (interval-length (ly:stencil-extent stc X))))
1031                stencils))
1032          (text-width (apply + text-widths))
1033          (word-count (length stencils))
1034          (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
1035          (fill-space
1036           (cond
1037            ((= word-count 1)
1038             (list
1039              (/ (- line-width text-width) 2)
1040              (/ (- line-width text-width) 2)))
1041            ((= word-count 2)
1042             (list
1043              (- line-width text-width)))
1044            (else
1045             (get-fill-space word-count line-width word-space text-widths))))
1046
1047          (line-contents (if (= word-count 1)
1048                             (list
1049                              point-stencil
1050                              (car stencils)
1051                              point-stencil)
1052                             stencils)))
1053
1054     (if (null? (remove ly:stencil-empty? orig-stencils))
1055         empty-stencil
1056         (begin
1057           (if (= text-direction LEFT)
1058               (set! line-contents (reverse line-contents)))
1059           (set! line-contents
1060                 (stack-stencils-padding-list
1061                  X RIGHT fill-space line-contents))
1062           (if (> word-count 1)
1063               ;; shift s.t. stencils align on the left edge, even if
1064               ;; first stencil had negative X-extent (e.g. center-column)
1065               ;; (if word-count = 1, X-extents are already normalized in
1066               ;; the definition of line-contents)
1067               (set! line-contents
1068                     (ly:stencil-translate-axis
1069                      line-contents
1070                      (- (car (ly:stencil-extent (car stencils) X)))
1071                      X)))
1072           line-contents))))
1073
1074 (define-markup-command (line layout props args)
1075   (markup-list?)
1076   #:category align
1077   #:properties ((word-space)
1078                 (text-direction RIGHT))
1079   "Put @var{args} in a horizontal line.  The property @code{word-space}
1080 determines the space between markups in @var{args}.
1081
1082 @lilypond[verbatim,quote]
1083 \\markup {
1084   \\line {
1085     one two three
1086   }
1087 }
1088 @end lilypond"
1089   (let ((stencils (interpret-markup-list layout props args)))
1090     (if (= text-direction LEFT)
1091         (set! stencils (reverse stencils)))
1092     (stack-stencil-line
1093      word-space
1094      (remove ly:stencil-empty? stencils))))
1095
1096 (define-markup-command (concat layout props args)
1097   (markup-list?)
1098   #:category align
1099   "
1100 @cindex concatenating text
1101 @cindex ligatures in text
1102
1103 Concatenate @var{args} in a horizontal line, without spaces in between.
1104 Strings and simple markups are concatenated on the input level, allowing
1105 ligatures.  For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is
1106 equivalent to @code{\"fi\"}.
1107
1108 @lilypond[verbatim,quote]
1109 \\markup {
1110   \\concat {
1111     one
1112     two
1113     three
1114   }
1115 }
1116 @end lilypond"
1117   (define (concat-string-args arg-list)
1118     (fold-right (lambda (arg result-list)
1119                   (let ((result (if (pair? result-list)
1120                                     (car result-list)
1121                                   '())))
1122                     (if (and (pair? arg) (eqv? (car arg) simple-markup))
1123                       (set! arg (cadr arg)))
1124                     (if (and (string? result) (string? arg))
1125                         (cons (string-append arg result) (cdr result-list))
1126                       (cons arg result-list))))
1127                 '()
1128                 arg-list))
1129
1130   (interpret-markup layout
1131                     (prepend-alist-chain 'word-space 0 props)
1132                     (make-line-markup (if (markup-command-list? args)
1133                                           args
1134                                           (concat-string-args args)))))
1135
1136 (define (wordwrap-stencils stencils
1137                            justify base-space line-width text-dir)
1138   "Perform simple wordwrap, return stencil of each line."
1139   (define space (if justify
1140                     ;; justify only stretches lines.
1141                     (* 0.7 base-space)
1142                     base-space))
1143   (define (take-list width space stencils
1144                      accumulator accumulated-width)
1145     "Return (head-list . tail) pair, with head-list fitting into width"
1146     (if (null? stencils)
1147         (cons accumulator stencils)
1148         (let* ((first (car stencils))
1149                (first-wid (cdr (ly:stencil-extent (car stencils) X)))
1150                (newwid (+ space first-wid accumulated-width)))
1151           (if (or (null? accumulator)
1152                   (< newwid width))
1153               (take-list width space
1154                          (cdr stencils)
1155                          (cons first accumulator)
1156                          newwid)
1157               (cons accumulator stencils)))))
1158   (let loop ((lines '())
1159              (todo stencils))
1160     (let* ((line-break (take-list line-width space todo
1161                                   '() 0.0))
1162            (line-stencils (car line-break))
1163            (space-left (- line-width
1164                           (apply + (map (lambda (x) (cdr (ly:stencil-extent x X)))
1165                                         line-stencils))))
1166            (line-word-space (cond ((not justify) space)
1167                                   ;; don't stretch last line of paragraph.
1168                                   ;; hmmm . bug - will overstretch the last line in some case.
1169                                   ((null? (cdr line-break))
1170                                    base-space)
1171                                   ((null? line-stencils) 0.0)
1172                                   ((null? (cdr line-stencils)) 0.0)
1173                                   (else (/ space-left (1- (length line-stencils))))))
1174            (line (stack-stencil-line line-word-space
1175                                      (if (= text-dir RIGHT)
1176                                          (reverse line-stencils)
1177                                          line-stencils))))
1178       (if (pair? (cdr line-break))
1179           (loop (cons line lines)
1180                 (cdr line-break))
1181           (begin
1182             (if (= text-dir LEFT)
1183                 (set! line
1184                       (ly:stencil-translate-axis
1185                        line
1186                        (- line-width (interval-end (ly:stencil-extent line X)))
1187                        X)))
1188             (reverse (cons line lines)))))))
1189
1190 (define-markup-list-command (wordwrap-internal layout props justify args)
1191   (boolean? markup-list?)
1192   #:properties ((line-width #f)
1193                 (word-space)
1194                 (text-direction RIGHT))
1195   "Internal markup list command used to define @code{\\justify} and @code{\\wordwrap}."
1196   (wordwrap-stencils (remove ly:stencil-empty?
1197                              (interpret-markup-list layout props args))
1198                      justify
1199                      word-space
1200                      (or line-width
1201                          (ly:output-def-lookup layout 'line-width))
1202                      text-direction))
1203
1204 (define-markup-command (justify layout props args)
1205   (markup-list?)
1206   #:category align
1207   #:properties ((baseline-skip)
1208                 wordwrap-internal-markup-list)
1209   "
1210 @cindex justifying text
1211
1212 Like @code{\\wordwrap}, but with lines stretched to justify the margins.
1213 Use @code{\\override #'(line-width . @var{X})} to set the line width;
1214 @var{X}@tie{}is the number of staff spaces.
1215
1216 @lilypond[verbatim,quote]
1217 \\markup {
1218   \\justify {
1219     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
1220     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
1221     Ut enim ad minim veniam, quis nostrud exercitation ullamco
1222     laboris nisi ut aliquip ex ea commodo consequat.
1223   }
1224 }
1225 @end lilypond"
1226   (stack-lines DOWN 0.0 baseline-skip
1227                (wordwrap-internal-markup-list layout props #t args)))
1228
1229 (define-markup-command (wordwrap layout props args)
1230   (markup-list?)
1231   #:category align
1232   #:properties ((baseline-skip)
1233                 wordwrap-internal-markup-list)
1234   "Simple wordwrap.  Use @code{\\override #'(line-width . @var{X})} to set
1235 the line width, where @var{X} is the number of staff spaces.
1236
1237 @lilypond[verbatim,quote]
1238 \\markup {
1239   \\wordwrap {
1240     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
1241     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
1242     Ut enim ad minim veniam, quis nostrud exercitation ullamco
1243     laboris nisi ut aliquip ex ea commodo consequat.
1244   }
1245 }
1246 @end lilypond"
1247   (stack-lines DOWN 0.0 baseline-skip
1248                (wordwrap-internal-markup-list layout props #f args)))
1249
1250 (define-markup-list-command (wordwrap-string-internal layout props justify arg)
1251   (boolean? string?)
1252   #:properties ((line-width)
1253                 (word-space)
1254                 (text-direction RIGHT))
1255   "Internal markup list command used to define @code{\\justify-string} and
1256 @code{\\wordwrap-string}."
1257   (let* ((para-strings (regexp-split
1258                         (string-regexp-substitute
1259                          "\r" "\n"
1260                          (string-regexp-substitute "\r\n" "\n" arg))
1261                         "\n[ \t\n]*\n[ \t\n]*"))
1262          (list-para-words (map (lambda (str)
1263                                  (regexp-split str "[ \t\n]+"))
1264                                para-strings))
1265          (para-lines (map (lambda (words)
1266                             (let* ((stencils
1267                                     (remove ly:stencil-empty?
1268                                             (map (lambda (x)
1269                                                    (interpret-markup layout props x))
1270                                                  words))))
1271                               (wordwrap-stencils stencils
1272                                                  justify word-space
1273                                                  line-width text-direction)))
1274                           list-para-words)))
1275     (apply append para-lines)))
1276
1277 (define-markup-command (wordwrap-string layout props arg)
1278   (string?)
1279   #:category align
1280   #:properties ((baseline-skip)
1281                 wordwrap-string-internal-markup-list)
1282   "Wordwrap a string.  Paragraphs may be separated with double newlines.
1283
1284 @lilypond[verbatim,quote]
1285 \\markup {
1286   \\override #'(line-width . 40)
1287   \\wordwrap-string #\"Lorem ipsum dolor sit amet, consectetur
1288       adipisicing elit, sed do eiusmod tempor incididunt ut labore
1289       et dolore magna aliqua.
1290
1291
1292       Ut enim ad minim veniam, quis nostrud exercitation ullamco
1293       laboris nisi ut aliquip ex ea commodo consequat.
1294
1295
1296       Excepteur sint occaecat cupidatat non proident, sunt in culpa
1297       qui officia deserunt mollit anim id est laborum\"
1298 }
1299 @end lilypond"
1300   (stack-lines DOWN 0.0 baseline-skip
1301                (wordwrap-string-internal-markup-list layout props #f arg)))
1302
1303 (define-markup-command (justify-string layout props arg)
1304   (string?)
1305   #:category align
1306   #:properties ((baseline-skip)
1307                 wordwrap-string-internal-markup-list)
1308   "Justify a string.  Paragraphs may be separated with double newlines
1309
1310 @lilypond[verbatim,quote]
1311 \\markup {
1312   \\override #'(line-width . 40)
1313   \\justify-string #\"Lorem ipsum dolor sit amet, consectetur
1314       adipisicing elit, sed do eiusmod tempor incididunt ut labore
1315       et dolore magna aliqua.
1316
1317
1318       Ut enim ad minim veniam, quis nostrud exercitation ullamco
1319       laboris nisi ut aliquip ex ea commodo consequat.
1320
1321
1322       Excepteur sint occaecat cupidatat non proident, sunt in culpa
1323       qui officia deserunt mollit anim id est laborum\"
1324 }
1325 @end lilypond"
1326   (stack-lines DOWN 0.0 baseline-skip
1327                (wordwrap-string-internal-markup-list layout props #t arg)))
1328
1329 (define-markup-command (wordwrap-field layout props symbol)
1330   (symbol?)
1331   #:category align
1332   "Wordwrap the data which has been assigned to @var{symbol}.
1333
1334 @lilypond[verbatim,quote]
1335 \\header {
1336   title = \"My title\"
1337   myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing
1338     elit, sed do eiusmod tempor incididunt ut labore et dolore magna
1339     aliqua.  Ut enim ad minim veniam, quis nostrud exercitation ullamco
1340     laboris nisi ut aliquip ex ea commodo consequat.\"
1341 }
1342
1343 \\paper {
1344   bookTitleMarkup = \\markup {
1345     \\column {
1346       \\fill-line { \\fromproperty #'header:title }
1347       \\null
1348       \\wordwrap-field #'header:myText
1349     }
1350   }
1351 }
1352
1353 \\markup {
1354   \\null
1355 }
1356 @end lilypond"
1357   (let* ((m (chain-assoc-get symbol props)))
1358     (if (string? m)
1359         (wordwrap-string-markup layout props m)
1360         empty-stencil)))
1361
1362 (define-markup-command (justify-field layout props symbol)
1363   (symbol?)
1364   #:category align
1365   "Justify the data which has been assigned to @var{symbol}.
1366
1367 @lilypond[verbatim,quote]
1368 \\header {
1369   title = \"My title\"
1370   myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing
1371     elit, sed do eiusmod tempor incididunt ut labore et dolore magna
1372     aliqua.  Ut enim ad minim veniam, quis nostrud exercitation ullamco
1373     laboris nisi ut aliquip ex ea commodo consequat.\"
1374 }
1375
1376 \\paper {
1377   bookTitleMarkup = \\markup {
1378     \\column {
1379       \\fill-line { \\fromproperty #'header:title }
1380       \\null
1381       \\justify-field #'header:myText
1382     }
1383   }
1384 }
1385
1386 \\markup {
1387   \\null
1388 }
1389 @end lilypond"
1390   (let* ((m (chain-assoc-get symbol props)))
1391     (if (string? m)
1392         (justify-string-markup layout props m)
1393         empty-stencil)))
1394
1395 (define-markup-command (combine layout props arg1 arg2)
1396   (markup? markup?)
1397   #:category align
1398   "
1399 @cindex merging text
1400
1401 Print two markups on top of each other.
1402
1403 Note: @code{\\combine} cannot take a list of markups enclosed in
1404 curly braces as an argument; the follow example will not compile:
1405
1406 @example
1407 \\combine @{ a list @}
1408 @end example
1409
1410 @lilypond[verbatim,quote]
1411 \\markup {
1412   \\fontsize #5
1413   \\override #'(thickness . 2)
1414   \\combine
1415     \\draw-line #'(0 . 4)
1416     \\arrow-head #Y #DOWN ##f
1417 }
1418 @end lilypond"
1419   (let* ((s1 (interpret-markup layout props arg1))
1420          (s2 (interpret-markup layout props arg2)))
1421     (ly:stencil-add s1 s2)))
1422
1423 ;;
1424 ;; TODO: should extract baseline-skip from each argument somehow..
1425 ;;
1426 (define-markup-command (column layout props args)
1427   (markup-list?)
1428   #:category align
1429   #:properties ((baseline-skip))
1430   "
1431 @cindex stacking text in a column
1432
1433 Stack the markups in @var{args} vertically.  The property
1434 @code{baseline-skip} determines the space between markups
1435 in @var{args}.
1436
1437 @lilypond[verbatim,quote]
1438 \\markup {
1439   \\column {
1440     one
1441     two
1442     three
1443   }
1444 }
1445 @end lilypond"
1446   (let ((arg-stencils (interpret-markup-list layout props args)))
1447     (stack-lines -1 0.0 baseline-skip
1448                  (remove ly:stencil-empty? arg-stencils))))
1449
1450 (define-markup-command (dir-column layout props args)
1451   (markup-list?)
1452   #:category align
1453   #:properties ((direction)
1454                 (baseline-skip))
1455   "
1456 @cindex changing direction of text columns
1457
1458 Make a column of @var{args}, going up or down, depending on the
1459 setting of the @code{direction} layout property.
1460
1461 @lilypond[verbatim,quote]
1462 \\markup {
1463   \\override #`(direction . ,UP) {
1464     \\dir-column {
1465       going up
1466     }
1467   }
1468   \\hspace #1
1469   \\dir-column {
1470     going down
1471   }
1472   \\hspace #1
1473   \\override #'(direction . 1) {
1474     \\dir-column {
1475       going up
1476     }
1477   }
1478 }
1479 @end lilypond"
1480   (stack-lines (if (number? direction) direction -1)
1481                0.0
1482                baseline-skip
1483                (interpret-markup-list layout props args)))
1484
1485 (define (general-column align-dir baseline mols)
1486   "Stack @var{mols} vertically, aligned to  @var{align-dir} horizontally."
1487
1488   (let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols))
1489          (stacked-stencil (stack-lines -1 0.0 baseline aligned-mols))
1490          (stacked-extent (ly:stencil-extent stacked-stencil X)))
1491     (ly:stencil-translate-axis stacked-stencil (- (car stacked-extent)) X )))
1492
1493 (define-markup-command (center-column layout props args)
1494   (markup-list?)
1495   #:category align
1496   #:properties ((baseline-skip))
1497   "
1498 @cindex centering a column of text
1499
1500 Put @code{args} in a centered column.
1501
1502 @lilypond[verbatim,quote]
1503 \\markup {
1504   \\center-column {
1505     one
1506     two
1507     three
1508   }
1509 }
1510 @end lilypond"
1511   (general-column CENTER baseline-skip (interpret-markup-list layout props args)))
1512
1513 (define-markup-command (left-column layout props args)
1514   (markup-list?)
1515   #:category align
1516   #:properties ((baseline-skip))
1517  "
1518 @cindex text columns, left-aligned
1519
1520 Put @code{args} in a left-aligned column.
1521
1522 @lilypond[verbatim,quote]
1523 \\markup {
1524   \\left-column {
1525     one
1526     two
1527     three
1528   }
1529 }
1530 @end lilypond"
1531   (general-column LEFT baseline-skip (interpret-markup-list layout props args)))
1532
1533 (define-markup-command (right-column layout props args)
1534   (markup-list?)
1535   #:category align
1536   #:properties ((baseline-skip))
1537  "
1538 @cindex text columns, right-aligned
1539
1540 Put @code{args} in a right-aligned column.
1541
1542 @lilypond[verbatim,quote]
1543 \\markup {
1544   \\right-column {
1545     one
1546     two
1547     three
1548   }
1549 }
1550 @end lilypond"
1551   (general-column RIGHT baseline-skip (interpret-markup-list layout props args)))
1552
1553 (define-markup-command (vcenter layout props arg)
1554   (markup?)
1555   #:category align
1556   "
1557 @cindex vertically centering text
1558
1559 Align @code{arg} to its Y@tie{}center.
1560
1561 @lilypond[verbatim,quote]
1562 \\markup {
1563   one
1564   \\vcenter
1565   two
1566   three
1567 }
1568 @end lilypond"
1569   (let* ((mol (interpret-markup layout props arg)))
1570     (ly:stencil-aligned-to mol Y CENTER)))
1571
1572 (define-markup-command (center-align layout props arg)
1573   (markup?)
1574   #:category align
1575   "
1576 @cindex horizontally centering text
1577
1578 Align @code{arg} to its X@tie{}center.
1579
1580 @lilypond[verbatim,quote]
1581 \\markup {
1582   \\column {
1583     one
1584     \\center-align
1585     two
1586     three
1587   }
1588 }
1589 @end lilypond"
1590   (let* ((mol (interpret-markup layout props arg)))
1591     (ly:stencil-aligned-to mol X CENTER)))
1592
1593 (define-markup-command (right-align layout props arg)
1594   (markup?)
1595   #:category align
1596   "
1597 @cindex right aligning text
1598
1599 Align @var{arg} on its right edge.
1600
1601 @lilypond[verbatim,quote]
1602 \\markup {
1603   \\column {
1604     one
1605     \\right-align
1606     two
1607     three
1608   }
1609 }
1610 @end lilypond"
1611   (let* ((m (interpret-markup layout props arg)))
1612     (ly:stencil-aligned-to m X RIGHT)))
1613
1614 (define-markup-command (left-align layout props arg)
1615   (markup?)
1616   #:category align
1617   "
1618 @cindex left aligning text
1619
1620 Align @var{arg} on its left edge.
1621
1622 @lilypond[verbatim,quote]
1623 \\markup {
1624   \\column {
1625     one
1626     \\left-align
1627     two
1628     three
1629   }
1630 }
1631 @end lilypond"
1632   (let* ((m (interpret-markup layout props arg)))
1633     (ly:stencil-aligned-to m X LEFT)))
1634
1635 (define-markup-command (general-align layout props axis dir arg)
1636   (integer? number? markup?)
1637   #:category align
1638   "
1639 @cindex controlling general text alignment
1640
1641 Align @var{arg} in @var{axis} direction to the @var{dir} side.
1642
1643 @lilypond[verbatim,quote]
1644 \\markup {
1645   \\column {
1646     one
1647     \\general-align #X #LEFT
1648     two
1649     three
1650     \\null
1651     one
1652     \\general-align #X #CENTER
1653     two
1654     three
1655     \\null
1656     \\line {
1657       one
1658       \\general-align #Y #UP
1659       two
1660       three
1661     }
1662     \\null
1663     \\line {
1664       one
1665       \\general-align #Y #3.2
1666       two
1667       three
1668     }
1669   }
1670 }
1671 @end lilypond"
1672   (let* ((m (interpret-markup layout props arg)))
1673     (ly:stencil-aligned-to m axis dir)))
1674
1675 (define-markup-command (halign layout props dir arg)
1676   (number? markup?)
1677   #:category align
1678   "
1679 @cindex setting horizontal text alignment
1680
1681 Set horizontal alignment.  If @var{dir} is @code{-1}, then it is
1682 left-aligned, while @code{+1} is right.  Values in between interpolate
1683 alignment accordingly.
1684
1685 @lilypond[verbatim,quote]
1686 \\markup {
1687   \\column {
1688     one
1689     \\halign #LEFT
1690     two
1691     three
1692     \\null
1693     one
1694     \\halign #CENTER
1695     two
1696     three
1697     \\null
1698     one
1699     \\halign #RIGHT
1700     two
1701     three
1702     \\null
1703     one
1704     \\halign #-5
1705     two
1706     three
1707   }
1708 }
1709 @end lilypond"
1710   (let* ((m (interpret-markup layout props arg)))
1711     (ly:stencil-aligned-to m X dir)))
1712
1713 (define-markup-command (with-dimensions layout props x y arg)
1714   (number-pair? number-pair? markup?)
1715   #:category other
1716   "
1717 @cindex setting extent of text objects
1718
1719 Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}."
1720   (let* ((m (interpret-markup layout props arg)))
1721     (ly:make-stencil (ly:stencil-expr m) x y)))
1722
1723 (define-markup-command (pad-around layout props amount arg)
1724   (number? markup?)
1725   #:category align
1726   "Add padding @var{amount} all around @var{arg}.
1727
1728 @lilypond[verbatim,quote]
1729 \\markup {
1730   \\box {
1731     default
1732   }
1733   \\hspace #2
1734   \\box {
1735     \\pad-around #0.5 {
1736       padded
1737     }
1738   }
1739 }
1740 @end lilypond"
1741   (let* ((m (interpret-markup layout props arg))
1742          (x (ly:stencil-extent m X))
1743          (y (ly:stencil-extent m Y)))
1744     (ly:make-stencil (ly:stencil-expr m)
1745                      (interval-widen x amount)
1746                      (interval-widen y amount))))
1747
1748 (define-markup-command (pad-x layout props amount arg)
1749   (number? markup?)
1750   #:category align
1751   "
1752 @cindex padding text horizontally
1753
1754 Add padding @var{amount} around @var{arg} in the X@tie{}direction.
1755
1756 @lilypond[verbatim,quote]
1757 \\markup {
1758   \\box {
1759     default
1760   }
1761   \\hspace #4
1762   \\box {
1763     \\pad-x #2 {
1764       padded
1765     }
1766   }
1767 }
1768 @end lilypond"
1769   (let* ((m (interpret-markup layout props arg))
1770          (x (ly:stencil-extent m X))
1771          (y (ly:stencil-extent m Y)))
1772     (ly:make-stencil (ly:stencil-expr m)
1773                      (interval-widen x amount)
1774                      y)))
1775
1776 (define-markup-command (put-adjacent layout props axis dir arg1 arg2)
1777   (integer? ly:dir? markup? markup?)
1778   #:category align
1779   "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}."
1780   (let ((m1 (interpret-markup layout props arg1))
1781         (m2 (interpret-markup layout props arg2)))
1782     (ly:stencil-combine-at-edge m1 axis dir m2 0.0)))
1783
1784 (define-markup-command (transparent layout props arg)
1785   (markup?)
1786   #:category other
1787   "Make @var{arg} transparent.
1788
1789 @lilypond[verbatim,quote]
1790 \\markup {
1791   \\transparent {
1792     invisible text
1793   }
1794 }
1795 @end lilypond"
1796   (let* ((m (interpret-markup layout props arg))
1797          (x (ly:stencil-extent m X))
1798          (y (ly:stencil-extent m Y)))
1799     (ly:make-stencil "" x y)))
1800
1801 (define-markup-command (pad-to-box layout props x-ext y-ext arg)
1802   (number-pair? number-pair? markup?)
1803   #:category align
1804   "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space.
1805
1806 @lilypond[verbatim,quote]
1807 \\markup {
1808   \\box {
1809     default
1810   }
1811   \\hspace #4
1812   \\box {
1813     \\pad-to-box #'(0 . 10) #'(0 . 3) {
1814       padded
1815     }
1816   }
1817 }
1818 @end lilypond"
1819   (let* ((m (interpret-markup layout props arg))
1820          (x (ly:stencil-extent m X))
1821          (y (ly:stencil-extent m Y)))
1822     (ly:make-stencil (ly:stencil-expr m)
1823                      (interval-union x-ext x)
1824                      (interval-union y-ext y))))
1825
1826 (define-markup-command (hcenter-in layout props length arg)
1827   (number? markup?)
1828   #:category align
1829   "Center @var{arg} horizontally within a box of extending
1830 @var{length}/2 to the left and right.
1831
1832 @lilypond[quote,verbatim]
1833 \\new StaffGroup <<
1834   \\new Staff {
1835     \\set Staff.instrumentName = \\markup {
1836       \\hcenter-in #12
1837       Oboe
1838     }
1839     c''1
1840   }
1841   \\new Staff {
1842     \\set Staff.instrumentName = \\markup {
1843       \\hcenter-in #12
1844       Bassoon
1845     }
1846     \\clef tenor
1847     c'1
1848   }
1849 >>
1850 @end lilypond"
1851   (interpret-markup layout props
1852                     (make-pad-to-box-markup
1853                      (cons (/ length -2) (/ length 2))
1854                      '(0 . 0)
1855                      (make-center-align-markup arg))))
1856
1857 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1858 ;; property
1859 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1860
1861 (define-markup-command (fromproperty layout props symbol)
1862   (symbol?)
1863   #:category other
1864   "Read the @var{symbol} from property settings, and produce a stencil
1865 from the markup contained within.  If @var{symbol} is not defined, it
1866 returns an empty markup.
1867
1868 @lilypond[verbatim,quote]
1869 \\header {
1870   myTitle = \"myTitle\"
1871   title = \\markup {
1872     from
1873     \\italic
1874     \\fromproperty #'header:myTitle
1875   }
1876 }
1877 \\markup {
1878   \\null
1879 }
1880 @end lilypond"
1881   (let ((m (chain-assoc-get symbol props)))
1882     (if (markup? m)
1883         (interpret-markup layout props m)
1884         empty-stencil)))
1885
1886 (define-markup-command (on-the-fly layout props procedure arg)
1887   (symbol? markup?)
1888   #:category other
1889   "Apply the @var{procedure} markup command to @var{arg}.
1890 @var{procedure} should take a single argument."
1891   (let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
1892     (set-object-property! anonymous-with-signature
1893                           'markup-signature
1894                           (list markup?))
1895     (interpret-markup layout props (list anonymous-with-signature arg))))
1896
1897 (define-markup-command (footnote layout props mkup note)
1898   (markup? markup?)
1899   #:category other
1900   "Have footnote @var{note} act as an annotation to the markup @var{mkup}."
1901   (ly:stencil-combine-at-edge
1902     (interpret-markup layout props mkup)
1903     X
1904     RIGHT
1905     (ly:make-stencil
1906       `(footnote ,(interpret-markup layout props note))
1907       '(0 . 0)
1908       '(0 . 0))
1909     0.0))
1910
1911 (define-markup-command (override layout props new-prop arg)
1912   (pair? markup?)
1913   #:category other
1914   "
1915 @cindex overriding properties within text markup
1916
1917 Add the argument @var{new-prop} to the property list.  Properties
1918 may be any property supported by @rinternals{font-interface},
1919 @rinternals{text-interface} and
1920 @rinternals{instrument-specific-markup-interface}.
1921
1922 @lilypond[verbatim,quote]
1923 \\markup {
1924   \\line {
1925     \\column {
1926       default
1927       baseline-skip
1928     }
1929     \\hspace #2
1930     \\override #'(baseline-skip . 4) {
1931       \\column {
1932         increased
1933         baseline-skip
1934       }
1935     }
1936   }
1937 }
1938 @end lilypond"
1939   (interpret-markup layout (cons (list new-prop) props) arg))
1940
1941 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1942 ;; files
1943 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1944
1945 (define-markup-command (verbatim-file layout props name)
1946   (string?)
1947   #:category other
1948   "Read the contents of file @var{name}, and include it verbatim.
1949
1950 @lilypond[verbatim,quote]
1951 \\markup {
1952   \\verbatim-file #\"simple.ly\"
1953 }
1954 @end lilypond"
1955   (interpret-markup layout props
1956                     (if  (ly:get-option 'safe)
1957                          "verbatim-file disabled in safe mode"
1958                          (let* ((str (ly:gulp-file name))
1959                                 (lines (string-split str #\nl)))
1960                            (make-typewriter-markup
1961                             (make-column-markup lines))))))
1962
1963 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1964 ;; fonts.
1965 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1966
1967
1968 (define-markup-command (smaller layout props arg)
1969   (markup?)
1970   #:category font
1971   "Decrease the font size relative to the current setting.
1972
1973 @lilypond[verbatim,quote]
1974 \\markup {
1975   \\fontsize #3.5 {
1976     some large text
1977     \\hspace #2
1978     \\smaller {
1979       a bit smaller
1980     }
1981     \\hspace #2
1982     more large text
1983   }
1984 }
1985 @end lilypond"
1986   (interpret-markup layout props
1987    `(,fontsize-markup -1 ,arg)))
1988
1989 (define-markup-command (larger layout props arg)
1990   (markup?)
1991   #:category font
1992   "Increase the font size relative to the current setting.
1993
1994 @lilypond[verbatim,quote]
1995 \\markup {
1996   default
1997   \\hspace #2
1998   \\larger
1999   larger
2000 }
2001 @end lilypond"
2002   (interpret-markup layout props
2003    `(,fontsize-markup 1 ,arg)))
2004
2005 (define-markup-command (finger layout props arg)
2006   (markup?)
2007   #:category font
2008   "Set @var{arg} as small numbers.
2009
2010 @lilypond[verbatim,quote]
2011 \\markup {
2012   \\finger {
2013     1 2 3 4 5
2014   }
2015 }
2016 @end lilypond"
2017   (interpret-markup layout
2018                     (cons '((font-size . -5) (font-encoding . fetaText)) props)
2019                     arg))
2020
2021 (define-markup-command (abs-fontsize layout props size arg)
2022   (number? markup?)
2023   #:category font
2024   "Use @var{size} as the absolute font size to display @var{arg}.
2025 Adjusts @code{baseline-skip} and @code{word-space} accordingly.
2026
2027 @lilypond[verbatim,quote]
2028 \\markup {
2029   default text font size
2030   \\hspace #2
2031   \\abs-fontsize #16 { text font size 16 }
2032   \\hspace #2
2033   \\abs-fontsize #12 { text font size 12 }
2034 }
2035 @end lilypond"
2036   (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
2037          (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
2038          (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
2039          (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
2040          (magnification (/ size ref-size)))
2041     (interpret-markup layout
2042                       (cons `((baseline-skip . ,(* magnification ref-baseline))
2043                               (word-space . ,(* magnification ref-word-space))
2044                               (font-size . ,(magnification->font-size magnification)))
2045                             props)
2046                       arg)))
2047
2048 (define-markup-command (fontsize layout props increment arg)
2049   (number? markup?)
2050   #:category font
2051   #:properties ((font-size 0)
2052                 (word-space 1)
2053                 (baseline-skip 2))
2054   "Add @var{increment} to the font-size.  Adjusts @code{baseline-skip}
2055 accordingly.
2056
2057 @lilypond[verbatim,quote]
2058 \\markup {
2059   default
2060   \\hspace #2
2061   \\fontsize #-1.5
2062   smaller
2063 }
2064 @end lilypond"
2065   (let ((entries (list
2066                   (cons 'baseline-skip (* baseline-skip (magstep increment)))
2067                   (cons 'word-space (* word-space (magstep increment)))
2068                   (cons 'font-size (+ font-size increment)))))
2069     (interpret-markup layout (cons entries props) arg)))
2070
2071 (define-markup-command (magnify layout props sz arg)
2072   (number? markup?)
2073   #:category font
2074   "
2075 @cindex magnifying text
2076
2077 Set the font magnification for its argument.  In the following
2078 example, the middle@tie{}A is 10% larger:
2079
2080 @example
2081 A \\magnify #1.1 @{ A @} A
2082 @end example
2083
2084 Note: Magnification only works if a font name is explicitly selected.
2085 Use @code{\\fontsize} otherwise.
2086
2087 @lilypond[verbatim,quote]
2088 \\markup {
2089   default
2090   \\hspace #2
2091   \\magnify #1.5 {
2092     50% larger
2093   }
2094 }
2095 @end lilypond"
2096   (interpret-markup
2097    layout
2098    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
2099    arg))
2100
2101 (define-markup-command (bold layout props arg)
2102   (markup?)
2103   #:category font
2104   "Switch to bold font-series.
2105
2106 @lilypond[verbatim,quote]
2107 \\markup {
2108   default
2109   \\hspace #2
2110   \\bold
2111   bold
2112 }
2113 @end lilypond"
2114   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
2115
2116 (define-markup-command (sans layout props arg)
2117   (markup?)
2118   #:category font
2119   "Switch to the sans serif font family.
2120
2121 @lilypond[verbatim,quote]
2122 \\markup {
2123   default
2124   \\hspace #2
2125   \\sans {
2126     sans serif
2127   }
2128 }
2129 @end lilypond"
2130   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
2131
2132 (define-markup-command (number layout props arg)
2133   (markup?)
2134   #:category font
2135   "Set font family to @code{number}, which yields the font used for
2136 time signatures and fingerings.  This font contains numbers and
2137 some punctuation; it has no letters.
2138
2139 @lilypond[verbatim,quote]
2140 \\markup {
2141   \\number {
2142     0 1 2 3 4 5 6 7 8 9 . ,
2143   }
2144 }
2145 @end lilypond"
2146   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2147
2148 (define-markup-command (roman layout props arg)
2149   (markup?)
2150   #:category font
2151   "Set font family to @code{roman}.
2152
2153 @lilypond[verbatim,quote]
2154 \\markup {
2155   \\sans \\bold {
2156     sans serif, bold
2157     \\hspace #2
2158     \\roman {
2159       text in roman font family
2160     }
2161     \\hspace #2
2162     return to sans
2163   }
2164 }
2165 @end lilypond"
2166   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
2167
2168 (define-markup-command (huge layout props arg)
2169   (markup?)
2170   #:category font
2171   "Set font size to +2.
2172
2173 @lilypond[verbatim,quote]
2174 \\markup {
2175   default
2176   \\hspace #2
2177   \\huge
2178   huge
2179 }
2180 @end lilypond"
2181   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
2182
2183 (define-markup-command (large layout props arg)
2184   (markup?)
2185   #:category font
2186   "Set font size to +1.
2187
2188 @lilypond[verbatim,quote]
2189 \\markup {
2190   default
2191   \\hspace #2
2192   \\large
2193   large
2194 }
2195 @end lilypond"
2196   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
2197
2198 (define-markup-command (normalsize layout props arg)
2199   (markup?)
2200   #:category font
2201   "Set font size to default.
2202
2203 @lilypond[verbatim,quote]
2204 \\markup {
2205   \\teeny {
2206     this is very small
2207     \\hspace #2
2208     \\normalsize {
2209       normal size
2210     }
2211     \\hspace #2
2212     teeny again
2213   }
2214 }
2215 @end lilypond"
2216   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
2217
2218 (define-markup-command (small layout props arg)
2219   (markup?)
2220   #:category font
2221   "Set font size to -1.
2222
2223 @lilypond[verbatim,quote]
2224 \\markup {
2225   default
2226   \\hspace #2
2227   \\small
2228   small
2229 }
2230 @end lilypond"
2231   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
2232
2233 (define-markup-command (tiny layout props arg)
2234   (markup?)
2235   #:category font
2236   "Set font size to -2.
2237
2238 @lilypond[verbatim,quote]
2239 \\markup {
2240   default
2241   \\hspace #2
2242   \\tiny
2243   tiny
2244 }
2245 @end lilypond"
2246   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
2247
2248 (define-markup-command (teeny layout props arg)
2249   (markup?)
2250   #:category font
2251   "Set font size to -3.
2252
2253 @lilypond[verbatim,quote]
2254 \\markup {
2255   default
2256   \\hspace #2
2257   \\teeny
2258   teeny
2259 }
2260 @end lilypond"
2261   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
2262
2263 (define-markup-command (fontCaps layout props arg)
2264   (markup?)
2265   #:category font
2266   "Set @code{font-shape} to @code{caps}
2267
2268 Note: @code{\\fontCaps} requires the installation and selection of
2269 fonts which support the @code{caps} font shape."
2270   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
2271
2272 ;; Poor man's caps
2273 (define-markup-command (smallCaps layout props arg)
2274   (markup?)
2275   #:category font
2276   "Emit @var{arg} as small caps.
2277
2278 Note: @code{\\smallCaps} does not support accented characters.
2279
2280 @lilypond[verbatim,quote]
2281 \\markup {
2282   default
2283   \\hspace #2
2284   \\smallCaps {
2285     Text in small caps
2286   }
2287 }
2288 @end lilypond"
2289   (define (char-list->markup chars lower)
2290     (let ((final-string (string-upcase (reverse-list->string chars))))
2291       (if lower
2292           (markup #:fontsize -2 final-string)
2293           final-string)))
2294   (define (make-small-caps rest-chars currents current-is-lower prev-result)
2295     (if (null? rest-chars)
2296         (make-concat-markup
2297           (reverse! (cons (char-list->markup currents current-is-lower)
2298                           prev-result)))
2299         (let* ((ch (car rest-chars))
2300                (is-lower (char-lower-case? ch)))
2301           (if (or (and current-is-lower is-lower)
2302                   (and (not current-is-lower) (not is-lower)))
2303               (make-small-caps (cdr rest-chars)
2304                                (cons ch currents)
2305                                is-lower
2306                                prev-result)
2307               (make-small-caps (cdr rest-chars)
2308                                (list ch)
2309                                is-lower
2310                                (if (null? currents)
2311                                    prev-result
2312                                    (cons (char-list->markup
2313                                             currents current-is-lower)
2314                                          prev-result)))))))
2315   (interpret-markup layout props
2316     (if (string? arg)
2317         (make-small-caps (string->list arg) (list) #f (list))
2318         arg)))
2319
2320 (define-markup-command (caps layout props arg)
2321   (markup?)
2322   #:category font
2323   "Copy of the @code{\\smallCaps} command.
2324
2325 @lilypond[verbatim,quote]
2326 \\markup {
2327   default
2328   \\hspace #2
2329   \\caps {
2330     Text in small caps
2331   }
2332 }
2333 @end lilypond"
2334   (interpret-markup layout props (make-smallCaps-markup arg)))
2335
2336 (define-markup-command (dynamic layout props arg)
2337   (markup?)
2338   #:category font
2339   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
2340 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
2341 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
2342 done in a different font.  The recommended font for this is bold and italic.
2343 @lilypond[verbatim,quote]
2344 \\markup {
2345   \\dynamic {
2346     sfzp
2347   }
2348 }
2349 @end lilypond"
2350   (interpret-markup
2351    layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2352
2353 (define-markup-command (text layout props arg)
2354   (markup?)
2355   #:category font
2356   "Use a text font instead of music symbol or music alphabet font.
2357
2358 @lilypond[verbatim,quote]
2359 \\markup {
2360   \\number {
2361     1, 2,
2362     \\text {
2363       three, four,
2364     }
2365     5
2366   }
2367 }
2368 @end lilypond"
2369
2370   ;; ugh - latin1
2371   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
2372                     arg))
2373
2374 (define-markup-command (italic layout props arg)
2375   (markup?)
2376   #:category font
2377   "Use italic @code{font-shape} for @var{arg}.
2378
2379 @lilypond[verbatim,quote]
2380 \\markup {
2381   default
2382   \\hspace #2
2383   \\italic
2384   italic
2385 }
2386 @end lilypond"
2387   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
2388
2389 (define-markup-command (typewriter layout props arg)
2390   (markup?)
2391   #:category font
2392   "Use @code{font-family} typewriter for @var{arg}.
2393
2394 @lilypond[verbatim,quote]
2395 \\markup {
2396   default
2397   \\hspace #2
2398   \\typewriter
2399   typewriter
2400 }
2401 @end lilypond"
2402   (interpret-markup
2403    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
2404
2405 (define-markup-command (upright layout props arg)
2406   (markup?)
2407   #:category font
2408   "Set @code{font-shape} to @code{upright}.  This is the opposite
2409 of @code{italic}.
2410
2411 @lilypond[verbatim,quote]
2412 \\markup {
2413   \\italic {
2414     italic text
2415     \\hspace #2
2416     \\upright {
2417       upright text
2418     }
2419     \\hspace #2
2420     italic again
2421   }
2422 }
2423 @end lilypond"
2424   (interpret-markup
2425    layout (prepend-alist-chain 'font-shape 'upright props) arg))
2426
2427 (define-markup-command (medium layout props arg)
2428   (markup?)
2429   #:category font
2430   "Switch to medium font-series (in contrast to bold).
2431
2432 @lilypond[verbatim,quote]
2433 \\markup {
2434   \\bold {
2435     some bold text
2436     \\hspace #2
2437     \\medium {
2438       medium font series
2439     }
2440     \\hspace #2
2441     bold again
2442   }
2443 }
2444 @end lilypond"
2445   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
2446                     arg))
2447
2448 (define-markup-command (normal-text layout props arg)
2449   (markup?)
2450   #:category font
2451   "Set all font related properties (except the size) to get the default
2452 normal text font, no matter what font was used earlier.
2453
2454 @lilypond[verbatim,quote]
2455 \\markup {
2456   \\huge \\bold \\sans \\caps {
2457     Some text with font overrides
2458     \\hspace #2
2459     \\normal-text {
2460       Default text, same font-size
2461     }
2462     \\hspace #2
2463     More text as before
2464   }
2465 }
2466 @end lilypond"
2467   ;; ugh - latin1
2468   (interpret-markup layout
2469                     (cons '((font-family . roman) (font-shape . upright)
2470                             (font-series . medium) (font-encoding . latin1))
2471                           props)
2472                     arg))
2473
2474 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2475 ;; symbols.
2476 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2477
2478 (define-markup-command (musicglyph layout props glyph-name)
2479   (string?)
2480   #:category music
2481   "@var{glyph-name} is converted to a musical symbol; for example,
2482 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2483 the music font.  See @ruser{The Feta font} for a complete listing of
2484 the possible glyphs.
2485
2486 @lilypond[verbatim,quote]
2487 \\markup {
2488   \\musicglyph #\"f\"
2489   \\musicglyph #\"rests.2\"
2490   \\musicglyph #\"clefs.G_change\"
2491 }
2492 @end lilypond"
2493   (let* ((font (ly:paper-get-font layout
2494                                   (cons '((font-encoding . fetaMusic)
2495                                           (font-name . #f))
2496
2497                                                  props)))
2498          (glyph (ly:font-get-glyph font glyph-name)))
2499     (if (null? (ly:stencil-expr glyph))
2500         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2501
2502     glyph))
2503
2504 (define-markup-command (doublesharp layout props)
2505   ()
2506   #:category music
2507   "Draw a double sharp symbol.
2508
2509 @lilypond[verbatim,quote]
2510 \\markup {
2511   \\doublesharp
2512 }
2513 @end lilypond"
2514   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
2515
2516 (define-markup-command (sesquisharp layout props)
2517   ()
2518   #:category music
2519   "Draw a 3/2 sharp symbol.
2520
2521 @lilypond[verbatim,quote]
2522 \\markup {
2523   \\sesquisharp
2524 }
2525 @end lilypond"
2526   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
2527
2528 (define-markup-command (sharp layout props)
2529   ()
2530   #:category music
2531   "Draw a sharp symbol.
2532
2533 @lilypond[verbatim,quote]
2534 \\markup {
2535   \\sharp
2536 }
2537 @end lilypond"
2538   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
2539
2540 (define-markup-command (semisharp layout props)
2541   ()
2542   #:category music
2543   "Draw a semisharp symbol.
2544
2545 @lilypond[verbatim,quote]
2546 \\markup {
2547   \\semisharp
2548 }
2549 @end lilypond"
2550   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
2551
2552 (define-markup-command (natural layout props)
2553   ()
2554   #:category music
2555   "Draw a natural symbol.
2556
2557 @lilypond[verbatim,quote]
2558 \\markup {
2559   \\natural
2560 }
2561 @end lilypond"
2562   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
2563
2564 (define-markup-command (semiflat layout props)
2565   ()
2566   #:category music
2567   "Draw a semiflat symbol.
2568
2569 @lilypond[verbatim,quote]
2570 \\markup {
2571   \\semiflat
2572 }
2573 @end lilypond"
2574   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
2575
2576 (define-markup-command (flat layout props)
2577   ()
2578   #:category music
2579   "Draw a flat symbol.
2580
2581 @lilypond[verbatim,quote]
2582 \\markup {
2583   \\flat
2584 }
2585 @end lilypond"
2586   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
2587
2588 (define-markup-command (sesquiflat layout props)
2589   ()
2590   #:category music
2591   "Draw a 3/2 flat symbol.
2592
2593 @lilypond[verbatim,quote]
2594 \\markup {
2595   \\sesquiflat
2596 }
2597 @end lilypond"
2598   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
2599
2600 (define-markup-command (doubleflat layout props)
2601   ()
2602   #:category music
2603   "Draw a double flat symbol.
2604
2605 @lilypond[verbatim,quote]
2606 \\markup {
2607   \\doubleflat
2608 }
2609 @end lilypond"
2610   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
2611
2612 (define-markup-command (with-color layout props color arg)
2613   (color? markup?)
2614   #:category other
2615   "
2616 @cindex coloring text
2617
2618 Draw @var{arg} in color specified by @var{color}.
2619
2620 @lilypond[verbatim,quote]
2621 \\markup {
2622   \\with-color #red
2623   red
2624   \\hspace #2
2625   \\with-color #green
2626   green
2627   \\hspace #2
2628   \\with-color #blue
2629   blue
2630 }
2631 @end lilypond"
2632   (let ((stil (interpret-markup layout props arg)))
2633     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
2634                      (ly:stencil-extent stil X)
2635                      (ly:stencil-extent stil Y))))
2636
2637 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2638 ;; glyphs
2639 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2640
2641 (define-markup-command (arrow-head layout props axis dir filled)
2642   (integer? ly:dir? boolean?)
2643   #:category graphic
2644   "Produce an arrow head in specified direction and axis.
2645 Use the filled head if @var{filled} is specified.
2646 @lilypond[verbatim,quote]
2647 \\markup {
2648   \\fontsize #5 {
2649     \\general-align #Y #DOWN {
2650       \\arrow-head #Y #UP ##t
2651       \\arrow-head #Y #DOWN ##f
2652       \\hspace #2
2653       \\arrow-head #X #RIGHT ##f
2654       \\arrow-head #X #LEFT ##f
2655     }
2656   }
2657 }
2658 @end lilypond"
2659   (let*
2660       ((name (format #f "arrowheads.~a.~a~a"
2661                      (if filled
2662                          "close"
2663                          "open")
2664                      axis
2665                      dir)))
2666     (ly:font-get-glyph
2667      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2668                                      props))
2669      name)))
2670
2671 (define-markup-command (lookup layout props glyph-name)
2672   (string?)
2673   #:category other
2674   "Lookup a glyph by name.
2675
2676 @lilypond[verbatim,quote]
2677 \\markup {
2678   \\override #'(font-encoding . fetaBraces) {
2679     \\lookup #\"brace200\"
2680     \\hspace #2
2681     \\rotate #180
2682     \\lookup #\"brace180\"
2683   }
2684 }
2685 @end lilypond"
2686   (ly:font-get-glyph (ly:paper-get-font layout props)
2687                      glyph-name))
2688
2689 (define-markup-command (char layout props num)
2690   (integer?)
2691   #:category other
2692   "Produce a single character.  Characters encoded in hexadecimal
2693 format require the prefix @code{#x}.
2694
2695 @lilypond[verbatim,quote]
2696 \\markup {
2697   \\char #65 \\char ##x00a9
2698 }
2699 @end lilypond"
2700   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
2701
2702 (define number->mark-letter-vector (make-vector 25 #\A))
2703
2704 (do ((i 0 (1+ i))
2705      (j 0 (1+ j)))
2706     ((>= i 26))
2707   (if (= i (- (char->integer #\I) (char->integer #\A)))
2708       (set! i (1+ i)))
2709   (vector-set! number->mark-letter-vector j
2710                (integer->char (+ i (char->integer #\A)))))
2711
2712 (define number->mark-alphabet-vector (list->vector
2713   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
2714
2715 (define (number->markletter-string vec n)
2716   "Double letters for big marks."
2717   (let* ((lst (vector-length vec)))
2718
2719     (if (>= n lst)
2720         (string-append (number->markletter-string vec (1- (quotient n lst)))
2721                        (number->markletter-string vec (remainder n lst)))
2722         (make-string 1 (vector-ref vec n)))))
2723
2724 (define-markup-command (markletter layout props num)
2725   (integer?)
2726   #:category other
2727   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2728 (skipping letter@tie{}I), and continue with double letters.
2729
2730 @lilypond[verbatim,quote]
2731 \\markup {
2732   \\markletter #8
2733   \\hspace #2
2734   \\markletter #26
2735 }
2736 @end lilypond"
2737   (ly:text-interface::interpret-markup layout props
2738     (number->markletter-string number->mark-letter-vector num)))
2739
2740 (define-markup-command (markalphabet layout props num)
2741   (integer?)
2742   #:category other
2743    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2744 and continue with double letters.
2745
2746 @lilypond[verbatim,quote]
2747 \\markup {
2748   \\markalphabet #8
2749   \\hspace #2
2750   \\markalphabet #26
2751 }
2752 @end lilypond"
2753    (ly:text-interface::interpret-markup layout props
2754      (number->markletter-string number->mark-alphabet-vector num)))
2755
2756 (define-public (horizontal-slash-interval num forward number-interval mag)
2757   (if forward
2758     (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
2759           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2760           (else (interval-widen number-interval (* mag 0.25))))
2761     (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
2762           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2763           (else (interval-widen number-interval (* mag 0.25))))
2764   ))
2765
2766 (define-public (adjust-slash-stencil num forward stencil mag)
2767   (if forward
2768     (cond ((= num 2)
2769               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2770           ((= num 3)
2771               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2772           ;((= num 5)
2773               ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
2774           ;((= num 7)
2775           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2776           (else stencil))
2777     (cond ((= num 6)
2778               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
2779           ;((= num 8)
2780           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2781           (else stencil))
2782   )
2783 )
2784
2785 (define (slashed-digit-internal layout props num forward font-size thickness)
2786   (let* ((mag (magstep font-size))
2787          (thickness (* mag
2788                        (ly:output-def-lookup layout 'line-thickness)
2789                        thickness))
2790          ; backward slashes might use slope and point in the other direction!
2791          (dy (* mag (if forward 0.4 -0.4)))
2792          (number-stencil (interpret-markup layout
2793                                            (prepend-alist-chain 'font-encoding 'fetaText props)
2794                                            (number->string num)))
2795          (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
2796          (center (interval-center (ly:stencil-extent number-stencil Y)))
2797          ; Use the real extents of the slash, not the whole number, because we
2798          ; might translate the slash later on!
2799          (num-y (interval-widen (cons center center) (abs dy)))
2800          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
2801          (slash-stencil (if is-sane
2802                             (make-line-stencil thickness
2803                                          (car num-x) (- (interval-center num-y) dy)
2804                                          (cdr num-x) (+ (interval-center num-y) dy))
2805                             #f)))
2806     (if (ly:stencil? slash-stencil)
2807       (begin
2808         ; for some numbers we need to shift the slash/backslash up or down to make
2809         ; the slashed digit look better
2810         (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
2811         (set! number-stencil
2812           (ly:stencil-add number-stencil slash-stencil)))
2813       (ly:warning "Unable to create slashed digit ~a" num))
2814     number-stencil))
2815
2816
2817 (define-markup-command (slashed-digit layout props num)
2818   (integer?)
2819   #:category other
2820   #:properties ((font-size 0)
2821                 (thickness 1.6))
2822   "
2823 @cindex slashed digits
2824
2825 A feta number, with slash.  This is for use in the context of
2826 figured bass notation.
2827 @lilypond[verbatim,quote]
2828 \\markup {
2829   \\slashed-digit #5
2830   \\hspace #2
2831   \\override #'(thickness . 3)
2832   \\slashed-digit #7
2833 }
2834 @end lilypond"
2835   (slashed-digit-internal layout props num #t font-size thickness))
2836
2837 (define-markup-command (backslashed-digit layout props num)
2838   (integer?)
2839   #:category other
2840   #:properties ((font-size 0)
2841                 (thickness 1.6))
2842   "
2843 @cindex backslashed digits
2844
2845 A feta number, with backslash.  This is for use in the context of
2846 figured bass notation.
2847 @lilypond[verbatim,quote]
2848 \\markup {
2849   \\backslashed-digit #5
2850   \\hspace #2
2851   \\override #'(thickness . 3)
2852   \\backslashed-digit #7
2853 }
2854 @end lilypond"
2855   (slashed-digit-internal layout props num #f font-size thickness))
2856
2857 ;; eyeglasses
2858 (define eyeglassespath
2859   '((moveto 0.42 0.77)
2860     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
2861     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
2862     (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
2863     (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
2864     (closepath)
2865     (moveto 2.07 0.77)
2866     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
2867     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
2868     (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
2869     (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
2870     (closepath)
2871     (moveto 1.025 0.935)
2872     (rcurveto 0 0.182 -0.148 0.33 -0.33 0.33)
2873     (rcurveto -0.182 0 -0.33 -0.148 -0.33 -0.33)
2874     (moveto -0.68 0.77)
2875     (rlineto 0.66 1.43)
2876     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)
2877     (moveto 2.07 0.77)
2878     (rlineto 0.66 1.43)
2879     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)))
2880
2881 (define-markup-command (eyeglasses layout props)
2882   ()
2883   #:category other
2884   "Prints out eyeglasses, indicating strongly to look at the conductor.
2885 @lilypond[verbatim,quote]
2886 \\markup { \\eyeglasses }
2887 @end lilypond"
2888   (interpret-markup layout props
2889     (make-override-markup '(line-cap-style . butt)
2890       (make-path-markup 0.15 eyeglassespath))))
2891
2892 (define-markup-command (left-brace layout props size)
2893   (number?)
2894   #:category other
2895   "
2896 A feta brace in point size @var{size}.
2897
2898 @lilypond[verbatim,quote]
2899 \\markup {
2900   \\left-brace #35
2901   \\hspace #2
2902   \\left-brace #45
2903 }
2904 @end lilypond"
2905   (let* ((font (ly:paper-get-font layout
2906                                   (cons '((font-encoding . fetaBraces)
2907                                           (font-name . #f))
2908                                         props)))
2909          (glyph-count (1- (ly:otf-glyph-count font)))
2910          (scale (ly:output-def-lookup layout 'output-scale))
2911          (scaled-size (/ (ly:pt size) scale))
2912          (glyph (lambda (n)
2913                   (ly:font-get-glyph font (string-append "brace"
2914                                                          (number->string n)))))
2915          (get-y-from-brace (lambda (brace)
2916                              (interval-length
2917                               (ly:stencil-extent (glyph brace) Y))))
2918          (find-brace (binary-search 0 glyph-count get-y-from-brace scaled-size))
2919          (glyph-found (glyph find-brace)))
2920
2921     (if (or (null? (ly:stencil-expr glyph-found))
2922             (< scaled-size (interval-length (ly:stencil-extent (glyph 0) Y)))
2923             (> scaled-size (interval-length
2924                             (ly:stencil-extent (glyph glyph-count) Y))))
2925         (begin
2926           (ly:warning (_ "no brace found for point size ~S ") size)
2927           (ly:warning (_ "defaulting to ~S pt")
2928                       (/ (* scale (interval-length
2929                                    (ly:stencil-extent glyph-found Y)))
2930                          (ly:pt 1)))))
2931     glyph-found))
2932
2933 (define-markup-command (right-brace layout props size)
2934   (number?)
2935   #:category other
2936   "
2937 A feta brace in point size @var{size}, rotated 180 degrees.
2938
2939 @lilypond[verbatim,quote]
2940 \\markup {
2941   \\right-brace #45
2942   \\hspace #2
2943   \\right-brace #35
2944 }
2945 @end lilypond"
2946   (interpret-markup layout props (markup #:rotate 180 #:left-brace size)))
2947
2948 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2949 ;; the note command.
2950 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2951
2952 ;; TODO: better syntax.
2953
2954 (define-markup-command (note-by-number layout props log dot-count dir)
2955   (number? number? number?)
2956   #:category music
2957   #:properties ((font-size 0)
2958                 (style '()))
2959   "
2960 @cindex notes within text by log and dot-count
2961
2962 Construct a note symbol, with stem.  By using fractional values for
2963 @var{dir}, longer or shorter stems can be obtained.
2964
2965 @lilypond[verbatim,quote]
2966 \\markup {
2967   \\note-by-number #3 #0 #DOWN
2968   \\hspace #2
2969   \\note-by-number #1 #2 #0.8
2970 }
2971 @end lilypond"
2972   (define (get-glyph-name-candidates dir log style)
2973     (map (lambda (dir-name)
2974            (format #f "noteheads.~a~a" dir-name
2975                    (if (and (symbol? style)
2976                             (not (equal? 'default style)))
2977                        (select-head-glyph style (min log 2))
2978                        (min log 2))))
2979          (list (if (= dir UP) "u" "d")
2980                "s")))
2981
2982   (define (get-glyph-name font cands)
2983     (if (null? cands)
2984         ""
2985         (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
2986             (get-glyph-name font (cdr cands))
2987             (car cands))))
2988
2989   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2990                                                props)))
2991          (size-factor (magstep font-size))
2992          (stem-length (* size-factor (max 3 (- log 1))))
2993          (head-glyph-name
2994           (let ((result (get-glyph-name font (get-glyph-name-candidates
2995                                               (sign dir) log style))))
2996             (if (string-null? result)
2997                 ;; If no glyph name can be found, select default heads.  Though
2998                 ;; this usually means an unsupported style has been chosen, it
2999                 ;; also prevents unrelated 'style settings from other grobs
3000                 ;; (e.g., TextSpanner and TimeSignature) leaking into markup.
3001                 (get-glyph-name font (get-glyph-name-candidates
3002                                       (sign dir) log 'default))
3003                 result)))
3004          (head-glyph (ly:font-get-glyph font head-glyph-name))
3005          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
3006          (stem-thickness (* size-factor 0.13))
3007          (stemy (* dir stem-length))
3008          (attach-off (cons (interval-index
3009                             (ly:stencil-extent head-glyph X)
3010                             (* (sign dir) (car attach-indices)))
3011                            (* (sign dir) ; fixme, this is inconsistent between X & Y.
3012                               (interval-index
3013                                (ly:stencil-extent head-glyph Y)
3014                                (cdr attach-indices)))))
3015          (stem-glyph (and (> log 0)
3016                           (ly:round-filled-box
3017                            (ordered-cons (car attach-off)
3018                                          (+ (car attach-off)
3019                                             (* (- (sign dir)) stem-thickness)))
3020                            (cons (min stemy (cdr attach-off))
3021                                  (max stemy (cdr attach-off)))
3022                            (/ stem-thickness 3))))
3023
3024          (dot (ly:font-get-glyph font "dots.dot"))
3025          (dotwid (interval-length (ly:stencil-extent dot X)))
3026          (dots (and (> dot-count 0)
3027                     (apply ly:stencil-add
3028                            (map (lambda (x)
3029                                   (ly:stencil-translate-axis
3030                                    dot (* 2 x dotwid) X))
3031                                 (iota dot-count)))))
3032          (flaggl (and (> log 2)
3033                       (ly:stencil-translate
3034                        (ly:font-get-glyph font
3035                                           (string-append "flags."
3036                                                          (if (> dir 0) "u" "d")
3037                                                          (number->string log)))
3038                        (cons (+ (car attach-off) (if (< dir 0)
3039                                                      stem-thickness 0))
3040                              stemy)))))
3041
3042     ;; If there is a flag on an upstem and the stem is short, move the dots
3043     ;; to avoid the flag.  16th notes get a special case because their flags
3044     ;; hang lower than any other flags.
3045     (if (and dots (> dir 0) (> log 2)
3046              (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
3047         (set! dots (ly:stencil-translate-axis dots 0.5 X)))
3048     (if flaggl
3049         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
3050     (if (ly:stencil? stem-glyph)
3051         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
3052         (set! stem-glyph head-glyph))
3053     (if (ly:stencil? dots)
3054         (set! stem-glyph
3055               (ly:stencil-add
3056                (ly:stencil-translate-axis
3057                 dots
3058                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
3059                 X)
3060                stem-glyph)))
3061     stem-glyph))
3062
3063 (define-public log2
3064   (let ((divisor (log 2)))
3065     (lambda (z) (inexact->exact (/ (log z) divisor)))))
3066
3067 (define (parse-simple-duration duration-string)
3068   "Parse the `duration-string', e.g. ''4..'' or ''breve.'',
3069 and return a (log dots) list."
3070   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)")
3071                             duration-string)))
3072     (if (and match (string=? duration-string (match:substring match 0)))
3073         (let ((len (match:substring match 1))
3074               (dots (match:substring match 2)))
3075           (list (cond ((string=? len "breve") -1)
3076                       ((string=? len "longa") -2)
3077                       ((string=? len "maxima") -3)
3078                       (else (log2 (string->number len))))
3079                 (if dots (string-length dots) 0)))
3080         (ly:error (_ "not a valid duration string: ~a") duration-string))))
3081
3082 (define-markup-command (note layout props duration dir)
3083   (string? number?)
3084   #:category music
3085   #:properties (note-by-number-markup)
3086   "
3087 @cindex notes within text by string
3088
3089 This produces a note with a stem pointing in @var{dir} direction, with
3090 the @var{duration} for the note head type and augmentation dots.  For
3091 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
3092 a shortened down stem.
3093
3094 @lilypond[verbatim,quote]
3095 \\markup {
3096   \\override #'(style . cross) {
3097     \\note #\"4..\" #UP
3098   }
3099   \\hspace #2
3100   \\note #\"breve\" #0
3101 }
3102 @end lilypond"
3103   (let ((parsed (parse-simple-duration duration)))
3104     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
3105
3106 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3107 ;; translating.
3108 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3109
3110 (define-markup-command (lower layout props amount arg)
3111   (number? markup?)
3112   #:category align
3113   "
3114 @cindex lowering text
3115
3116 Lower @var{arg} by the distance @var{amount}.
3117 A negative @var{amount} indicates raising; see also @code{\\raise}.
3118
3119 @lilypond[verbatim,quote]
3120 \\markup {
3121   one
3122   \\lower #3
3123   two
3124   three
3125 }
3126 @end lilypond"
3127   (ly:stencil-translate-axis (interpret-markup layout props arg)
3128                              (- amount) Y))
3129
3130 (define-markup-command (translate-scaled layout props offset arg)
3131   (number-pair? markup?)
3132   #:category align
3133   #:properties ((font-size 0))
3134   "
3135 @cindex translating text
3136 @cindex scaling text
3137
3138 Translate @var{arg} by @var{offset}, scaling the offset by the
3139 @code{font-size}.
3140
3141 @lilypond[verbatim,quote]
3142 \\markup {
3143   \\fontsize #5 {
3144     * \\translate #'(2 . 3) translate
3145     \\hspace #2
3146     * \\translate-scaled #'(2 . 3) translate-scaled
3147   }
3148 }
3149 @end lilypond"
3150   (let* ((factor (magstep font-size))
3151          (scaled (cons (* factor (car offset))
3152                        (* factor (cdr offset)))))
3153     (ly:stencil-translate (interpret-markup layout props arg)
3154                           scaled)))
3155
3156 (define-markup-command (raise layout props amount arg)
3157   (number? markup?)
3158   #:category align
3159   "
3160 @cindex raising text
3161
3162 Raise @var{arg} by the distance @var{amount}.
3163 A negative @var{amount} indicates lowering, see also @code{\\lower}.
3164
3165 The argument to @code{\\raise} is the vertical displacement amount,
3166 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
3167 raise objects in relation to their surrounding markups.
3168
3169 If the text object itself is positioned above or below the staff, then
3170 @code{\\raise} cannot be used to move it, since the mechanism that
3171 positions it next to the staff cancels any shift made with
3172 @code{\\raise}.  For vertical positioning, use the @code{padding}
3173 and/or @code{extra-offset} properties.
3174
3175 @lilypond[verbatim,quote]
3176 \\markup {
3177   C
3178   \\small
3179   \\bold
3180   \\raise #1.0
3181   9/7+
3182 }
3183 @end lilypond"
3184   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
3185
3186 (define-markup-command (fraction layout props arg1 arg2)
3187   (markup? markup?)
3188   #:category other
3189   #:properties ((font-size 0))
3190   "
3191 @cindex creating text fractions
3192
3193 Make a fraction of two markups.
3194 @lilypond[verbatim,quote]
3195 \\markup {
3196   π ≈
3197   \\fraction 355 113
3198 }
3199 @end lilypond"
3200   (let* ((m1 (interpret-markup layout props arg1))
3201          (m2 (interpret-markup layout props arg2))
3202          (factor (magstep font-size))
3203          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
3204          (padding (* factor 0.2))
3205          (baseline (* factor 0.6))
3206          (offset (* factor 0.75)))
3207     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
3208     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
3209     (let* ((x1 (ly:stencil-extent m1 X))
3210            (x2 (ly:stencil-extent m2 X))
3211            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
3212            ;; should stack mols separately, to maintain LINE on baseline
3213            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
3214       (set! stack
3215             (ly:stencil-aligned-to stack Y CENTER))
3216       (set! stack
3217             (ly:stencil-aligned-to stack X LEFT))
3218       ;; should have EX dimension
3219       ;; empirical anyway
3220       (ly:stencil-translate-axis stack offset Y))))
3221
3222 (define-markup-command (normal-size-super layout props arg)
3223   (markup?)
3224   #:category font
3225   #:properties ((baseline-skip))
3226   "
3227 @cindex setting superscript in standard font size
3228
3229 Set @var{arg} in superscript with a normal font size.
3230
3231 @lilypond[verbatim,quote]
3232 \\markup {
3233   default
3234   \\normal-size-super {
3235     superscript in standard size
3236   }
3237 }
3238 @end lilypond"
3239   (ly:stencil-translate-axis
3240    (interpret-markup layout props arg)
3241    (* 0.5 baseline-skip) Y))
3242
3243 (define-markup-command (super layout props arg)
3244   (markup?)
3245   #:category font
3246   #:properties ((font-size 0)
3247                 (baseline-skip))
3248   "
3249 @cindex superscript text
3250
3251 Set @var{arg} in superscript.
3252
3253 @lilypond[verbatim,quote]
3254 \\markup {
3255   E =
3256   \\concat {
3257     mc
3258     \\super
3259     2
3260   }
3261 }
3262 @end lilypond"
3263   (ly:stencil-translate-axis
3264    (interpret-markup
3265     layout
3266     (cons `((font-size . ,(- font-size 3))) props)
3267     arg)
3268    (* 0.5 baseline-skip)
3269    Y))
3270
3271 (define-markup-command (translate layout props offset arg)
3272   (number-pair? markup?)
3273   #:category align
3274   "
3275 @cindex translating text
3276
3277 Translate @var{arg} relative to its surroundings.  @var{offset}
3278 is a pair of numbers representing the displacement in the X and Y axis.
3279
3280 @lilypond[verbatim,quote]
3281 \\markup {
3282   *
3283   \\translate #'(2 . 3)
3284   \\line { translated two spaces right, three up }
3285 }
3286 @end lilypond"
3287   (ly:stencil-translate (interpret-markup layout props arg)
3288                         offset))
3289
3290 (define-markup-command (sub layout props arg)
3291   (markup?)
3292   #:category font
3293   #:properties ((font-size 0)
3294                 (baseline-skip))
3295   "
3296 @cindex subscript text
3297
3298 Set @var{arg} in subscript.
3299
3300 @lilypond[verbatim,quote]
3301 \\markup {
3302   \\concat {
3303     H
3304     \\sub {
3305       2
3306     }
3307     O
3308   }
3309 }
3310 @end lilypond"
3311   (ly:stencil-translate-axis
3312    (interpret-markup
3313     layout
3314     (cons `((font-size . ,(- font-size 3))) props)
3315     arg)
3316    (* -0.5 baseline-skip)
3317    Y))
3318
3319 (define-markup-command (normal-size-sub layout props arg)
3320   (markup?)
3321   #:category font
3322   #:properties ((baseline-skip))
3323   "
3324 @cindex setting subscript in standard font size
3325
3326 Set @var{arg} in subscript with a normal font size.
3327
3328 @lilypond[verbatim,quote]
3329 \\markup {
3330   default
3331   \\normal-size-sub {
3332     subscript in standard size
3333   }
3334 }
3335 @end lilypond"
3336   (ly:stencil-translate-axis
3337    (interpret-markup layout props arg)
3338    (* -0.5 baseline-skip)
3339    Y))
3340
3341 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3342 ;; brackets.
3343 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3344
3345 (define-markup-command (hbracket layout props arg)
3346   (markup?)
3347   #:category graphic
3348   "
3349 @cindex placing horizontal brackets around text
3350
3351 Draw horizontal brackets around @var{arg}.
3352
3353 @lilypond[verbatim,quote]
3354 \\markup {
3355   \\hbracket {
3356     \\line {
3357       one two three
3358     }
3359   }
3360 }
3361 @end lilypond"
3362   (let ((th 0.1) ;; todo: take from GROB.
3363         (m (interpret-markup layout props arg)))
3364     (bracketify-stencil m X th (* 2.5 th) th)))
3365
3366 (define-markup-command (bracket layout props arg)
3367   (markup?)
3368   #:category graphic
3369   "
3370 @cindex placing vertical brackets around text
3371
3372 Draw vertical brackets around @var{arg}.
3373
3374 @lilypond[verbatim,quote]
3375 \\markup {
3376   \\bracket {
3377     \\note #\"2.\" #UP
3378   }
3379 }
3380 @end lilypond"
3381   (let ((th 0.1) ;; todo: take from GROB.
3382         (m (interpret-markup layout props arg)))
3383     (bracketify-stencil m Y th (* 2.5 th) th)))
3384
3385 (define-markup-command (parenthesize layout props arg)
3386   (markup?)
3387   #:category graphic
3388   #:properties ((angularity 0)
3389                 (padding)
3390                 (size 1)
3391                 (thickness 1)
3392                 (width 0.25))
3393   "
3394 @cindex placing parentheses around text
3395
3396 Draw parentheses around @var{arg}.  This is useful for parenthesizing
3397 a column containing several lines of text.
3398
3399 @lilypond[verbatim,quote]
3400 \\markup {
3401   \\line {
3402     \\parenthesize {
3403       \\column {
3404         foo
3405         bar
3406       }
3407     }
3408     \\override #'(angularity . 2) {
3409       \\parenthesize {
3410         \\column {
3411           bah
3412           baz
3413         }
3414       }
3415     }
3416   }
3417 }
3418 @end lilypond"
3419   (let* ((markup (interpret-markup layout props arg))
3420          (scaled-width (* size width))
3421          (scaled-thickness
3422           (* (chain-assoc-get 'line-thickness props 0.1)
3423              thickness))
3424          (half-thickness
3425           (min (* size 0.5 scaled-thickness)
3426                (* (/ 4 3.0) scaled-width)))
3427          (padding (chain-assoc-get 'padding props half-thickness)))
3428     (parenthesize-stencil
3429      markup half-thickness scaled-width angularity padding)))
3430
3431 \f
3432 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3433 ;; Delayed markup evaluation
3434 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3435
3436 (define-markup-command (page-ref layout props label gauge default)
3437   (symbol? markup? markup?)
3438   #:category other
3439   "
3440 @cindex referencing page numbers in text
3441
3442 Reference to a page number. @var{label} is the label set on the referenced
3443 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
3444 the maximum width of the page number, and @var{default} the value to display
3445 when @var{label} is not found."
3446   (let* ((gauge-stencil (interpret-markup layout props gauge))
3447          (x-ext (ly:stencil-extent gauge-stencil X))
3448          (y-ext (ly:stencil-extent gauge-stencil Y)))
3449     (ly:make-stencil
3450      `(delay-stencil-evaluation
3451        ,(delay (ly:stencil-expr
3452                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
3453                        (page-number (if (list? table)
3454                                         (assoc-get label table)
3455                                         #f))
3456                        (page-markup (if page-number (format #f "~a" page-number) default))
3457                        (page-stencil (interpret-markup layout props page-markup))
3458                        (gap (- (interval-length x-ext)
3459                                (interval-length (ly:stencil-extent page-stencil X)))))
3460                   (interpret-markup layout props
3461                                     (markup #:concat (#:hspace gap page-markup)))))))
3462      x-ext
3463      y-ext)))
3464
3465 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3466 ;; scaling
3467 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3468
3469 (define-markup-command (scale layout props factor-pair arg)
3470   (number-pair? markup?)
3471   #:category graphic
3472   "
3473 @cindex scaling markup
3474 @cindex mirroring markup
3475
3476 Scale @var{arg}.  @var{factor-pair} is a pair of numbers
3477 representing the scaling-factor in the X and Y axes.
3478 Negative values may be used to produce mirror images.
3479
3480 @lilypond[verbatim,quote]
3481 \\markup {
3482   \\line {
3483     \\scale #'(2 . 1)
3484     stretched
3485     \\scale #'(1 . -1)
3486     mirrored
3487   }
3488 }
3489 @end lilypond"
3490   (let ((stil (interpret-markup layout props arg))
3491         (sx (car factor-pair))
3492         (sy (cdr factor-pair)))
3493     (ly:stencil-scale stil sx sy)))
3494
3495 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3496 ;; Repeating
3497 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3498
3499 (define-markup-command (pattern layout props count axis space pattern)
3500   (integer? integer? number? markup?)
3501   #:category other
3502   "
3503 Prints @var{count} times a @var{pattern} markup.
3504 Patterns are spaced apart by @var{space}.
3505 Patterns are distributed on @var{axis}.
3506
3507 @lilypond[verbatim, quote]
3508 \\markup \\column {
3509   \"Horizontally repeated :\"
3510   \\pattern #7 #X #2 \\flat
3511   \\null
3512   \"Vertically repeated :\"
3513   \\pattern #3 #Y #0.5 \\flat
3514 }
3515 @end lilypond"
3516   (let ((pattern-width (interval-length
3517                          (ly:stencil-extent (interpret-markup layout props pattern) X)))
3518         (new-props (prepend-alist-chain 'word-space 0 (prepend-alist-chain 'baseline-skip 0 props))))
3519     (let loop ((i (1- count)) (patterns (markup)))
3520       (if (zero? i)
3521           (interpret-markup
3522             layout
3523             new-props
3524             (if (= axis X)
3525                 (markup patterns pattern)
3526                 (markup #:column (patterns pattern))))
3527           (loop (1- i)
3528             (if (= axis X)
3529                 (markup patterns pattern #:hspace space)
3530                 (markup #:column (patterns pattern #:vspace space))))))))
3531
3532 (define-markup-command (fill-with-pattern layout props space dir pattern left right)
3533   (number? ly:dir? markup? markup? markup?)
3534   #:category align
3535   #:properties ((word-space)
3536                 (line-width))
3537   "
3538 Put @var{left} and @var{right} in a horizontal line of width @code{line-width}
3539 with a line of markups @var{pattern} in between.
3540 Patterns are spaced apart by @var{space}.
3541 Patterns are aligned to the @var{dir} markup.
3542
3543 @lilypond[verbatim, quote]
3544 \\markup \\column {
3545   \"right-aligned :\"
3546   \\fill-with-pattern #1 #RIGHT . first right
3547   \\fill-with-pattern #1 #RIGHT . second right
3548   \\null
3549   \"center-aligned :\"
3550   \\fill-with-pattern #1.5 #CENTER - left right
3551   \\null
3552   \"left-aligned :\"
3553   \\override #'(line-width . 50) \\fill-with-pattern #2 #LEFT : left first
3554   \\override #'(line-width . 50) \\fill-with-pattern #2 #LEFT : left second
3555 }
3556 @end lilypond"
3557   (let* ((pattern-x-extent (ly:stencil-extent (interpret-markup layout props pattern) X))
3558          (pattern-width (interval-length pattern-x-extent))
3559          (left-width (interval-length (ly:stencil-extent (interpret-markup layout props left) X)))
3560          (right-width (interval-length (ly:stencil-extent (interpret-markup layout props right) X)))
3561          (middle-width (max 0 (- line-width (+ (+ left-width right-width) (* word-space 2)))))
3562          (period (+ space pattern-width))
3563          (count (truncate (/ (- middle-width pattern-width) period)))
3564          (x-offset (+ (* (- (- middle-width (* count period)) pattern-width) (/ (1+ dir) 2)) (abs (car pattern-x-extent)))))
3565     (interpret-markup layout props
3566                       (markup left
3567                               #:with-dimensions (cons 0 middle-width) '(0 . 0)
3568                               #:translate (cons x-offset 0)
3569                               #:pattern (1+ count) X space pattern
3570                               right))))
3571
3572 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3573 ;; Markup list commands
3574 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3575
3576 (define-public (space-lines baseline stils)
3577   (let space-stil ((stils stils)
3578                    (result (list)))
3579     (if (null? stils)
3580         (reverse! result)
3581         (let* ((stil (car stils))
3582                (dy-top (max (- (/ baseline 1.5)
3583                                (interval-bound (ly:stencil-extent stil Y) UP))
3584                             0.0))
3585                (dy-bottom (max (+ (/ baseline 3.0)
3586                                   (interval-bound (ly:stencil-extent stil Y) DOWN))
3587                                0.0))
3588                (new-stil (ly:make-stencil
3589                           (ly:stencil-expr stil)
3590                           (ly:stencil-extent stil X)
3591                           (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN)
3592                                    dy-bottom)
3593                                 (+ (interval-bound (ly:stencil-extent stil Y) UP)
3594                                    dy-top)))))
3595           (space-stil (cdr stils) (cons new-stil result))))))
3596
3597 (define-markup-list-command (justified-lines layout props args)
3598   (markup-list?)
3599   #:properties ((baseline-skip)
3600                 wordwrap-internal-markup-list)
3601   "
3602 @cindex justifying lines of text
3603
3604 Like @code{\\justify}, but return a list of lines instead of a single markup.
3605 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
3606 @var{X}@tie{}is the number of staff spaces."
3607   (space-lines baseline-skip
3608                (interpret-markup-list layout props
3609                                       (make-wordwrap-internal-markup-list #t args))))
3610
3611 (define-markup-list-command (wordwrap-lines layout props args)
3612   (markup-list?)
3613   #:properties ((baseline-skip)
3614                 wordwrap-internal-markup-list)
3615   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
3616 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
3617 where @var{X} is the number of staff spaces."
3618   (space-lines baseline-skip
3619                (interpret-markup-list layout props
3620                                       (make-wordwrap-internal-markup-list #f args))))
3621
3622 (define-markup-list-command (column-lines layout props args)
3623   (markup-list?)
3624   #:properties ((baseline-skip))
3625   "Like @code{\\column}, but return a list of lines instead of a single markup.
3626 @code{baseline-skip} determines the space between each markup in @var{args}."
3627   (space-lines baseline-skip
3628                (interpret-markup-list layout props args)))
3629
3630 (define-markup-list-command (override-lines layout props new-prop args)
3631   (pair? markup-list?)
3632   "Like @code{\\override}, for markup lists."
3633   (interpret-markup-list layout (cons (list new-prop) props) args))