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