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 "
 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     (stack-lines -1 0.0 baseline aligned-mols)))
1490
1491 (define-markup-command (center-column layout props args)
1492   (markup-list?)
1493   #:category align
1494   #:properties ((baseline-skip))
1495   "
1496 @cindex centering a column of text
1497
1498 Put @code{args} in a centered column.
1499
1500 @lilypond[verbatim,quote]
1501 \\markup {
1502   \\center-column {
1503     one
1504     two
1505     three
1506   }
1507 }
1508 @end lilypond"
1509   (general-column CENTER baseline-skip (interpret-markup-list layout props args)))
1510
1511 (define-markup-command (left-column layout props args)
1512   (markup-list?)
1513   #:category align
1514   #:properties ((baseline-skip))
1515  "
1516 @cindex text columns, left-aligned
1517
1518 Put @code{args} in a left-aligned column.
1519
1520 @lilypond[verbatim,quote]
1521 \\markup {
1522   \\left-column {
1523     one
1524     two
1525     three
1526   }
1527 }
1528 @end lilypond"
1529   (general-column LEFT baseline-skip (interpret-markup-list layout props args)))
1530
1531 (define-markup-command (right-column layout props args)
1532   (markup-list?)
1533   #:category align
1534   #:properties ((baseline-skip))
1535  "
1536 @cindex text columns, right-aligned
1537
1538 Put @code{args} in a right-aligned column.
1539
1540 @lilypond[verbatim,quote]
1541 \\markup {
1542   \\right-column {
1543     one
1544     two
1545     three
1546   }
1547 }
1548 @end lilypond"
1549   (general-column RIGHT baseline-skip (interpret-markup-list layout props args)))
1550
1551 (define-markup-command (vcenter layout props arg)
1552   (markup?)
1553   #:category align
1554   "
1555 @cindex vertically centering text
1556
1557 Align @code{arg} to its Y@tie{}center.
1558
1559 @lilypond[verbatim,quote]
1560 \\markup {
1561   one
1562   \\vcenter
1563   two
1564   three
1565 }
1566 @end lilypond"
1567   (let* ((mol (interpret-markup layout props arg)))
1568     (ly:stencil-aligned-to mol Y CENTER)))
1569
1570 (define-markup-command (center-align layout props arg)
1571   (markup?)
1572   #:category align
1573   "
1574 @cindex horizontally centering text
1575
1576 Align @code{arg} to its X@tie{}center.
1577
1578 @lilypond[verbatim,quote]
1579 \\markup {
1580   \\column {
1581     one
1582     \\center-align
1583     two
1584     three
1585   }
1586 }
1587 @end lilypond"
1588   (let* ((mol (interpret-markup layout props arg)))
1589     (ly:stencil-aligned-to mol X CENTER)))
1590
1591 (define-markup-command (right-align layout props arg)
1592   (markup?)
1593   #:category align
1594   "
1595 @cindex right aligning text
1596
1597 Align @var{arg} on its right edge.
1598
1599 @lilypond[verbatim,quote]
1600 \\markup {
1601   \\column {
1602     one
1603     \\right-align
1604     two
1605     three
1606   }
1607 }
1608 @end lilypond"
1609   (let* ((m (interpret-markup layout props arg)))
1610     (ly:stencil-aligned-to m X RIGHT)))
1611
1612 (define-markup-command (left-align layout props arg)
1613   (markup?)
1614   #:category align
1615   "
1616 @cindex left aligning text
1617
1618 Align @var{arg} on its left edge.
1619
1620 @lilypond[verbatim,quote]
1621 \\markup {
1622   \\column {
1623     one
1624     \\left-align
1625     two
1626     three
1627   }
1628 }
1629 @end lilypond"
1630   (let* ((m (interpret-markup layout props arg)))
1631     (ly:stencil-aligned-to m X LEFT)))
1632
1633 (define-markup-command (general-align layout props axis dir arg)
1634   (integer? number? markup?)
1635   #:category align
1636   "
1637 @cindex controlling general text alignment
1638
1639 Align @var{arg} in @var{axis} direction to the @var{dir} side.
1640
1641 @lilypond[verbatim,quote]
1642 \\markup {
1643   \\column {
1644     one
1645     \\general-align #X #LEFT
1646     two
1647     three
1648     \\null
1649     one
1650     \\general-align #X #CENTER
1651     two
1652     three
1653     \\null
1654     \\line {
1655       one
1656       \\general-align #Y #UP
1657       two
1658       three
1659     }
1660     \\null
1661     \\line {
1662       one
1663       \\general-align #Y #3.2
1664       two
1665       three
1666     }
1667   }
1668 }
1669 @end lilypond"
1670   (let* ((m (interpret-markup layout props arg)))
1671     (ly:stencil-aligned-to m axis dir)))
1672
1673 (define-markup-command (halign layout props dir arg)
1674   (number? markup?)
1675   #:category align
1676   "
1677 @cindex setting horizontal text alignment
1678
1679 Set horizontal alignment.  If @var{dir} is @code{-1}, then it is
1680 left-aligned, while @code{+1} is right.  Values in between interpolate
1681 alignment accordingly.
1682
1683 @lilypond[verbatim,quote]
1684 \\markup {
1685   \\column {
1686     one
1687     \\halign #LEFT
1688     two
1689     three
1690     \\null
1691     one
1692     \\halign #CENTER
1693     two
1694     three
1695     \\null
1696     one
1697     \\halign #RIGHT
1698     two
1699     three
1700     \\null
1701     one
1702     \\halign #-5
1703     two
1704     three
1705   }
1706 }
1707 @end lilypond"
1708   (let* ((m (interpret-markup layout props arg)))
1709     (ly:stencil-aligned-to m X dir)))
1710
1711 (define-markup-command (with-dimensions layout props x y arg)
1712   (number-pair? number-pair? markup?)
1713   #:category other
1714   "
1715 @cindex setting extent of text objects
1716
1717 Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}."
1718   (let* ((m (interpret-markup layout props arg)))
1719     (ly:make-stencil (ly:stencil-expr m) x y)))
1720
1721 (define-markup-command (pad-around layout props amount arg)
1722   (number? markup?)
1723   #:category align
1724   "Add padding @var{amount} all around @var{arg}.
1725
1726 @lilypond[verbatim,quote]
1727 \\markup {
1728   \\box {
1729     default
1730   }
1731   \\hspace #2
1732   \\box {
1733     \\pad-around #0.5 {
1734       padded
1735     }
1736   }
1737 }
1738 @end lilypond"
1739   (let* ((m (interpret-markup layout props arg))
1740          (x (ly:stencil-extent m X))
1741          (y (ly:stencil-extent m Y)))
1742     (ly:make-stencil (ly:stencil-expr m)
1743                      (interval-widen x amount)
1744                      (interval-widen y amount))))
1745
1746 (define-markup-command (pad-x layout props amount arg)
1747   (number? markup?)
1748   #:category align
1749   "
1750 @cindex padding text horizontally
1751
1752 Add padding @var{amount} around @var{arg} in the X@tie{}direction.
1753
1754 @lilypond[verbatim,quote]
1755 \\markup {
1756   \\box {
1757     default
1758   }
1759   \\hspace #4
1760   \\box {
1761     \\pad-x #2 {
1762       padded
1763     }
1764   }
1765 }
1766 @end lilypond"
1767   (let* ((m (interpret-markup layout props arg))
1768          (x (ly:stencil-extent m X))
1769          (y (ly:stencil-extent m Y)))
1770     (ly:make-stencil (ly:stencil-expr m)
1771                      (interval-widen x amount)
1772                      y)))
1773
1774 (define-markup-command (put-adjacent layout props axis dir arg1 arg2)
1775   (integer? ly:dir? markup? markup?)
1776   #:category align
1777   "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}."
1778   (let ((m1 (interpret-markup layout props arg1))
1779         (m2 (interpret-markup layout props arg2)))
1780     (ly:stencil-combine-at-edge m1 axis dir m2 0.0)))
1781
1782 (define-markup-command (transparent layout props arg)
1783   (markup?)
1784   #:category other
1785   "Make @var{arg} transparent.
1786
1787 @lilypond[verbatim,quote]
1788 \\markup {
1789   \\transparent {
1790     invisible text
1791   }
1792 }
1793 @end lilypond"
1794   (let* ((m (interpret-markup layout props arg))
1795          (x (ly:stencil-extent m X))
1796          (y (ly:stencil-extent m Y)))
1797     (ly:make-stencil "" x y)))
1798
1799 (define-markup-command (pad-to-box layout props x-ext y-ext arg)
1800   (number-pair? number-pair? markup?)
1801   #:category align
1802   "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space.
1803
1804 @lilypond[verbatim,quote]
1805 \\markup {
1806   \\box {
1807     default
1808   }
1809   \\hspace #4
1810   \\box {
1811     \\pad-to-box #'(0 . 10) #'(0 . 3) {
1812       padded
1813     }
1814   }
1815 }
1816 @end lilypond"
1817   (let* ((m (interpret-markup layout props arg))
1818          (x (ly:stencil-extent m X))
1819          (y (ly:stencil-extent m Y)))
1820     (ly:make-stencil (ly:stencil-expr m)
1821                      (interval-union x-ext x)
1822                      (interval-union y-ext y))))
1823
1824 (define-markup-command (hcenter-in layout props length arg)
1825   (number? markup?)
1826   #:category align
1827   "Center @var{arg} horizontally within a box of extending
1828 @var{length}/2 to the left and right.
1829
1830 @lilypond[quote,verbatim]
1831 \\new StaffGroup <<
1832   \\new Staff {
1833     \\set Staff.instrumentName = \\markup {
1834       \\hcenter-in #12
1835       Oboe
1836     }
1837     c''1
1838   }
1839   \\new Staff {
1840     \\set Staff.instrumentName = \\markup {
1841       \\hcenter-in #12
1842       Bassoon
1843     }
1844     \\clef tenor
1845     c'1
1846   }
1847 >>
1848 @end lilypond"
1849   (interpret-markup layout props
1850                     (make-pad-to-box-markup
1851                      (cons (/ length -2) (/ length 2))
1852                      '(0 . 0)
1853                      (make-center-align-markup arg))))
1854
1855 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1856 ;; property
1857 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1858
1859 (define-markup-command (fromproperty layout props symbol)
1860   (symbol?)
1861   #:category other
1862   "Read the @var{symbol} from property settings, and produce a stencil
1863 from the markup contained within.  If @var{symbol} is not defined, it
1864 returns an empty markup.
1865
1866 @lilypond[verbatim,quote]
1867 \\header {
1868   myTitle = \"myTitle\"
1869   title = \\markup {
1870     from
1871     \\italic
1872     \\fromproperty #'header:myTitle
1873   }
1874 }
1875 \\markup {
1876   \\null
1877 }
1878 @end lilypond"
1879   (let ((m (chain-assoc-get symbol props)))
1880     (if (markup? m)
1881         (interpret-markup layout props m)
1882         empty-stencil)))
1883
1884 (define-markup-command (on-the-fly layout props procedure arg)
1885   (symbol? markup?)
1886   #:category other
1887   "Apply the @var{procedure} markup command to @var{arg}.
1888 @var{procedure} should take a single argument."
1889   (let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
1890     (set-object-property! anonymous-with-signature
1891                           'markup-signature
1892                           (list markup?))
1893     (interpret-markup layout props (list anonymous-with-signature arg))))
1894
1895 (define-markup-command (footnote layout props mkup note)
1896   (markup? markup?)
1897   #:category other
1898   "Have footnote @var{note} act as an annotation to the markup @var{mkup}."
1899   (ly:stencil-combine-at-edge
1900     (interpret-markup layout props mkup)
1901     X
1902     RIGHT
1903     (ly:make-stencil
1904       `(footnote ,(interpret-markup layout props note))
1905       '(0 . 0)
1906       '(0 . 0))
1907     0.0))
1908
1909 (define-markup-command (override layout props new-prop arg)
1910   (pair? markup?)
1911   #:category other
1912   "
1913 @cindex overriding properties within text markup
1914
1915 Add the argument @var{new-prop} to the property list.  Properties
1916 may be any property supported by @rinternals{font-interface},
1917 @rinternals{text-interface} and
1918 @rinternals{instrument-specific-markup-interface}.
1919
1920 @lilypond[verbatim,quote]
1921 \\markup {
1922   \\line {
1923     \\column {
1924       default
1925       baseline-skip
1926     }
1927     \\hspace #2
1928     \\override #'(baseline-skip . 4) {
1929       \\column {
1930         increased
1931         baseline-skip
1932       }
1933     }
1934   }
1935 }
1936 @end lilypond"
1937   (interpret-markup layout (cons (list new-prop) props) arg))
1938
1939 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1940 ;; files
1941 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1942
1943 (define-markup-command (verbatim-file layout props name)
1944   (string?)
1945   #:category other
1946   "Read the contents of file @var{name}, and include it verbatim.
1947
1948 @lilypond[verbatim,quote]
1949 \\markup {
1950   \\verbatim-file #\"simple.ly\"
1951 }
1952 @end lilypond"
1953   (interpret-markup layout props
1954                     (if  (ly:get-option 'safe)
1955                          "verbatim-file disabled in safe mode"
1956                          (let* ((str (ly:gulp-file name))
1957                                 (lines (string-split str #\nl)))
1958                            (make-typewriter-markup
1959                             (make-column-markup lines))))))
1960
1961 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1962 ;; fonts.
1963 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1964
1965
1966 (define-markup-command (smaller layout props arg)
1967   (markup?)
1968   #:category font
1969   "Decrease the font size relative to the current setting.
1970
1971 @lilypond[verbatim,quote]
1972 \\markup {
1973   \\fontsize #3.5 {
1974     some large text
1975     \\hspace #2
1976     \\smaller {
1977       a bit smaller
1978     }
1979     \\hspace #2
1980     more large text
1981   }
1982 }
1983 @end lilypond"
1984   (interpret-markup layout props
1985    `(,fontsize-markup -1 ,arg)))
1986
1987 (define-markup-command (larger layout props arg)
1988   (markup?)
1989   #:category font
1990   "Increase the font size relative to the current setting.
1991
1992 @lilypond[verbatim,quote]
1993 \\markup {
1994   default
1995   \\hspace #2
1996   \\larger
1997   larger
1998 }
1999 @end lilypond"
2000   (interpret-markup layout props
2001    `(,fontsize-markup 1 ,arg)))
2002
2003 (define-markup-command (finger layout props arg)
2004   (markup?)
2005   #:category font
2006   "Set @var{arg} as small numbers.
2007
2008 @lilypond[verbatim,quote]
2009 \\markup {
2010   \\finger {
2011     1 2 3 4 5
2012   }
2013 }
2014 @end lilypond"
2015   (interpret-markup layout
2016                     (cons '((font-size . -5) (font-encoding . fetaText)) props)
2017                     arg))
2018
2019 (define-markup-command (abs-fontsize layout props size arg)
2020   (number? markup?)
2021   #:category font
2022   "Use @var{size} as the absolute font size to display @var{arg}.
2023 Adjusts @code{baseline-skip} and @code{word-space} accordingly.
2024
2025 @lilypond[verbatim,quote]
2026 \\markup {
2027   default text font size
2028   \\hspace #2
2029   \\abs-fontsize #16 { text font size 16 }
2030   \\hspace #2
2031   \\abs-fontsize #12 { text font size 12 }
2032 }
2033 @end lilypond"
2034   (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
2035          (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
2036          (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
2037          (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
2038          (magnification (/ size ref-size)))
2039     (interpret-markup layout
2040                       (cons `((baseline-skip . ,(* magnification ref-baseline))
2041                               (word-space . ,(* magnification ref-word-space))
2042                               (font-size . ,(magnification->font-size magnification)))
2043                             props)
2044                       arg)))
2045
2046 (define-markup-command (fontsize layout props increment arg)
2047   (number? markup?)
2048   #:category font
2049   #:properties ((font-size 0)
2050                 (word-space 1)
2051                 (baseline-skip 2))
2052   "Add @var{increment} to the font-size.  Adjusts @code{baseline-skip}
2053 accordingly.
2054
2055 @lilypond[verbatim,quote]
2056 \\markup {
2057   default
2058   \\hspace #2
2059   \\fontsize #-1.5
2060   smaller
2061 }
2062 @end lilypond"
2063   (let ((entries (list
2064                   (cons 'baseline-skip (* baseline-skip (magstep increment)))
2065                   (cons 'word-space (* word-space (magstep increment)))
2066                   (cons 'font-size (+ font-size increment)))))
2067     (interpret-markup layout (cons entries props) arg)))
2068
2069 (define-markup-command (magnify layout props sz arg)
2070   (number? markup?)
2071   #:category font
2072   "
2073 @cindex magnifying text
2074
2075 Set the font magnification for its argument.  In the following
2076 example, the middle@tie{}A is 10% larger:
2077
2078 @example
2079 A \\magnify #1.1 @{ A @} A
2080 @end example
2081
2082 Note: Magnification only works if a font name is explicitly selected.
2083 Use @code{\\fontsize} otherwise.
2084
2085 @lilypond[verbatim,quote]
2086 \\markup {
2087   default
2088   \\hspace #2
2089   \\magnify #1.5 {
2090     50% larger
2091   }
2092 }
2093 @end lilypond"
2094   (interpret-markup
2095    layout
2096    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
2097    arg))
2098
2099 (define-markup-command (bold layout props arg)
2100   (markup?)
2101   #:category font
2102   "Switch to bold font-series.
2103
2104 @lilypond[verbatim,quote]
2105 \\markup {
2106   default
2107   \\hspace #2
2108   \\bold
2109   bold
2110 }
2111 @end lilypond"
2112   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
2113
2114 (define-markup-command (sans layout props arg)
2115   (markup?)
2116   #:category font
2117   "Switch to the sans serif font family.
2118
2119 @lilypond[verbatim,quote]
2120 \\markup {
2121   default
2122   \\hspace #2
2123   \\sans {
2124     sans serif
2125   }
2126 }
2127 @end lilypond"
2128   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
2129
2130 (define-markup-command (number layout props arg)
2131   (markup?)
2132   #:category font
2133   "Set font family to @code{number}, which yields the font used for
2134 time signatures and fingerings.  This font contains numbers and
2135 some punctuation; it has no letters.
2136
2137 @lilypond[verbatim,quote]
2138 \\markup {
2139   \\number {
2140     0 1 2 3 4 5 6 7 8 9 . ,
2141   }
2142 }
2143 @end lilypond"
2144   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2145
2146 (define-markup-command (roman layout props arg)
2147   (markup?)
2148   #:category font
2149   "Set font family to @code{roman}.
2150
2151 @lilypond[verbatim,quote]
2152 \\markup {
2153   \\sans \\bold {
2154     sans serif, bold
2155     \\hspace #2
2156     \\roman {
2157       text in roman font family
2158     }
2159     \\hspace #2
2160     return to sans
2161   }
2162 }
2163 @end lilypond"
2164   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
2165
2166 (define-markup-command (huge layout props arg)
2167   (markup?)
2168   #:category font
2169   "Set font size to +2.
2170
2171 @lilypond[verbatim,quote]
2172 \\markup {
2173   default
2174   \\hspace #2
2175   \\huge
2176   huge
2177 }
2178 @end lilypond"
2179   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
2180
2181 (define-markup-command (large layout props arg)
2182   (markup?)
2183   #:category font
2184   "Set font size to +1.
2185
2186 @lilypond[verbatim,quote]
2187 \\markup {
2188   default
2189   \\hspace #2
2190   \\large
2191   large
2192 }
2193 @end lilypond"
2194   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
2195
2196 (define-markup-command (normalsize layout props arg)
2197   (markup?)
2198   #:category font
2199   "Set font size to default.
2200
2201 @lilypond[verbatim,quote]
2202 \\markup {
2203   \\teeny {
2204     this is very small
2205     \\hspace #2
2206     \\normalsize {
2207       normal size
2208     }
2209     \\hspace #2
2210     teeny again
2211   }
2212 }
2213 @end lilypond"
2214   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
2215
2216 (define-markup-command (small layout props arg)
2217   (markup?)
2218   #:category font
2219   "Set font size to -1.
2220
2221 @lilypond[verbatim,quote]
2222 \\markup {
2223   default
2224   \\hspace #2
2225   \\small
2226   small
2227 }
2228 @end lilypond"
2229   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
2230
2231 (define-markup-command (tiny layout props arg)
2232   (markup?)
2233   #:category font
2234   "Set font size to -2.
2235
2236 @lilypond[verbatim,quote]
2237 \\markup {
2238   default
2239   \\hspace #2
2240   \\tiny
2241   tiny
2242 }
2243 @end lilypond"
2244   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
2245
2246 (define-markup-command (teeny layout props arg)
2247   (markup?)
2248   #:category font
2249   "Set font size to -3.
2250
2251 @lilypond[verbatim,quote]
2252 \\markup {
2253   default
2254   \\hspace #2
2255   \\teeny
2256   teeny
2257 }
2258 @end lilypond"
2259   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
2260
2261 (define-markup-command (fontCaps layout props arg)
2262   (markup?)
2263   #:category font
2264   "Set @code{font-shape} to @code{caps}
2265
2266 Note: @code{\\fontCaps} requires the installation and selection of
2267 fonts which support the @code{caps} font shape."
2268   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
2269
2270 ;; Poor man's caps
2271 (define-markup-command (smallCaps layout props arg)
2272   (markup?)
2273   #:category font
2274   "Emit @var{arg} as small caps.
2275
2276 Note: @code{\\smallCaps} does not support accented characters.
2277
2278 @lilypond[verbatim,quote]
2279 \\markup {
2280   default
2281   \\hspace #2
2282   \\smallCaps {
2283     Text in small caps
2284   }
2285 }
2286 @end lilypond"
2287   (define (char-list->markup chars lower)
2288     (let ((final-string (string-upcase (reverse-list->string chars))))
2289       (if lower
2290           (markup #:fontsize -2 final-string)
2291           final-string)))
2292   (define (make-small-caps rest-chars currents current-is-lower prev-result)
2293     (if (null? rest-chars)
2294         (make-concat-markup
2295           (reverse! (cons (char-list->markup currents current-is-lower)
2296                           prev-result)))
2297         (let* ((ch (car rest-chars))
2298                (is-lower (char-lower-case? ch)))
2299           (if (or (and current-is-lower is-lower)
2300                   (and (not current-is-lower) (not is-lower)))
2301               (make-small-caps (cdr rest-chars)
2302                                (cons ch currents)
2303                                is-lower
2304                                prev-result)
2305               (make-small-caps (cdr rest-chars)
2306                                (list ch)
2307                                is-lower
2308                                (if (null? currents)
2309                                    prev-result
2310                                    (cons (char-list->markup
2311                                             currents current-is-lower)
2312                                          prev-result)))))))
2313   (interpret-markup layout props
2314     (if (string? arg)
2315         (make-small-caps (string->list arg) (list) #f (list))
2316         arg)))
2317
2318 (define-markup-command (caps layout props arg)
2319   (markup?)
2320   #:category font
2321   "Copy of the @code{\\smallCaps} command.
2322
2323 @lilypond[verbatim,quote]
2324 \\markup {
2325   default
2326   \\hspace #2
2327   \\caps {
2328     Text in small caps
2329   }
2330 }
2331 @end lilypond"
2332   (interpret-markup layout props (make-smallCaps-markup arg)))
2333
2334 (define-markup-command (dynamic layout props arg)
2335   (markup?)
2336   #:category font
2337   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
2338 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
2339 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
2340 done in a different font.  The recommended font for this is bold and italic.
2341 @lilypond[verbatim,quote]
2342 \\markup {
2343   \\dynamic {
2344     sfzp
2345   }
2346 }
2347 @end lilypond"
2348   (interpret-markup
2349    layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2350
2351 (define-markup-command (text layout props arg)
2352   (markup?)
2353   #:category font
2354   "Use a text font instead of music symbol or music alphabet font.
2355
2356 @lilypond[verbatim,quote]
2357 \\markup {
2358   \\number {
2359     1, 2,
2360     \\text {
2361       three, four,
2362     }
2363     5
2364   }
2365 }
2366 @end lilypond"
2367
2368   ;; ugh - latin1
2369   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
2370                     arg))
2371
2372 (define-markup-command (italic layout props arg)
2373   (markup?)
2374   #:category font
2375   "Use italic @code{font-shape} for @var{arg}.
2376
2377 @lilypond[verbatim,quote]
2378 \\markup {
2379   default
2380   \\hspace #2
2381   \\italic
2382   italic
2383 }
2384 @end lilypond"
2385   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
2386
2387 (define-markup-command (typewriter layout props arg)
2388   (markup?)
2389   #:category font
2390   "Use @code{font-family} typewriter for @var{arg}.
2391
2392 @lilypond[verbatim,quote]
2393 \\markup {
2394   default
2395   \\hspace #2
2396   \\typewriter
2397   typewriter
2398 }
2399 @end lilypond"
2400   (interpret-markup
2401    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
2402
2403 (define-markup-command (upright layout props arg)
2404   (markup?)
2405   #:category font
2406   "Set @code{font-shape} to @code{upright}.  This is the opposite
2407 of @code{italic}.
2408
2409 @lilypond[verbatim,quote]
2410 \\markup {
2411   \\italic {
2412     italic text
2413     \\hspace #2
2414     \\upright {
2415       upright text
2416     }
2417     \\hspace #2
2418     italic again
2419   }
2420 }
2421 @end lilypond"
2422   (interpret-markup
2423    layout (prepend-alist-chain 'font-shape 'upright props) arg))
2424
2425 (define-markup-command (medium layout props arg)
2426   (markup?)
2427   #:category font
2428   "Switch to medium font-series (in contrast to bold).
2429
2430 @lilypond[verbatim,quote]
2431 \\markup {
2432   \\bold {
2433     some bold text
2434     \\hspace #2
2435     \\medium {
2436       medium font series
2437     }
2438     \\hspace #2
2439     bold again
2440   }
2441 }
2442 @end lilypond"
2443   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
2444                     arg))
2445
2446 (define-markup-command (normal-text layout props arg)
2447   (markup?)
2448   #:category font
2449   "Set all font related properties (except the size) to get the default
2450 normal text font, no matter what font was used earlier.
2451
2452 @lilypond[verbatim,quote]
2453 \\markup {
2454   \\huge \\bold \\sans \\caps {
2455     Some text with font overrides
2456     \\hspace #2
2457     \\normal-text {
2458       Default text, same font-size
2459     }
2460     \\hspace #2
2461     More text as before
2462   }
2463 }
2464 @end lilypond"
2465   ;; ugh - latin1
2466   (interpret-markup layout
2467                     (cons '((font-family . roman) (font-shape . upright)
2468                             (font-series . medium) (font-encoding . latin1))
2469                           props)
2470                     arg))
2471
2472 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2473 ;; symbols.
2474 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2475
2476 (define-markup-command (musicglyph layout props glyph-name)
2477   (string?)
2478   #:category music
2479   "@var{glyph-name} is converted to a musical symbol; for example,
2480 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2481 the music font.  See @ruser{The Feta font} for a complete listing of
2482 the possible glyphs.
2483
2484 @lilypond[verbatim,quote]
2485 \\markup {
2486   \\musicglyph #\"f\"
2487   \\musicglyph #\"rests.2\"
2488   \\musicglyph #\"clefs.G_change\"
2489 }
2490 @end lilypond"
2491   (let* ((font (ly:paper-get-font layout
2492                                   (cons '((font-encoding . fetaMusic)
2493                                           (font-name . #f))
2494
2495                                                  props)))
2496          (glyph (ly:font-get-glyph font glyph-name)))
2497     (if (null? (ly:stencil-expr glyph))
2498         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2499
2500     glyph))
2501
2502 (define-markup-command (doublesharp layout props)
2503   ()
2504   #:category music
2505   "Draw a double sharp symbol.
2506
2507 @lilypond[verbatim,quote]
2508 \\markup {
2509   \\doublesharp
2510 }
2511 @end lilypond"
2512   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
2513
2514 (define-markup-command (sesquisharp layout props)
2515   ()
2516   #:category music
2517   "Draw a 3/2 sharp symbol.
2518
2519 @lilypond[verbatim,quote]
2520 \\markup {
2521   \\sesquisharp
2522 }
2523 @end lilypond"
2524   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
2525
2526 (define-markup-command (sharp layout props)
2527   ()
2528   #:category music
2529   "Draw a sharp symbol.
2530
2531 @lilypond[verbatim,quote]
2532 \\markup {
2533   \\sharp
2534 }
2535 @end lilypond"
2536   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
2537
2538 (define-markup-command (semisharp layout props)
2539   ()
2540   #:category music
2541   "Draw a semisharp symbol.
2542
2543 @lilypond[verbatim,quote]
2544 \\markup {
2545   \\semisharp
2546 }
2547 @end lilypond"
2548   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
2549
2550 (define-markup-command (natural layout props)
2551   ()
2552   #:category music
2553   "Draw a natural symbol.
2554
2555 @lilypond[verbatim,quote]
2556 \\markup {
2557   \\natural
2558 }
2559 @end lilypond"
2560   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
2561
2562 (define-markup-command (semiflat layout props)
2563   ()
2564   #:category music
2565   "Draw a semiflat symbol.
2566
2567 @lilypond[verbatim,quote]
2568 \\markup {
2569   \\semiflat
2570 }
2571 @end lilypond"
2572   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
2573
2574 (define-markup-command (flat layout props)
2575   ()
2576   #:category music
2577   "Draw a flat symbol.
2578
2579 @lilypond[verbatim,quote]
2580 \\markup {
2581   \\flat
2582 }
2583 @end lilypond"
2584   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
2585
2586 (define-markup-command (sesquiflat layout props)
2587   ()
2588   #:category music
2589   "Draw a 3/2 flat symbol.
2590
2591 @lilypond[verbatim,quote]
2592 \\markup {
2593   \\sesquiflat
2594 }
2595 @end lilypond"
2596   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
2597
2598 (define-markup-command (doubleflat layout props)
2599   ()
2600   #:category music
2601   "Draw a double flat symbol.
2602
2603 @lilypond[verbatim,quote]
2604 \\markup {
2605   \\doubleflat
2606 }
2607 @end lilypond"
2608   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
2609
2610 (define-markup-command (with-color layout props color arg)
2611   (color? markup?)
2612   #:category other
2613   "
2614 @cindex coloring text
2615
2616 Draw @var{arg} in color specified by @var{color}.
2617
2618 @lilypond[verbatim,quote]
2619 \\markup {
2620   \\with-color #red
2621   red
2622   \\hspace #2
2623   \\with-color #green
2624   green
2625   \\hspace #2
2626   \\with-color #blue
2627   blue
2628 }
2629 @end lilypond"
2630   (let ((stil (interpret-markup layout props arg)))
2631     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
2632                      (ly:stencil-extent stil X)
2633                      (ly:stencil-extent stil Y))))
2634
2635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2636 ;; glyphs
2637 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2638
2639 (define-markup-command (arrow-head layout props axis dir filled)
2640   (integer? ly:dir? boolean?)
2641   #:category graphic
2642   "Produce an arrow head in specified direction and axis.
2643 Use the filled head if @var{filled} is specified.
2644 @lilypond[verbatim,quote]
2645 \\markup {
2646   \\fontsize #5 {
2647     \\general-align #Y #DOWN {
2648       \\arrow-head #Y #UP ##t
2649       \\arrow-head #Y #DOWN ##f
2650       \\hspace #2
2651       \\arrow-head #X #RIGHT ##f
2652       \\arrow-head #X #LEFT ##f
2653     }
2654   }
2655 }
2656 @end lilypond"
2657   (let*
2658       ((name (format "arrowheads.~a.~a~a"
2659                      (if filled
2660                          "close"
2661                          "open")
2662                      axis
2663                      dir)))
2664     (ly:font-get-glyph
2665      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2666                                      props))
2667      name)))
2668
2669 (define-markup-command (lookup layout props glyph-name)
2670   (string?)
2671   #:category other
2672   "Lookup a glyph by name.
2673
2674 @lilypond[verbatim,quote]
2675 \\markup {
2676   \\override #'(font-encoding . fetaBraces) {
2677     \\lookup #\"brace200\"
2678     \\hspace #2
2679     \\rotate #180
2680     \\lookup #\"brace180\"
2681   }
2682 }
2683 @end lilypond"
2684   (ly:font-get-glyph (ly:paper-get-font layout props)
2685                      glyph-name))
2686
2687 (define-markup-command (char layout props num)
2688   (integer?)
2689   #:category other
2690   "Produce a single character.  Characters encoded in hexadecimal
2691 format require the prefix @code{#x}.
2692
2693 @lilypond[verbatim,quote]
2694 \\markup {
2695   \\char #65 \\char ##x00a9
2696 }
2697 @end lilypond"
2698   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
2699
2700 (define number->mark-letter-vector (make-vector 25 #\A))
2701
2702 (do ((i 0 (1+ i))
2703      (j 0 (1+ j)))
2704     ((>= i 26))
2705   (if (= i (- (char->integer #\I) (char->integer #\A)))
2706       (set! i (1+ i)))
2707   (vector-set! number->mark-letter-vector j
2708                (integer->char (+ i (char->integer #\A)))))
2709
2710 (define number->mark-alphabet-vector (list->vector
2711   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
2712
2713 (define (number->markletter-string vec n)
2714   "Double letters for big marks."
2715   (let* ((lst (vector-length vec)))
2716
2717     (if (>= n lst)
2718         (string-append (number->markletter-string vec (1- (quotient n lst)))
2719                        (number->markletter-string vec (remainder n lst)))
2720         (make-string 1 (vector-ref vec n)))))
2721
2722 (define-markup-command (markletter layout props num)
2723   (integer?)
2724   #:category other
2725   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2726 (skipping letter@tie{}I), and continue with double letters.
2727
2728 @lilypond[verbatim,quote]
2729 \\markup {
2730   \\markletter #8
2731   \\hspace #2
2732   \\markletter #26
2733 }
2734 @end lilypond"
2735   (ly:text-interface::interpret-markup layout props
2736     (number->markletter-string number->mark-letter-vector num)))
2737
2738 (define-markup-command (markalphabet layout props num)
2739   (integer?)
2740   #:category other
2741    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2742 and continue with double letters.
2743
2744 @lilypond[verbatim,quote]
2745 \\markup {
2746   \\markalphabet #8
2747   \\hspace #2
2748   \\markalphabet #26
2749 }
2750 @end lilypond"
2751    (ly:text-interface::interpret-markup layout props
2752      (number->markletter-string number->mark-alphabet-vector num)))
2753
2754 (define-public (horizontal-slash-interval num forward number-interval mag)
2755   (if forward
2756     (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
2757           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2758           (else (interval-widen number-interval (* mag 0.25))))
2759     (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
2760           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2761           (else (interval-widen number-interval (* mag 0.25))))
2762   ))
2763
2764 (define-public (adjust-slash-stencil num forward stencil mag)
2765   (if forward
2766     (cond ((= num 2)
2767               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2768           ((= num 3)
2769               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2770           ;((= num 5)
2771               ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
2772           ;((= num 7)
2773           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2774           (else stencil))
2775     (cond ((= num 6)
2776               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
2777           ;((= num 8)
2778           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2779           (else stencil))
2780   )
2781 )
2782
2783 (define (slashed-digit-internal layout props num forward font-size thickness)
2784   (let* ((mag (magstep font-size))
2785          (thickness (* mag
2786                        (ly:output-def-lookup layout 'line-thickness)
2787                        thickness))
2788          ; backward slashes might use slope and point in the other direction!
2789          (dy (* mag (if forward 0.4 -0.4)))
2790          (number-stencil (interpret-markup layout
2791                                            (prepend-alist-chain 'font-encoding 'fetaText props)
2792                                            (number->string num)))
2793          (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
2794          (center (interval-center (ly:stencil-extent number-stencil Y)))
2795          ; Use the real extents of the slash, not the whole number, because we
2796          ; might translate the slash later on!
2797          (num-y (interval-widen (cons center center) (abs dy)))
2798          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
2799          (slash-stencil (if is-sane
2800                             (make-line-stencil thickness
2801                                          (car num-x) (- (interval-center num-y) dy)
2802                                          (cdr num-x) (+ (interval-center num-y) dy))
2803                             #f)))
2804     (if (ly:stencil? slash-stencil)
2805       (begin
2806         ; for some numbers we need to shift the slash/backslash up or down to make
2807         ; the slashed digit look better
2808         (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
2809         (set! number-stencil
2810           (ly:stencil-add number-stencil slash-stencil)))
2811       (ly:warning "Unable to create slashed digit ~a" num))
2812     number-stencil))
2813
2814
2815 (define-markup-command (slashed-digit layout props num)
2816   (integer?)
2817   #:category other
2818   #:properties ((font-size 0)
2819                 (thickness 1.6))
2820   "
2821 @cindex slashed digits
2822
2823 A feta number, with slash.  This is for use in the context of
2824 figured bass notation.
2825 @lilypond[verbatim,quote]
2826 \\markup {
2827   \\slashed-digit #5
2828   \\hspace #2
2829   \\override #'(thickness . 3)
2830   \\slashed-digit #7
2831 }
2832 @end lilypond"
2833   (slashed-digit-internal layout props num #t font-size thickness))
2834
2835 (define-markup-command (backslashed-digit layout props num)
2836   (integer?)
2837   #:category other
2838   #:properties ((font-size 0)
2839                 (thickness 1.6))
2840   "
2841 @cindex backslashed digits
2842
2843 A feta number, with backslash.  This is for use in the context of
2844 figured bass notation.
2845 @lilypond[verbatim,quote]
2846 \\markup {
2847   \\backslashed-digit #5
2848   \\hspace #2
2849   \\override #'(thickness . 3)
2850   \\backslashed-digit #7
2851 }
2852 @end lilypond"
2853   (slashed-digit-internal layout props num #f font-size thickness))
2854
2855 ;; eyeglasses
2856 (define eyeglassespath
2857   '((moveto 0.42 0.77)
2858     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
2859     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
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     (closepath)
2863     (moveto 2.07 0.77)
2864     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
2865     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
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     (closepath)
2869     (moveto 1.025 0.935)
2870     (rcurveto 0 0.182 -0.148 0.33 -0.33 0.33)
2871     (rcurveto -0.182 0 -0.33 -0.148 -0.33 -0.33)
2872     (moveto -0.68 0.77)
2873     (rlineto 0.66 1.43)
2874     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)
2875     (moveto 2.07 0.77)
2876     (rlineto 0.66 1.43)
2877     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)))
2878
2879 (define-markup-command (eyeglasses layout props)
2880   ()
2881   #:category other
2882   "Prints out eyeglasses, indicating strongly to look at the conductor.
2883 @lilypond[verbatim,quote]
2884 \\markup { \\eyeglasses }
2885 @end lilypond"
2886   (interpret-markup layout props
2887     (make-override-markup '(line-cap-style . butt)
2888       (make-path-markup 0.15 eyeglassespath))))
2889
2890 (define-markup-command (left-brace layout props size)
2891   (number?)
2892   #:category other
2893   "
2894 A feta brace in point size @var{size}.
2895
2896 @lilypond[verbatim,quote]
2897 \\markup {
2898   \\left-brace #35
2899   \\hspace #2
2900   \\left-brace #45
2901 }
2902 @end lilypond"
2903   (let* ((font (ly:paper-get-font layout
2904                                   (cons '((font-encoding . fetaBraces)
2905                                           (font-name . #f))
2906                                         props)))
2907          (glyph-count (1- (ly:otf-glyph-count font)))
2908          (scale (ly:output-def-lookup layout 'output-scale))
2909          (scaled-size (/ (ly:pt size) scale))
2910          (glyph (lambda (n)
2911                   (ly:font-get-glyph font (string-append "brace"
2912                                                          (number->string n)))))
2913          (get-y-from-brace (lambda (brace)
2914                              (interval-length
2915                               (ly:stencil-extent (glyph brace) Y))))
2916          (find-brace (binary-search 0 glyph-count get-y-from-brace scaled-size))
2917          (glyph-found (glyph find-brace)))
2918
2919     (if (or (null? (ly:stencil-expr glyph-found))
2920             (< scaled-size (interval-length (ly:stencil-extent (glyph 0) Y)))
2921             (> scaled-size (interval-length
2922                             (ly:stencil-extent (glyph glyph-count) Y))))
2923         (begin
2924           (ly:warning (_ "no brace found for point size ~S ") size)
2925           (ly:warning (_ "defaulting to ~S pt")
2926                       (/ (* scale (interval-length
2927                                    (ly:stencil-extent glyph-found Y)))
2928                          (ly:pt 1)))))
2929     glyph-found))
2930
2931 (define-markup-command (right-brace layout props size)
2932   (number?)
2933   #:category other
2934   "
2935 A feta brace in point size @var{size}, rotated 180 degrees.
2936
2937 @lilypond[verbatim,quote]
2938 \\markup {
2939   \\right-brace #45
2940   \\hspace #2
2941   \\right-brace #35
2942 }
2943 @end lilypond"
2944   (interpret-markup layout props (markup #:rotate 180 #:left-brace size)))
2945
2946 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2947 ;; the note command.
2948 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2949
2950 ;; TODO: better syntax.
2951
2952 (define-markup-command (note-by-number layout props log dot-count dir)
2953   (number? number? number?)
2954   #:category music
2955   #:properties ((font-size 0)
2956                 (style '()))
2957   "
2958 @cindex notes within text by log and dot-count
2959
2960 Construct a note symbol, with stem.  By using fractional values for
2961 @var{dir}, longer or shorter stems can be obtained.
2962
2963 @lilypond[verbatim,quote]
2964 \\markup {
2965   \\note-by-number #3 #0 #DOWN
2966   \\hspace #2
2967   \\note-by-number #1 #2 #0.8
2968 }
2969 @end lilypond"
2970   (define (get-glyph-name-candidates dir log style)
2971     (map (lambda (dir-name)
2972            (format "noteheads.~a~a" dir-name
2973                    (if (and (symbol? style)
2974                             (not (equal? 'default style)))
2975                        (select-head-glyph style (min log 2))
2976                        (min log 2))))
2977          (list (if (= dir UP) "u" "d")
2978                "s")))
2979
2980   (define (get-glyph-name font cands)
2981     (if (null? cands)
2982         ""
2983         (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
2984             (get-glyph-name font (cdr cands))
2985             (car cands))))
2986
2987   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2988                                                props)))
2989          (size-factor (magstep font-size))
2990          (stem-length (* size-factor (max 3 (- log 1))))
2991          (head-glyph-name
2992           (let ((result (get-glyph-name font (get-glyph-name-candidates
2993                                               (sign dir) log style))))
2994             (if (string-null? result)
2995                 ;; If no glyph name can be found, select default heads.  Though
2996                 ;; this usually means an unsupported style has been chosen, it
2997                 ;; also prevents unrelated 'style settings from other grobs
2998                 ;; (e.g., TextSpanner and TimeSignature) leaking into markup.
2999                 (get-glyph-name font (get-glyph-name-candidates
3000                                       (sign dir) log 'default))
3001                 result)))
3002          (head-glyph (ly:font-get-glyph font head-glyph-name))
3003          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
3004          (stem-thickness (* size-factor 0.13))
3005          (stemy (* dir stem-length))
3006          (attach-off (cons (interval-index
3007                             (ly:stencil-extent head-glyph X)
3008                             (* (sign dir) (car attach-indices)))
3009                            (* (sign dir) ; fixme, this is inconsistent between X & Y.
3010                               (interval-index
3011                                (ly:stencil-extent head-glyph Y)
3012                                (cdr attach-indices)))))
3013          (stem-glyph (and (> log 0)
3014                           (ly:round-filled-box
3015                            (ordered-cons (car attach-off)
3016                                          (+ (car attach-off)
3017                                             (* (- (sign dir)) stem-thickness)))
3018                            (cons (min stemy (cdr attach-off))
3019                                  (max stemy (cdr attach-off)))
3020                            (/ stem-thickness 3))))
3021
3022          (dot (ly:font-get-glyph font "dots.dot"))
3023          (dotwid (interval-length (ly:stencil-extent dot X)))
3024          (dots (and (> dot-count 0)
3025                     (apply ly:stencil-add
3026                            (map (lambda (x)
3027                                   (ly:stencil-translate-axis
3028                                    dot (* 2 x dotwid) X))
3029                                 (iota dot-count)))))
3030          (flaggl (and (> log 2)
3031                       (ly:stencil-translate
3032                        (ly:font-get-glyph font
3033                                           (string-append "flags."
3034                                                          (if (> dir 0) "u" "d")
3035                                                          (number->string log)))
3036                        (cons (+ (car attach-off) (if (< dir 0)
3037                                                      stem-thickness 0))
3038                              stemy)))))
3039
3040     ;; If there is a flag on an upstem and the stem is short, move the dots
3041     ;; to avoid the flag.  16th notes get a special case because their flags
3042     ;; hang lower than any other flags.
3043     (if (and dots (> dir 0) (> log 2)
3044              (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
3045         (set! dots (ly:stencil-translate-axis dots 0.5 X)))
3046     (if flaggl
3047         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
3048     (if (ly:stencil? stem-glyph)
3049         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
3050         (set! stem-glyph head-glyph))
3051     (if (ly:stencil? dots)
3052         (set! stem-glyph
3053               (ly:stencil-add
3054                (ly:stencil-translate-axis
3055                 dots
3056                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
3057                 X)
3058                stem-glyph)))
3059     stem-glyph))
3060
3061 (define-public log2
3062   (let ((divisor (log 2)))
3063     (lambda (z) (inexact->exact (/ (log z) divisor)))))
3064
3065 (define (parse-simple-duration duration-string)
3066   "Parse the `duration-string', e.g. ''4..'' or ''breve.'',
3067 and return a (log dots) list."
3068   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)")
3069                             duration-string)))
3070     (if (and match (string=? duration-string (match:substring match 0)))
3071         (let ((len (match:substring match 1))
3072               (dots (match:substring match 2)))
3073           (list (cond ((string=? len "breve") -1)
3074                       ((string=? len "longa") -2)
3075                       ((string=? len "maxima") -3)
3076                       (else (log2 (string->number len))))
3077                 (if dots (string-length dots) 0)))
3078         (ly:error (_ "not a valid duration string: ~a") duration-string))))
3079
3080 (define-markup-command (note layout props duration dir)
3081   (string? number?)
3082   #:category music
3083   #:properties (note-by-number-markup)
3084   "
3085 @cindex notes within text by string
3086
3087 This produces a note with a stem pointing in @var{dir} direction, with
3088 the @var{duration} for the note head type and augmentation dots.  For
3089 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
3090 a shortened down stem.
3091
3092 @lilypond[verbatim,quote]
3093 \\markup {
3094   \\override #'(style . cross) {
3095     \\note #\"4..\" #UP
3096   }
3097   \\hspace #2
3098   \\note #\"breve\" #0
3099 }
3100 @end lilypond"
3101   (let ((parsed (parse-simple-duration duration)))
3102     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
3103
3104 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3105 ;; translating.
3106 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3107
3108 (define-markup-command (lower layout props amount arg)
3109   (number? markup?)
3110   #:category align
3111   "
3112 @cindex lowering text
3113
3114 Lower @var{arg} by the distance @var{amount}.
3115 A negative @var{amount} indicates raising; see also @code{\\raise}.
3116
3117 @lilypond[verbatim,quote]
3118 \\markup {
3119   one
3120   \\lower #3
3121   two
3122   three
3123 }
3124 @end lilypond"
3125   (ly:stencil-translate-axis (interpret-markup layout props arg)
3126                              (- amount) Y))
3127
3128 (define-markup-command (translate-scaled layout props offset arg)
3129   (number-pair? markup?)
3130   #:category align
3131   #:properties ((font-size 0))
3132   "
3133 @cindex translating text
3134 @cindex scaling text
3135
3136 Translate @var{arg} by @var{offset}, scaling the offset by the
3137 @code{font-size}.
3138
3139 @lilypond[verbatim,quote]
3140 \\markup {
3141   \\fontsize #5 {
3142     * \\translate #'(2 . 3) translate
3143     \\hspace #2
3144     * \\translate-scaled #'(2 . 3) translate-scaled
3145   }
3146 }
3147 @end lilypond"
3148   (let* ((factor (magstep font-size))
3149          (scaled (cons (* factor (car offset))
3150                        (* factor (cdr offset)))))
3151     (ly:stencil-translate (interpret-markup layout props arg)
3152                           scaled)))
3153
3154 (define-markup-command (raise layout props amount arg)
3155   (number? markup?)
3156   #:category align
3157   "
3158 @cindex raising text
3159
3160 Raise @var{arg} by the distance @var{amount}.
3161 A negative @var{amount} indicates lowering, see also @code{\\lower}.
3162
3163 The argument to @code{\\raise} is the vertical displacement amount,
3164 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
3165 raise objects in relation to their surrounding markups.
3166
3167 If the text object itself is positioned above or below the staff, then
3168 @code{\\raise} cannot be used to move it, since the mechanism that
3169 positions it next to the staff cancels any shift made with
3170 @code{\\raise}.  For vertical positioning, use the @code{padding}
3171 and/or @code{extra-offset} properties.
3172
3173 @lilypond[verbatim,quote]
3174 \\markup {
3175   C
3176   \\small
3177   \\bold
3178   \\raise #1.0
3179   9/7+
3180 }
3181 @end lilypond"
3182   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
3183
3184 (define-markup-command (fraction layout props arg1 arg2)
3185   (markup? markup?)
3186   #:category other
3187   #:properties ((font-size 0))
3188   "
3189 @cindex creating text fractions
3190
3191 Make a fraction of two markups.
3192 @lilypond[verbatim,quote]
3193 \\markup {
3194   π ≈
3195   \\fraction 355 113
3196 }
3197 @end lilypond"
3198   (let* ((m1 (interpret-markup layout props arg1))
3199          (m2 (interpret-markup layout props arg2))
3200          (factor (magstep font-size))
3201          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
3202          (padding (* factor 0.2))
3203          (baseline (* factor 0.6))
3204          (offset (* factor 0.75)))
3205     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
3206     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
3207     (let* ((x1 (ly:stencil-extent m1 X))
3208            (x2 (ly:stencil-extent m2 X))
3209            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
3210            ;; should stack mols separately, to maintain LINE on baseline
3211            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
3212       (set! stack
3213             (ly:stencil-aligned-to stack Y CENTER))
3214       (set! stack
3215             (ly:stencil-aligned-to stack X LEFT))
3216       ;; should have EX dimension
3217       ;; empirical anyway
3218       (ly:stencil-translate-axis stack offset Y))))
3219
3220 (define-markup-command (normal-size-super layout props arg)
3221   (markup?)
3222   #:category font
3223   #:properties ((baseline-skip))
3224   "
3225 @cindex setting superscript in standard font size
3226
3227 Set @var{arg} in superscript with a normal font size.
3228
3229 @lilypond[verbatim,quote]
3230 \\markup {
3231   default
3232   \\normal-size-super {
3233     superscript in standard size
3234   }
3235 }
3236 @end lilypond"
3237   (ly:stencil-translate-axis
3238    (interpret-markup layout props arg)
3239    (* 0.5 baseline-skip) Y))
3240
3241 (define-markup-command (super layout props arg)
3242   (markup?)
3243   #:category font
3244   #:properties ((font-size 0)
3245                 (baseline-skip))
3246   "
3247 @cindex superscript text
3248
3249 Set @var{arg} in superscript.
3250
3251 @lilypond[verbatim,quote]
3252 \\markup {
3253   E =
3254   \\concat {
3255     mc
3256     \\super
3257     2
3258   }
3259 }
3260 @end lilypond"
3261   (ly:stencil-translate-axis
3262    (interpret-markup
3263     layout
3264     (cons `((font-size . ,(- font-size 3))) props)
3265     arg)
3266    (* 0.5 baseline-skip)
3267    Y))
3268
3269 (define-markup-command (translate layout props offset arg)
3270   (number-pair? markup?)
3271   #:category align
3272   "
3273 @cindex translating text
3274
3275 Translate @var{arg} relative to its surroundings.  @var{offset}
3276 is a pair of numbers representing the displacement in the X and Y axis.
3277
3278 @lilypond[verbatim,quote]
3279 \\markup {
3280   *
3281   \\translate #'(2 . 3)
3282   \\line { translated two spaces right, three up }
3283 }
3284 @end lilypond"
3285   (ly:stencil-translate (interpret-markup layout props arg)
3286                         offset))
3287
3288 (define-markup-command (sub layout props arg)
3289   (markup?)
3290   #:category font
3291   #:properties ((font-size 0)
3292                 (baseline-skip))
3293   "
3294 @cindex subscript text
3295
3296 Set @var{arg} in subscript.
3297
3298 @lilypond[verbatim,quote]
3299 \\markup {
3300   \\concat {
3301     H
3302     \\sub {
3303       2
3304     }
3305     O
3306   }
3307 }
3308 @end lilypond"
3309   (ly:stencil-translate-axis
3310    (interpret-markup
3311     layout
3312     (cons `((font-size . ,(- font-size 3))) props)
3313     arg)
3314    (* -0.5 baseline-skip)
3315    Y))
3316
3317 (define-markup-command (normal-size-sub layout props arg)
3318   (markup?)
3319   #:category font
3320   #:properties ((baseline-skip))
3321   "
3322 @cindex setting subscript in standard font size
3323
3324 Set @var{arg} in subscript with a normal font size.
3325
3326 @lilypond[verbatim,quote]
3327 \\markup {
3328   default
3329   \\normal-size-sub {
3330     subscript in standard size
3331   }
3332 }
3333 @end lilypond"
3334   (ly:stencil-translate-axis
3335    (interpret-markup layout props arg)
3336    (* -0.5 baseline-skip)
3337    Y))
3338
3339 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3340 ;; brackets.
3341 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3342
3343 (define-markup-command (hbracket layout props arg)
3344   (markup?)
3345   #:category graphic
3346   "
3347 @cindex placing horizontal brackets around text
3348
3349 Draw horizontal brackets around @var{arg}.
3350
3351 @lilypond[verbatim,quote]
3352 \\markup {
3353   \\hbracket {
3354     \\line {
3355       one two three
3356     }
3357   }
3358 }
3359 @end lilypond"
3360   (let ((th 0.1) ;; todo: take from GROB.
3361         (m (interpret-markup layout props arg)))
3362     (bracketify-stencil m X th (* 2.5 th) th)))
3363
3364 (define-markup-command (bracket layout props arg)
3365   (markup?)
3366   #:category graphic
3367   "
3368 @cindex placing vertical brackets around text
3369
3370 Draw vertical brackets around @var{arg}.
3371
3372 @lilypond[verbatim,quote]
3373 \\markup {
3374   \\bracket {
3375     \\note #\"2.\" #UP
3376   }
3377 }
3378 @end lilypond"
3379   (let ((th 0.1) ;; todo: take from GROB.
3380         (m (interpret-markup layout props arg)))
3381     (bracketify-stencil m Y th (* 2.5 th) th)))
3382
3383 (define-markup-command (parenthesize layout props arg)
3384   (markup?)
3385   #:category graphic
3386   #:properties ((angularity 0)
3387                 (padding)
3388                 (size 1)
3389                 (thickness 1)
3390                 (width 0.25))
3391   "
3392 @cindex placing parentheses around text
3393
3394 Draw parentheses around @var{arg}.  This is useful for parenthesizing
3395 a column containing several lines of text.
3396
3397 @lilypond[verbatim,quote]
3398 \\markup {
3399   \\line {
3400     \\parenthesize {
3401       \\column {
3402         foo
3403         bar
3404       }
3405     }
3406     \\override #'(angularity . 2) {
3407       \\parenthesize {
3408         \\column {
3409           bah
3410           baz
3411         }
3412       }
3413     }
3414   }
3415 }
3416 @end lilypond"
3417   (let* ((markup (interpret-markup layout props arg))
3418          (scaled-width (* size width))
3419          (scaled-thickness
3420           (* (chain-assoc-get 'line-thickness props 0.1)
3421              thickness))
3422          (half-thickness
3423           (min (* size 0.5 scaled-thickness)
3424                (* (/ 4 3.0) scaled-width)))
3425          (padding (chain-assoc-get 'padding props half-thickness)))
3426     (parenthesize-stencil
3427      markup half-thickness scaled-width angularity padding)))
3428
3429 \f
3430 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3431 ;; Delayed markup evaluation
3432 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3433
3434 (define-markup-command (page-ref layout props label gauge default)
3435   (symbol? markup? markup?)
3436   #:category other
3437   "
3438 @cindex referencing page numbers in text
3439
3440 Reference to a page number. @var{label} is the label set on the referenced
3441 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
3442 the maximum width of the page number, and @var{default} the value to display
3443 when @var{label} is not found."
3444   (let* ((gauge-stencil (interpret-markup layout props gauge))
3445          (x-ext (ly:stencil-extent gauge-stencil X))
3446          (y-ext (ly:stencil-extent gauge-stencil Y)))
3447     (ly:make-stencil
3448      `(delay-stencil-evaluation
3449        ,(delay (ly:stencil-expr
3450                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
3451                        (page-number (if (list? table)
3452                                         (assoc-get label table)
3453                                         #f))
3454                        (page-markup (if page-number (format "~a" page-number) default))
3455                        (page-stencil (interpret-markup layout props page-markup))
3456                        (gap (- (interval-length x-ext)
3457                                (interval-length (ly:stencil-extent page-stencil X)))))
3458                   (interpret-markup layout props
3459                                     (markup #:concat (#:hspace gap page-markup)))))))
3460      x-ext
3461      y-ext)))
3462
3463 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3464 ;; scaling
3465 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3466
3467 (define-markup-command (scale layout props factor-pair arg)
3468   (number-pair? markup?)
3469   #:category graphic
3470   "
3471 @cindex scaling markup
3472 @cindex mirroring markup
3473
3474 Scale @var{arg}.  @var{factor-pair} is a pair of numbers
3475 representing the scaling-factor in the X and Y axes.
3476 Negative values may be used to produce mirror images.
3477
3478 @lilypond[verbatim,quote]
3479 \\markup {
3480   \\line {
3481     \\scale #'(2 . 1)
3482     stretched
3483     \\scale #'(1 . -1)
3484     mirrored
3485   }
3486 }
3487 @end lilypond"
3488   (let ((stil (interpret-markup layout props arg))
3489         (sx (car factor-pair))
3490         (sy (cdr factor-pair)))
3491     (ly:stencil-scale stil sx sy)))
3492
3493 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3494 ;; Repeating
3495 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3496
3497 (define-markup-command (pattern layout props count axis space pattern)
3498   (integer? integer? number? markup?)
3499   #:category other
3500   "
3501 Prints @var{count} times a @var{pattern} markup.
3502 Patterns are spaced apart by @var{space}.
3503 Patterns are distributed on @var{axis}.
3504
3505 @lilypond[verbatim, quote]
3506 \\markup \\column {
3507   \"Horizontally repeated :\"
3508   \\pattern #7 #X #2 \\flat
3509   \\null
3510   \"Vertically repeated :\"
3511   \\pattern #3 #Y #0.5 \\flat
3512 }
3513 @end lilypond"
3514   (let ((pattern-width (interval-length
3515                          (ly:stencil-extent (interpret-markup layout props pattern) X)))
3516         (new-props (prepend-alist-chain 'word-space 0 (prepend-alist-chain 'baseline-skip 0 props))))
3517     (let loop ((i (1- count)) (patterns (markup)))
3518       (if (zero? i)
3519           (interpret-markup
3520             layout
3521             new-props
3522             (if (= axis X)
3523                 (markup patterns pattern)
3524                 (markup #:column (patterns pattern))))
3525           (loop (1- i)
3526             (if (= axis X)
3527                 (markup patterns pattern #:hspace space)
3528                 (markup #:column (patterns pattern #:vspace space))))))))
3529
3530 (define-markup-command (fill-with-pattern layout props space dir pattern left right)
3531   (number? ly:dir? markup? markup? markup?)
3532   #:category align
3533   #:properties ((word-space)
3534                 (line-width))
3535   "
3536 Put @var{left} and @var{right} in a horizontal line of width @code{line-width}
3537 with a line of markups @var{pattern} in between.
3538 Patterns are spaced apart by @var{space}.
3539 Patterns are aligned to the @var{dir} markup.
3540
3541 @lilypond[verbatim, quote]
3542 \\markup \\column {
3543   \"right-aligned :\"
3544   \\fill-with-pattern #1 #RIGHT . first right
3545   \\fill-with-pattern #1 #RIGHT . second right
3546   \\null
3547   \"center-aligned :\"
3548   \\fill-with-pattern #1.5 #CENTER - left right
3549   \\null
3550   \"left-aligned :\"
3551   \\override #'(line-width . 50) \\fill-with-pattern #2 #LEFT : left first
3552   \\override #'(line-width . 50) \\fill-with-pattern #2 #LEFT : left second
3553 }
3554 @end lilypond"
3555   (let* ((pattern-x-extent (ly:stencil-extent (interpret-markup layout props pattern) X))
3556          (pattern-width (interval-length pattern-x-extent))
3557          (left-width (interval-length (ly:stencil-extent (interpret-markup layout props left) X)))
3558          (right-width (interval-length (ly:stencil-extent (interpret-markup layout props right) X)))
3559          (middle-width (- line-width (+ (+ left-width right-width) (* word-space 2))))
3560          (period (+ space pattern-width))
3561          (count (truncate (/ (- middle-width pattern-width) period)))
3562          (x-offset (+ (* (- (- middle-width (* count period)) pattern-width) (/ (1+ dir) 2)) (abs (car pattern-x-extent)))))
3563     (interpret-markup layout props
3564                       (markup left
3565                               #:with-dimensions (cons 0 middle-width) '(0 . 0)
3566                               #:translate (cons x-offset 0)
3567                               #:pattern (1+ count) X space pattern
3568                               right))))
3569
3570 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3571 ;; Markup list commands
3572 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3573
3574 (define-public (space-lines baseline stils)
3575   (let space-stil ((stils stils)
3576                    (result (list)))
3577     (if (null? stils)
3578         (reverse! result)
3579         (let* ((stil (car stils))
3580                (dy-top (max (- (/ baseline 1.5)
3581                                (interval-bound (ly:stencil-extent stil Y) UP))
3582                             0.0))
3583                (dy-bottom (max (+ (/ baseline 3.0)
3584                                   (interval-bound (ly:stencil-extent stil Y) DOWN))
3585                                0.0))
3586                (new-stil (ly:make-stencil
3587                           (ly:stencil-expr stil)
3588                           (ly:stencil-extent stil X)
3589                           (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN)
3590                                    dy-bottom)
3591                                 (+ (interval-bound (ly:stencil-extent stil Y) UP)
3592                                    dy-top)))))
3593           (space-stil (cdr stils) (cons new-stil result))))))
3594
3595 (define-markup-list-command (justified-lines layout props args)
3596   (markup-list?)
3597   #:properties ((baseline-skip)
3598                 wordwrap-internal-markup-list)
3599   "
3600 @cindex justifying lines of text
3601
3602 Like @code{\\justify}, but return a list of lines instead of a single markup.
3603 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
3604 @var{X}@tie{}is the number of staff spaces."
3605   (space-lines baseline-skip
3606                (interpret-markup-list layout props
3607                                       (make-wordwrap-internal-markup-list #t args))))
3608
3609 (define-markup-list-command (wordwrap-lines layout props args)
3610   (markup-list?)
3611   #:properties ((baseline-skip)
3612                 wordwrap-internal-markup-list)
3613   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
3614 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
3615 where @var{X} is the number of staff spaces."
3616   (space-lines baseline-skip
3617                (interpret-markup-list layout props
3618                                       (make-wordwrap-internal-markup-list #f args))))
3619
3620 (define-markup-list-command (column-lines layout props args)
3621   (markup-list?)
3622   #:properties ((baseline-skip))
3623   "Like @code{\\column}, but return a list of lines instead of a single markup.
3624 @code{baseline-skip} determines the space between each markup in @var{args}."
3625   (space-lines baseline-skip
3626                (interpret-markup-list layout props args)))
3627
3628 (define-markup-list-command (override-lines layout props new-prop args)
3629   (pair? markup-list?)
3630   "Like @code{\\override}, for markup lists."
3631   (interpret-markup-list layout (cons (list new-prop) props) args))