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