scm/define-markup-commands.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2000--2012  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/\" {
 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          (footnote-hash (gensym "footnote"))
1971          (stencil-seed 0)
1972          (gauge-stencil (interpret-markup
1973                            layout
1974                            props
1975                            ((ly:output-def-lookup
1976                                layout
1977                                'footnote-numbering-function)
1978                               stencil-seed)))
1979          (x-ext (ly:stencil-extent gauge-stencil X))
1980          (y-ext (ly:stencil-extent gauge-stencil Y))
1981          (footnote-number
1982            `(delay-stencil-evaluation
1983               ,(delay
1984                 (ly:stencil-expr
1985                   (let* ((table
1986                           (ly:output-def-lookup layout
1987                                                 'number-footnote-table))
1988                          (footnote-stencil (if (list? table)
1989                                                (assoc-get footnote-hash
1990                                                           table)
1991                                                empty-stencil))
1992                          (footnote-stencil (if (ly:stencil? footnote-stencil)
1993                                                footnote-stencil
1994                                                (begin
1995                                                  (ly:programming-error
1996 "Cannot find correct footnote for a markup object.")
1997                                                  empty-stencil)))
1998                          (gap (- (interval-length x-ext)
1999                                  (interval-length
2000                                    (ly:stencil-extent footnote-stencil X))))
2001                          (y-trans (- (+ (cdr y-ext)
2002                                         raise)
2003                                      (cdr (ly:stencil-extent footnote-stencil
2004                                                              Y)))))
2005                     (ly:stencil-translate footnote-stencil
2006                                           (cons gap y-trans)))))))
2007          (main-stencil (ly:stencil-combine-at-edge
2008                          markup-stencil
2009                          X
2010                          RIGHT
2011                          (ly:make-stencil footnote-number x-ext y-ext)
2012                          padding)))
2013   (ly:stencil-add
2014     main-stencil
2015     (ly:make-stencil
2016       `(footnote ,footnote-hash #t ,(interpret-markup layout props note))
2017       '(0 . 0)
2018       '(0 . 0)))))
2019
2020 (define-markup-command (override layout props new-prop arg)
2021   (pair? markup?)
2022   #:category other
2023   "
2024 @cindex overriding properties within text markup
2025
2026 Add the argument @var{new-prop} to the property list.  Properties
2027 may be any property supported by @rinternals{font-interface},
2028 @rinternals{text-interface} and
2029 @rinternals{instrument-specific-markup-interface}.
2030
2031 @lilypond[verbatim,quote]
2032 \\markup {
2033   \\line {
2034     \\column {
2035       default
2036       baseline-skip
2037     }
2038     \\hspace #2
2039     \\override #'(baseline-skip . 4) {
2040       \\column {
2041         increased
2042         baseline-skip
2043       }
2044     }
2045   }
2046 }
2047 @end lilypond"
2048   (interpret-markup layout (cons (list new-prop) props) arg))
2049
2050 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2051 ;; files
2052 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2053
2054 (define-markup-command (verbatim-file layout props name)
2055   (string?)
2056   #:category other
2057   "Read the contents of file @var{name}, and include it verbatim.
2058
2059 @lilypond[verbatim,quote]
2060 \\markup {
2061   \\verbatim-file #\"simple.ly\"
2062 }
2063 @end lilypond"
2064   (interpret-markup layout props
2065                     (if  (ly:get-option 'safe)
2066                          "verbatim-file disabled in safe mode"
2067                          (let* ((str (ly:gulp-file name))
2068                                 (lines (string-split str #\nl)))
2069                            (make-typewriter-markup
2070                             (make-column-markup lines))))))
2071
2072 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2073 ;; fonts.
2074 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2075
2076
2077 (define-markup-command (smaller layout props arg)
2078   (markup?)
2079   #:category font
2080   "Decrease the font size relative to the current setting.
2081
2082 @lilypond[verbatim,quote]
2083 \\markup {
2084   \\fontsize #3.5 {
2085     some large text
2086     \\hspace #2
2087     \\smaller {
2088       a bit smaller
2089     }
2090     \\hspace #2
2091     more large text
2092   }
2093 }
2094 @end lilypond"
2095   (interpret-markup layout props
2096    `(,fontsize-markup -1 ,arg)))
2097
2098 (define-markup-command (larger layout props arg)
2099   (markup?)
2100   #:category font
2101   "Increase the font size relative to the current setting.
2102
2103 @lilypond[verbatim,quote]
2104 \\markup {
2105   default
2106   \\hspace #2
2107   \\larger
2108   larger
2109 }
2110 @end lilypond"
2111   (interpret-markup layout props
2112    `(,fontsize-markup 1 ,arg)))
2113
2114 (define-markup-command (finger layout props arg)
2115   (markup?)
2116   #:category font
2117   "Set @var{arg} as small numbers.
2118
2119 @lilypond[verbatim,quote]
2120 \\markup {
2121   \\finger {
2122     1 2 3 4 5
2123   }
2124 }
2125 @end lilypond"
2126   (interpret-markup layout
2127                     (cons '((font-size . -5) (font-encoding . fetaText)) props)
2128                     arg))
2129
2130 (define-markup-command (abs-fontsize layout props size arg)
2131   (number? markup?)
2132   #:category font
2133   "Use @var{size} as the absolute font size to display @var{arg}.
2134 Adjusts @code{baseline-skip} and @code{word-space} accordingly.
2135
2136 @lilypond[verbatim,quote]
2137 \\markup {
2138   default text font size
2139   \\hspace #2
2140   \\abs-fontsize #16 { text font size 16 }
2141   \\hspace #2
2142   \\abs-fontsize #12 { text font size 12 }
2143 }
2144 @end lilypond"
2145   (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
2146          (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
2147          (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
2148          (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
2149          (magnification (/ size ref-size)))
2150      (interpret-markup
2151       layout
2152       (cons
2153        `((baseline-skip . ,(* magnification ref-baseline))
2154          (word-space . ,(* magnification ref-word-space))
2155          (font-size . ,(magnification->font-size magnification)))
2156        props)
2157       arg)))
2158
2159 (define-markup-command (fontsize layout props increment arg)
2160   (number? markup?)
2161   #:category font
2162   #:properties ((font-size 0)
2163                 (word-space 1)
2164                 (baseline-skip 2))
2165   "Add @var{increment} to the font-size.  Adjusts @code{baseline-skip}
2166 accordingly.
2167
2168 @lilypond[verbatim,quote]
2169 \\markup {
2170   default
2171   \\hspace #2
2172   \\fontsize #-1.5
2173   smaller
2174 }
2175 @end lilypond"
2176   (interpret-markup
2177    layout
2178    (cons
2179     `((baseline-skip . ,(* baseline-skip (magstep increment)))
2180       (word-space . ,(* word-space (magstep increment)))
2181       (font-size . ,(+ font-size increment)))
2182     props)
2183    arg))
2184
2185 (define-markup-command (magnify layout props sz arg)
2186   (number? markup?)
2187   #:category font
2188   "
2189 @cindex magnifying text
2190
2191 Set the font magnification for its argument.  In the following
2192 example, the middle@tie{}A is 10% larger:
2193
2194 @example
2195 A \\magnify #1.1 @{ A @} A
2196 @end example
2197
2198 Note: Magnification only works if a font name is explicitly selected.
2199 Use @code{\\fontsize} otherwise.
2200
2201 @lilypond[verbatim,quote]
2202 \\markup {
2203   default
2204   \\hspace #2
2205   \\magnify #1.5 {
2206     50% larger
2207   }
2208 }
2209 @end lilypond"
2210   (interpret-markup
2211    layout
2212    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
2213    arg))
2214
2215 (define-markup-command (bold layout props arg)
2216   (markup?)
2217   #:category font
2218   "Switch to bold font-series.
2219
2220 @lilypond[verbatim,quote]
2221 \\markup {
2222   default
2223   \\hspace #2
2224   \\bold
2225   bold
2226 }
2227 @end lilypond"
2228   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
2229
2230 (define-markup-command (sans layout props arg)
2231   (markup?)
2232   #:category font
2233   "Switch to the sans serif font family.
2234
2235 @lilypond[verbatim,quote]
2236 \\markup {
2237   default
2238   \\hspace #2
2239   \\sans {
2240     sans serif
2241   }
2242 }
2243 @end lilypond"
2244   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
2245
2246 (define-markup-command (number layout props arg)
2247   (markup?)
2248   #:category font
2249   "Set font family to @code{number}, which yields the font used for
2250 time signatures and fingerings.  This font contains numbers and
2251 some punctuation; it has no letters.
2252
2253 @lilypond[verbatim,quote]
2254 \\markup {
2255   \\number {
2256     0 1 2 3 4 5 6 7 8 9 . ,
2257   }
2258 }
2259 @end lilypond"
2260   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2261
2262 (define-markup-command (roman layout props arg)
2263   (markup?)
2264   #:category font
2265   "Set font family to @code{roman}.
2266
2267 @lilypond[verbatim,quote]
2268 \\markup {
2269   \\sans \\bold {
2270     sans serif, bold
2271     \\hspace #2
2272     \\roman {
2273       text in roman font family
2274     }
2275     \\hspace #2
2276     return to sans
2277   }
2278 }
2279 @end lilypond"
2280   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
2281
2282 (define-markup-command (huge layout props arg)
2283   (markup?)
2284   #:category font
2285   "Set font size to +2.
2286
2287 @lilypond[verbatim,quote]
2288 \\markup {
2289   default
2290   \\hspace #2
2291   \\huge
2292   huge
2293 }
2294 @end lilypond"
2295   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
2296
2297 (define-markup-command (large layout props arg)
2298   (markup?)
2299   #:category font
2300   "Set font size to +1.
2301
2302 @lilypond[verbatim,quote]
2303 \\markup {
2304   default
2305   \\hspace #2
2306   \\large
2307   large
2308 }
2309 @end lilypond"
2310   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
2311
2312 (define-markup-command (normalsize layout props arg)
2313   (markup?)
2314   #:category font
2315   "Set font size to default.
2316
2317 @lilypond[verbatim,quote]
2318 \\markup {
2319   \\teeny {
2320     this is very small
2321     \\hspace #2
2322     \\normalsize {
2323       normal size
2324     }
2325     \\hspace #2
2326     teeny again
2327   }
2328 }
2329 @end lilypond"
2330   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
2331
2332 (define-markup-command (small layout props arg)
2333   (markup?)
2334   #:category font
2335   "Set font size to -1.
2336
2337 @lilypond[verbatim,quote]
2338 \\markup {
2339   default
2340   \\hspace #2
2341   \\small
2342   small
2343 }
2344 @end lilypond"
2345   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
2346
2347 (define-markup-command (tiny layout props arg)
2348   (markup?)
2349   #:category font
2350   "Set font size to -2.
2351
2352 @lilypond[verbatim,quote]
2353 \\markup {
2354   default
2355   \\hspace #2
2356   \\tiny
2357   tiny
2358 }
2359 @end lilypond"
2360   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
2361
2362 (define-markup-command (teeny layout props arg)
2363   (markup?)
2364   #:category font
2365   "Set font size to -3.
2366
2367 @lilypond[verbatim,quote]
2368 \\markup {
2369   default
2370   \\hspace #2
2371   \\teeny
2372   teeny
2373 }
2374 @end lilypond"
2375   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
2376
2377 (define-markup-command (fontCaps layout props arg)
2378   (markup?)
2379   #:category font
2380   "Set @code{font-shape} to @code{caps}
2381
2382 Note: @code{\\fontCaps} requires the installation and selection of
2383 fonts which support the @code{caps} font shape."
2384   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
2385
2386 ;; Poor man's caps
2387 (define-markup-command (smallCaps layout props arg)
2388   (markup?)
2389   #:category font
2390   "Emit @var{arg} as small caps.
2391
2392 Note: @code{\\smallCaps} does not support accented characters.
2393
2394 @lilypond[verbatim,quote]
2395 \\markup {
2396   default
2397   \\hspace #2
2398   \\smallCaps {
2399     Text in small caps
2400   }
2401 }
2402 @end lilypond"
2403   (define (char-list->markup chars lower)
2404     (let ((final-string (string-upcase (reverse-list->string chars))))
2405       (if lower
2406           (markup #:fontsize -2 final-string)
2407           final-string)))
2408   (define (make-small-caps rest-chars currents current-is-lower prev-result)
2409     (if (null? rest-chars)
2410         (make-concat-markup
2411           (reverse! (cons (char-list->markup currents current-is-lower)
2412                           prev-result)))
2413         (let* ((ch (car rest-chars))
2414                (is-lower (char-lower-case? ch)))
2415           (if (or (and current-is-lower is-lower)
2416                   (and (not current-is-lower) (not is-lower)))
2417               (make-small-caps (cdr rest-chars)
2418                                (cons ch currents)
2419                                is-lower
2420                                prev-result)
2421               (make-small-caps (cdr rest-chars)
2422                                (list ch)
2423                                is-lower
2424                                (if (null? currents)
2425                                    prev-result
2426                                    (cons (char-list->markup
2427                                             currents current-is-lower)
2428                                          prev-result)))))))
2429   (interpret-markup layout props
2430     (if (string? arg)
2431         (make-small-caps (string->list arg) (list) #f (list))
2432         arg)))
2433
2434 (define-markup-command (caps layout props arg)
2435   (markup?)
2436   #:category font
2437   "Copy of the @code{\\smallCaps} command.
2438
2439 @lilypond[verbatim,quote]
2440 \\markup {
2441   default
2442   \\hspace #2
2443   \\caps {
2444     Text in small caps
2445   }
2446 }
2447 @end lilypond"
2448   (interpret-markup layout props (make-smallCaps-markup arg)))
2449
2450 (define-markup-command (dynamic layout props arg)
2451   (markup?)
2452   #:category font
2453   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
2454 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
2455 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
2456 done in a different font.  The recommended font for this is bold and italic.
2457 @lilypond[verbatim,quote]
2458 \\markup {
2459   \\dynamic {
2460     sfzp
2461   }
2462 }
2463 @end lilypond"
2464   (interpret-markup
2465    layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2466
2467 (define-markup-command (text layout props arg)
2468   (markup?)
2469   #:category font
2470   "Use a text font instead of music symbol or music alphabet font.
2471
2472 @lilypond[verbatim,quote]
2473 \\markup {
2474   \\number {
2475     1, 2,
2476     \\text {
2477       three, four,
2478     }
2479     5
2480   }
2481 }
2482 @end lilypond"
2483
2484   ;; ugh - latin1
2485   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
2486                     arg))
2487
2488 (define-markup-command (italic layout props arg)
2489   (markup?)
2490   #:category font
2491   "Use italic @code{font-shape} for @var{arg}.
2492
2493 @lilypond[verbatim,quote]
2494 \\markup {
2495   default
2496   \\hspace #2
2497   \\italic
2498   italic
2499 }
2500 @end lilypond"
2501   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
2502
2503 (define-markup-command (typewriter layout props arg)
2504   (markup?)
2505   #:category font
2506   "Use @code{font-family} typewriter for @var{arg}.
2507
2508 @lilypond[verbatim,quote]
2509 \\markup {
2510   default
2511   \\hspace #2
2512   \\typewriter
2513   typewriter
2514 }
2515 @end lilypond"
2516   (interpret-markup
2517    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
2518
2519 (define-markup-command (upright layout props arg)
2520   (markup?)
2521   #:category font
2522   "Set @code{font-shape} to @code{upright}.  This is the opposite
2523 of @code{italic}.
2524
2525 @lilypond[verbatim,quote]
2526 \\markup {
2527   \\italic {
2528     italic text
2529     \\hspace #2
2530     \\upright {
2531       upright text
2532     }
2533     \\hspace #2
2534     italic again
2535   }
2536 }
2537 @end lilypond"
2538   (interpret-markup
2539    layout (prepend-alist-chain 'font-shape 'upright props) arg))
2540
2541 (define-markup-command (medium layout props arg)
2542   (markup?)
2543   #:category font
2544   "Switch to medium font-series (in contrast to bold).
2545
2546 @lilypond[verbatim,quote]
2547 \\markup {
2548   \\bold {
2549     some bold text
2550     \\hspace #2
2551     \\medium {
2552       medium font series
2553     }
2554     \\hspace #2
2555     bold again
2556   }
2557 }
2558 @end lilypond"
2559   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
2560                     arg))
2561
2562 (define-markup-command (normal-text layout props arg)
2563   (markup?)
2564   #:category font
2565   "Set all font related properties (except the size) to get the default
2566 normal text font, no matter what font was used earlier.
2567
2568 @lilypond[verbatim,quote]
2569 \\markup {
2570   \\huge \\bold \\sans \\caps {
2571     huge bold sans caps
2572     \\hspace #2
2573     \\normal-text {
2574       huge normal
2575     }
2576     \\hspace #2
2577     as before
2578   }
2579 }
2580 @end lilypond"
2581   ;; ugh - latin1
2582   (interpret-markup layout
2583                     (cons '((font-family . roman) (font-shape . upright)
2584                             (font-series . medium) (font-encoding . latin1))
2585                           props)
2586                     arg))
2587
2588 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2589 ;; symbols.
2590 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2591
2592 (define-markup-command (musicglyph layout props glyph-name)
2593   (string?)
2594   #:category music
2595   "@var{glyph-name} is converted to a musical symbol; for example,
2596 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2597 the music font.  See @ruser{The Feta font} for a complete listing of
2598 the possible glyphs.
2599
2600 @lilypond[verbatim,quote]
2601 \\markup {
2602   \\musicglyph #\"f\"
2603   \\musicglyph #\"rests.2\"
2604   \\musicglyph #\"clefs.G_change\"
2605 }
2606 @end lilypond"
2607   (let* ((font (ly:paper-get-font layout
2608                                   (cons '((font-encoding . fetaMusic)
2609                                           (font-name . #f))
2610
2611                                                  props)))
2612          (glyph (ly:font-get-glyph font glyph-name)))
2613     (if (null? (ly:stencil-expr glyph))
2614         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2615
2616     glyph))
2617
2618 (define-markup-command (doublesharp layout props)
2619   ()
2620   #:category music
2621   "Draw a double sharp symbol.
2622
2623 @lilypond[verbatim,quote]
2624 \\markup {
2625   \\doublesharp
2626 }
2627 @end lilypond"
2628   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
2629
2630 (define-markup-command (sesquisharp layout props)
2631   ()
2632   #:category music
2633   "Draw a 3/2 sharp symbol.
2634
2635 @lilypond[verbatim,quote]
2636 \\markup {
2637   \\sesquisharp
2638 }
2639 @end lilypond"
2640   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
2641
2642 (define-markup-command (sharp layout props)
2643   ()
2644   #:category music
2645   "Draw a sharp symbol.
2646
2647 @lilypond[verbatim,quote]
2648 \\markup {
2649   \\sharp
2650 }
2651 @end lilypond"
2652   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
2653
2654 (define-markup-command (semisharp layout props)
2655   ()
2656   #:category music
2657   "Draw a semisharp symbol.
2658
2659 @lilypond[verbatim,quote]
2660 \\markup {
2661   \\semisharp
2662 }
2663 @end lilypond"
2664   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
2665
2666 (define-markup-command (natural layout props)
2667   ()
2668   #:category music
2669   "Draw a natural symbol.
2670
2671 @lilypond[verbatim,quote]
2672 \\markup {
2673   \\natural
2674 }
2675 @end lilypond"
2676   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
2677
2678 (define-markup-command (semiflat layout props)
2679   ()
2680   #:category music
2681   "Draw a semiflat symbol.
2682
2683 @lilypond[verbatim,quote]
2684 \\markup {
2685   \\semiflat
2686 }
2687 @end lilypond"
2688   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
2689
2690 (define-markup-command (flat layout props)
2691   ()
2692   #:category music
2693   "Draw a flat symbol.
2694
2695 @lilypond[verbatim,quote]
2696 \\markup {
2697   \\flat
2698 }
2699 @end lilypond"
2700   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
2701
2702 (define-markup-command (sesquiflat layout props)
2703   ()
2704   #:category music
2705   "Draw a 3/2 flat symbol.
2706
2707 @lilypond[verbatim,quote]
2708 \\markup {
2709   \\sesquiflat
2710 }
2711 @end lilypond"
2712   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
2713
2714 (define-markup-command (doubleflat layout props)
2715   ()
2716   #:category music
2717   "Draw a double flat symbol.
2718
2719 @lilypond[verbatim,quote]
2720 \\markup {
2721   \\doubleflat
2722 }
2723 @end lilypond"
2724   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
2725
2726 (define-markup-command (with-color layout props color arg)
2727   (color? markup?)
2728   #:category other
2729   "
2730 @cindex coloring text
2731
2732 Draw @var{arg} in color specified by @var{color}.
2733
2734 @lilypond[verbatim,quote]
2735 \\markup {
2736   \\with-color #red
2737   red
2738   \\hspace #2
2739   \\with-color #green
2740   green
2741   \\hspace #2
2742   \\with-color #blue
2743   blue
2744 }
2745 @end lilypond"
2746   (let ((stil (interpret-markup layout props arg)))
2747     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
2748                      (ly:stencil-extent stil X)
2749                      (ly:stencil-extent stil Y))))
2750
2751 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2752 ;; glyphs
2753 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2754
2755 (define-markup-command (arrow-head layout props axis dir filled)
2756   (integer? ly:dir? boolean?)
2757   #:category graphic
2758   "Produce an arrow head in specified direction and axis.
2759 Use the filled head if @var{filled} is specified.
2760 @lilypond[verbatim,quote]
2761 \\markup {
2762   \\fontsize #5 {
2763     \\general-align #Y #DOWN {
2764       \\arrow-head #Y #UP ##t
2765       \\arrow-head #Y #DOWN ##f
2766       \\hspace #2
2767       \\arrow-head #X #RIGHT ##f
2768       \\arrow-head #X #LEFT ##f
2769     }
2770   }
2771 }
2772 @end lilypond"
2773   (let*
2774       ((name (format #f "arrowheads.~a.~a~a"
2775                      (if filled
2776                          "close"
2777                          "open")
2778                      axis
2779                      dir)))
2780     (ly:font-get-glyph
2781      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2782                                      props))
2783      name)))
2784
2785 (define-markup-command (lookup layout props glyph-name)
2786   (string?)
2787   #:category other
2788   "Lookup a glyph by name.
2789
2790 @lilypond[verbatim,quote]
2791 \\markup {
2792   \\override #'(font-encoding . fetaBraces) {
2793     \\lookup #\"brace200\"
2794     \\hspace #2
2795     \\rotate #180
2796     \\lookup #\"brace180\"
2797   }
2798 }
2799 @end lilypond"
2800   (ly:font-get-glyph (ly:paper-get-font layout props)
2801                      glyph-name))
2802
2803 (define-markup-command (char layout props num)
2804   (integer?)
2805   #:category other
2806   "Produce a single character.  Characters encoded in hexadecimal
2807 format require the prefix @code{#x}.
2808
2809 @lilypond[verbatim,quote]
2810 \\markup {
2811   \\char #65 \\char ##x00a9
2812 }
2813 @end lilypond"
2814   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
2815
2816 (define number->mark-letter-vector (make-vector 25 #\A))
2817
2818 (do ((i 0 (1+ i))
2819      (j 0 (1+ j)))
2820     ((>= i 26))
2821   (if (= i (- (char->integer #\I) (char->integer #\A)))
2822       (set! i (1+ i)))
2823   (vector-set! number->mark-letter-vector j
2824                (integer->char (+ i (char->integer #\A)))))
2825
2826 (define number->mark-alphabet-vector (list->vector
2827   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
2828
2829 (define (number->markletter-string vec n)
2830   "Double letters for big marks."
2831   (let* ((lst (vector-length vec)))
2832
2833     (if (>= n lst)
2834         (string-append (number->markletter-string vec (1- (quotient n lst)))
2835                        (number->markletter-string vec (remainder n lst)))
2836         (make-string 1 (vector-ref vec n)))))
2837
2838 (define-markup-command (markletter layout props num)
2839   (integer?)
2840   #:category other
2841   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2842 (skipping letter@tie{}I), and continue with double letters.
2843
2844 @lilypond[verbatim,quote]
2845 \\markup {
2846   \\markletter #8
2847   \\hspace #2
2848   \\markletter #26
2849 }
2850 @end lilypond"
2851   (ly:text-interface::interpret-markup layout props
2852     (number->markletter-string number->mark-letter-vector num)))
2853
2854 (define-markup-command (markalphabet layout props num)
2855   (integer?)
2856   #:category other
2857    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2858 and continue with double letters.
2859
2860 @lilypond[verbatim,quote]
2861 \\markup {
2862   \\markalphabet #8
2863   \\hspace #2
2864   \\markalphabet #26
2865 }
2866 @end lilypond"
2867    (ly:text-interface::interpret-markup layout props
2868      (number->markletter-string number->mark-alphabet-vector num)))
2869
2870 (define-public (horizontal-slash-interval num forward number-interval mag)
2871   (if forward
2872     (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
2873           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2874           (else (interval-widen number-interval (* mag 0.25))))
2875     (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
2876           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2877           (else (interval-widen number-interval (* mag 0.25))))
2878   ))
2879
2880 (define-public (adjust-slash-stencil num forward stencil mag)
2881   (if forward
2882     (cond ((= num 2)
2883               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2884           ((= num 3)
2885               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2886           ;((= num 5)
2887               ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
2888           ;((= num 7)
2889           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2890           (else stencil))
2891     (cond ((= num 6)
2892               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
2893           ;((= num 8)
2894           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2895           (else stencil))
2896   )
2897 )
2898
2899 (define (slashed-digit-internal layout props num forward font-size thickness)
2900   (let* ((mag (magstep font-size))
2901          (thickness (* mag
2902                        (ly:output-def-lookup layout 'line-thickness)
2903                        thickness))
2904          ; backward slashes might use slope and point in the other direction!
2905          (dy (* mag (if forward 0.4 -0.4)))
2906          (number-stencil (interpret-markup layout
2907                                            (prepend-alist-chain 'font-encoding 'fetaText props)
2908                                            (number->string num)))
2909          (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
2910          (center (interval-center (ly:stencil-extent number-stencil Y)))
2911          ; Use the real extents of the slash, not the whole number, because we
2912          ; might translate the slash later on!
2913          (num-y (interval-widen (cons center center) (abs dy)))
2914          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
2915          (slash-stencil (if is-sane
2916                             (make-line-stencil thickness
2917                                          (car num-x) (- (interval-center num-y) dy)
2918                                          (cdr num-x) (+ (interval-center num-y) dy))
2919                             #f)))
2920     (if (ly:stencil? slash-stencil)
2921       (begin
2922         ; for some numbers we need to shift the slash/backslash up or down to make
2923         ; the slashed digit look better
2924         (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
2925         (set! number-stencil
2926           (ly:stencil-add number-stencil slash-stencil)))
2927       (ly:warning "Unable to create slashed digit ~a" num))
2928     number-stencil))
2929
2930
2931 (define-markup-command (slashed-digit layout props num)
2932   (integer?)
2933   #:category other
2934   #:properties ((font-size 0)
2935                 (thickness 1.6))
2936   "
2937 @cindex slashed digits
2938
2939 A feta number, with slash.  This is for use in the context of
2940 figured bass notation.
2941 @lilypond[verbatim,quote]
2942 \\markup {
2943   \\slashed-digit #5
2944   \\hspace #2
2945   \\override #'(thickness . 3)
2946   \\slashed-digit #7
2947 }
2948 @end lilypond"
2949   (slashed-digit-internal layout props num #t font-size thickness))
2950
2951 (define-markup-command (backslashed-digit layout props num)
2952   (integer?)
2953   #:category other
2954   #:properties ((font-size 0)
2955                 (thickness 1.6))
2956   "
2957 @cindex backslashed digits
2958
2959 A feta number, with backslash.  This is for use in the context of
2960 figured bass notation.
2961 @lilypond[verbatim,quote]
2962 \\markup {
2963   \\backslashed-digit #5
2964   \\hspace #2
2965   \\override #'(thickness . 3)
2966   \\backslashed-digit #7
2967 }
2968 @end lilypond"
2969   (slashed-digit-internal layout props num #f font-size thickness))
2970
2971 ;; eyeglasses
2972 (define eyeglassespath
2973   '((moveto 0.42 0.77)
2974     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
2975     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
2976     (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
2977     (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
2978     (closepath)
2979     (moveto 2.07 0.77)
2980     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
2981     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
2982     (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
2983     (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
2984     (closepath)
2985     (moveto 1.025 0.935)
2986     (rcurveto 0 0.182 -0.148 0.33 -0.33 0.33)
2987     (rcurveto -0.182 0 -0.33 -0.148 -0.33 -0.33)
2988     (moveto -0.68 0.77)
2989     (rlineto 0.66 1.43)
2990     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)
2991     (moveto 2.07 0.77)
2992     (rlineto 0.66 1.43)
2993     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)))
2994
2995 (define-markup-command (eyeglasses layout props)
2996   ()
2997   #:category other
2998   "Prints out eyeglasses, indicating strongly to look at the conductor.
2999 @lilypond[verbatim,quote]
3000 \\markup { \\eyeglasses }
3001 @end lilypond"
3002   (interpret-markup layout props
3003     (make-override-markup '(line-cap-style . butt)
3004       (make-path-markup 0.15 eyeglassespath))))
3005
3006 (define-markup-command (left-brace layout props size)
3007   (number?)
3008   #:category other
3009   "
3010 A feta brace in point size @var{size}.
3011
3012 @lilypond[verbatim,quote]
3013 \\markup {
3014   \\left-brace #35
3015   \\hspace #2
3016   \\left-brace #45
3017 }
3018 @end lilypond"
3019   (let* ((font (ly:paper-get-font layout
3020                                   (cons '((font-encoding . fetaBraces)
3021                                           (font-name . #f))
3022                                         props)))
3023          (glyph-count (1- (ly:otf-glyph-count font)))
3024          (scale (ly:output-def-lookup layout 'output-scale))
3025          (scaled-size (/ (ly:pt size) scale))
3026          (glyph (lambda (n)
3027                   (ly:font-get-glyph font (string-append "brace"
3028                                                          (number->string n)))))
3029          (get-y-from-brace (lambda (brace)
3030                              (interval-length
3031                               (ly:stencil-extent (glyph brace) Y))))
3032          (find-brace (binary-search 0 glyph-count get-y-from-brace scaled-size))
3033          (glyph-found (glyph find-brace)))
3034
3035     (if (or (null? (ly:stencil-expr glyph-found))
3036             (< scaled-size (interval-length (ly:stencil-extent (glyph 0) Y)))
3037             (> scaled-size (interval-length
3038                             (ly:stencil-extent (glyph glyph-count) Y))))
3039         (begin
3040           (ly:warning (_ "no brace found for point size ~S ") size)
3041           (ly:warning (_ "defaulting to ~S pt")
3042                       (/ (* scale (interval-length
3043                                    (ly:stencil-extent glyph-found Y)))
3044                          (ly:pt 1)))))
3045     glyph-found))
3046
3047 (define-markup-command (right-brace layout props size)
3048   (number?)
3049   #:category other
3050   "
3051 A feta brace in point size @var{size}, rotated 180 degrees.
3052
3053 @lilypond[verbatim,quote]
3054 \\markup {
3055   \\right-brace #45
3056   \\hspace #2
3057   \\right-brace #35
3058 }
3059 @end lilypond"
3060   (interpret-markup layout props (markup #:rotate 180 #:left-brace size)))
3061
3062 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3063 ;; the note command.
3064 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3065
3066 ;; TODO: better syntax.
3067
3068 (define-markup-command (note-by-number layout props log dot-count dir)
3069   (number? number? number?)
3070   #:category music
3071   #:properties ((font-size 0)
3072                 (style '()))
3073   "
3074 @cindex notes within text by log and dot-count
3075
3076 Construct a note symbol, with stem.  By using fractional values for
3077 @var{dir}, longer or shorter stems can be obtained.
3078
3079 @lilypond[verbatim,quote]
3080 \\markup {
3081   \\note-by-number #3 #0 #DOWN
3082   \\hspace #2
3083   \\note-by-number #1 #2 #0.8
3084 }
3085 @end lilypond"
3086   (define (get-glyph-name-candidates dir log style)
3087     (map (lambda (dir-name)
3088            (format #f "noteheads.~a~a" dir-name
3089                    (if (and (symbol? style)
3090                             (not (equal? 'default style)))
3091                        (select-head-glyph style (min log 2))
3092                        (min log 2))))
3093          (list (if (= dir UP) "u" "d")
3094                "s")))
3095
3096   (define (get-glyph-name font cands)
3097     (if (null? cands)
3098         ""
3099         (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
3100             (get-glyph-name font (cdr cands))
3101             (car cands))))
3102
3103   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
3104                                                props)))
3105          (size-factor (magstep font-size))
3106          (stem-length (* size-factor (max 3 (- log 1))))
3107          (head-glyph-name
3108           (let ((result (get-glyph-name font (get-glyph-name-candidates
3109                                               (sign dir) log style))))
3110             (if (string-null? result)
3111                 ;; If no glyph name can be found, select default heads.  Though
3112                 ;; this usually means an unsupported style has been chosen, it
3113                 ;; also prevents unrelated 'style settings from other grobs
3114                 ;; (e.g., TextSpanner and TimeSignature) leaking into markup.
3115                 (get-glyph-name font (get-glyph-name-candidates
3116                                       (sign dir) log 'default))
3117                 result)))
3118          (head-glyph (ly:font-get-glyph font head-glyph-name))
3119          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
3120          (stem-thickness (* size-factor 0.13))
3121          (stemy (* dir stem-length))
3122          (attach-off (cons (interval-index
3123                             (ly:stencil-extent head-glyph X)
3124                             (* (sign dir) (car attach-indices)))
3125                            (* (sign dir) ; fixme, this is inconsistent between X & Y.
3126                               (interval-index
3127                                (ly:stencil-extent head-glyph Y)
3128                                (cdr attach-indices)))))
3129          (stem-glyph (and (> log 0)
3130                           (ly:round-filled-box
3131                            (ordered-cons (car attach-off)
3132                                          (+ (car attach-off)
3133                                             (* (- (sign dir)) stem-thickness)))
3134                            (cons (min stemy (cdr attach-off))
3135                                  (max stemy (cdr attach-off)))
3136                            (/ stem-thickness 3))))
3137
3138          (dot (ly:font-get-glyph font "dots.dot"))
3139          (dotwid (interval-length (ly:stencil-extent dot X)))
3140          (dots (and (> dot-count 0)
3141                     (apply ly:stencil-add
3142                            (map (lambda (x)
3143                                   (ly:stencil-translate-axis
3144                                    dot (* 2 x dotwid) X))
3145                                 (iota dot-count)))))
3146          (flaggl (and (> log 2)
3147                       (ly:stencil-translate
3148                        (ly:font-get-glyph font
3149                                           (string-append "flags."
3150                                                          (if (> dir 0) "u" "d")
3151                                                          (number->string log)))
3152                        (cons (+ (car attach-off) (if (< dir 0)
3153                                                      stem-thickness 0))
3154                              stemy)))))
3155
3156     ;; If there is a flag on an upstem and the stem is short, move the dots
3157     ;; to avoid the flag.  16th notes get a special case because their flags
3158     ;; hang lower than any other flags.
3159     (if (and dots (> dir 0) (> log 2)
3160              (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
3161         (set! dots (ly:stencil-translate-axis dots 0.5 X)))
3162     (if flaggl
3163         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
3164     (if (ly:stencil? stem-glyph)
3165         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
3166         (set! stem-glyph head-glyph))
3167     (if (ly:stencil? dots)
3168         (set! stem-glyph
3169               (ly:stencil-add
3170                (ly:stencil-translate-axis
3171                 dots
3172                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
3173                 X)
3174                stem-glyph)))
3175     stem-glyph))
3176
3177 (define-public log2
3178   (let ((divisor (log 2)))
3179     (lambda (z) (inexact->exact (/ (log z) divisor)))))
3180
3181 (define (parse-simple-duration duration-string)
3182   "Parse the `duration-string', e.g. ''4..'' or ''breve.'',
3183 and return a (log dots) list."
3184   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)")
3185                             duration-string)))
3186     (if (and match (string=? duration-string (match:substring match 0)))
3187         (let ((len (match:substring match 1))
3188               (dots (match:substring match 2)))
3189           (list (cond ((string=? len "breve") -1)
3190                       ((string=? len "longa") -2)
3191                       ((string=? len "maxima") -3)
3192                       (else (log2 (string->number len))))
3193                 (if dots (string-length dots) 0)))
3194         (ly:error (_ "not a valid duration string: ~a") duration-string))))
3195
3196 (define-markup-command (note layout props duration dir)
3197   (string? number?)
3198   #:category music
3199   #:properties (note-by-number-markup)
3200   "
3201 @cindex notes within text by string
3202
3203 This produces a note with a stem pointing in @var{dir} direction, with
3204 the @var{duration} for the note head type and augmentation dots.  For
3205 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
3206 a shortened down stem.
3207
3208 @lilypond[verbatim,quote]
3209 \\markup {
3210   \\override #'(style . cross) {
3211     \\note #\"4..\" #UP
3212   }
3213   \\hspace #2
3214   \\note #\"breve\" #0
3215 }
3216 @end lilypond"
3217   (let ((parsed (parse-simple-duration duration)))
3218     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
3219
3220 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3221 ;; translating.
3222 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3223
3224 (define-markup-command (lower layout props amount arg)
3225   (number? markup?)
3226   #:category align
3227   "
3228 @cindex lowering text
3229
3230 Lower @var{arg} by the distance @var{amount}.
3231 A negative @var{amount} indicates raising; see also @code{\\raise}.
3232
3233 @lilypond[verbatim,quote]
3234 \\markup {
3235   one
3236   \\lower #3
3237   two
3238   three
3239 }
3240 @end lilypond"
3241   (ly:stencil-translate-axis (interpret-markup layout props arg)
3242                              (- amount) Y))
3243
3244 (define-markup-command (translate-scaled layout props offset arg)
3245   (number-pair? markup?)
3246   #:category align
3247   #:properties ((font-size 0))
3248   "
3249 @cindex translating text
3250 @cindex scaling text
3251
3252 Translate @var{arg} by @var{offset}, scaling the offset by the
3253 @code{font-size}.
3254
3255 @lilypond[verbatim,quote]
3256 \\markup {
3257   \\fontsize #5 {
3258     * \\translate #'(2 . 3) translate
3259     \\hspace #2
3260     * \\translate-scaled #'(2 . 3) translate-scaled
3261   }
3262 }
3263 @end lilypond"
3264   (let* ((factor (magstep font-size))
3265          (scaled (cons (* factor (car offset))
3266                        (* factor (cdr offset)))))
3267     (ly:stencil-translate (interpret-markup layout props arg)
3268                           scaled)))
3269
3270 (define-markup-command (raise layout props amount arg)
3271   (number? markup?)
3272   #:category align
3273   "
3274 @cindex raising text
3275
3276 Raise @var{arg} by the distance @var{amount}.
3277 A negative @var{amount} indicates lowering, see also @code{\\lower}.
3278
3279 The argument to @code{\\raise} is the vertical displacement amount,
3280 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
3281 raise objects in relation to their surrounding markups.
3282
3283 If the text object itself is positioned above or below the staff, then
3284 @code{\\raise} cannot be used to move it, since the mechanism that
3285 positions it next to the staff cancels any shift made with
3286 @code{\\raise}.  For vertical positioning, use the @code{padding}
3287 and/or @code{extra-offset} properties.
3288
3289 @lilypond[verbatim,quote]
3290 \\markup {
3291   C
3292   \\small
3293   \\bold
3294   \\raise #1.0
3295   9/7+
3296 }
3297 @end lilypond"
3298   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
3299
3300 (define-markup-command (fraction layout props arg1 arg2)
3301   (markup? markup?)
3302   #:category other
3303   #:properties ((font-size 0))
3304   "
3305 @cindex creating text fractions
3306
3307 Make a fraction of two markups.
3308 @lilypond[verbatim,quote]
3309 \\markup {
3310   π ≈
3311   \\fraction 355 113
3312 }
3313 @end lilypond"
3314   (let* ((m1 (interpret-markup layout props arg1))
3315          (m2 (interpret-markup layout props arg2))
3316          (factor (magstep font-size))
3317          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
3318          (padding (* factor 0.2))
3319          (baseline (* factor 0.6))
3320          (offset (* factor 0.75)))
3321     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
3322     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
3323     (let* ((x1 (ly:stencil-extent m1 X))
3324            (x2 (ly:stencil-extent m2 X))
3325            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
3326            ;; should stack mols separately, to maintain LINE on baseline
3327            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
3328       (set! stack
3329             (ly:stencil-aligned-to stack Y CENTER))
3330       (set! stack
3331             (ly:stencil-aligned-to stack X LEFT))
3332       ;; should have EX dimension
3333       ;; empirical anyway
3334       (ly:stencil-translate-axis stack offset Y))))
3335
3336 (define-markup-command (normal-size-super layout props arg)
3337   (markup?)
3338   #:category font
3339   #:properties ((baseline-skip))
3340   "
3341 @cindex setting superscript in standard font size
3342
3343 Set @var{arg} in superscript with a normal font size.
3344
3345 @lilypond[verbatim,quote]
3346 \\markup {
3347   default
3348   \\normal-size-super {
3349     superscript in standard size
3350   }
3351 }
3352 @end lilypond"
3353   (ly:stencil-translate-axis
3354    (interpret-markup layout props arg)
3355    (* 0.5 baseline-skip) Y))
3356
3357 (define-markup-command (super layout props arg)
3358   (markup?)
3359   #:category font
3360   #:properties ((font-size 0)
3361                 (baseline-skip))
3362   "
3363 @cindex superscript text
3364
3365 Set @var{arg} in superscript.
3366
3367 @lilypond[verbatim,quote]
3368 \\markup {
3369   E =
3370   \\concat {
3371     mc
3372     \\super
3373     2
3374   }
3375 }
3376 @end lilypond"
3377   (ly:stencil-translate-axis
3378    (interpret-markup
3379     layout
3380     (cons `((font-size . ,(- font-size 3))) props)
3381     arg)
3382    (* 0.5 baseline-skip)
3383    Y))
3384
3385 (define-markup-command (translate layout props offset arg)
3386   (number-pair? markup?)
3387   #:category align
3388   "
3389 @cindex translating text
3390
3391 Translate @var{arg} relative to its surroundings.  @var{offset}
3392 is a pair of numbers representing the displacement in the X and Y axis.
3393
3394 @lilypond[verbatim,quote]
3395 \\markup {
3396   *
3397   \\translate #'(2 . 3)
3398   \\line { translated two spaces right, three up }
3399 }
3400 @end lilypond"
3401   (ly:stencil-translate (interpret-markup layout props arg)
3402                         offset))
3403
3404 (define-markup-command (sub layout props arg)
3405   (markup?)
3406   #:category font
3407   #:properties ((font-size 0)
3408                 (baseline-skip))
3409   "
3410 @cindex subscript text
3411
3412 Set @var{arg} in subscript.
3413
3414 @lilypond[verbatim,quote]
3415 \\markup {
3416   \\concat {
3417     H
3418     \\sub {
3419       2
3420     }
3421     O
3422   }
3423 }
3424 @end lilypond"
3425   (ly:stencil-translate-axis
3426    (interpret-markup
3427     layout
3428     (cons `((font-size . ,(- font-size 3))) props)
3429     arg)
3430    (* -0.5 baseline-skip)
3431    Y))
3432
3433 (define-markup-command (normal-size-sub layout props arg)
3434   (markup?)
3435   #:category font
3436   #:properties ((baseline-skip))
3437   "
3438 @cindex setting subscript in standard font size
3439
3440 Set @var{arg} in subscript with a normal font size.
3441
3442 @lilypond[verbatim,quote]
3443 \\markup {
3444   default
3445   \\normal-size-sub {
3446     subscript in standard size
3447   }
3448 }
3449 @end lilypond"
3450   (ly:stencil-translate-axis
3451    (interpret-markup layout props arg)
3452    (* -0.5 baseline-skip)
3453    Y))
3454
3455 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3456 ;; brackets.
3457 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3458
3459 (define-markup-command (hbracket layout props arg)
3460   (markup?)
3461   #:category graphic
3462   "
3463 @cindex placing horizontal brackets around text
3464
3465 Draw horizontal brackets around @var{arg}.
3466
3467 @lilypond[verbatim,quote]
3468 \\markup {
3469   \\hbracket {
3470     \\line {
3471       one two three
3472     }
3473   }
3474 }
3475 @end lilypond"
3476   (let ((th 0.1) ;; todo: take from GROB.
3477         (m (interpret-markup layout props arg)))
3478     (bracketify-stencil m X th (* 2.5 th) th)))
3479
3480 (define-markup-command (bracket layout props arg)
3481   (markup?)
3482   #:category graphic
3483   "
3484 @cindex placing vertical brackets around text
3485
3486 Draw vertical brackets around @var{arg}.
3487
3488 @lilypond[verbatim,quote]
3489 \\markup {
3490   \\bracket {
3491     \\note #\"2.\" #UP
3492   }
3493 }
3494 @end lilypond"
3495   (let ((th 0.1) ;; todo: take from GROB.
3496         (m (interpret-markup layout props arg)))
3497     (bracketify-stencil m Y th (* 2.5 th) th)))
3498
3499 (define-markup-command (parenthesize layout props arg)
3500   (markup?)
3501   #:category graphic
3502   #:properties ((angularity 0)
3503                 (padding)
3504                 (size 1)
3505                 (thickness 1)
3506                 (width 0.25))
3507   "
3508 @cindex placing parentheses around text
3509
3510 Draw parentheses around @var{arg}.  This is useful for parenthesizing
3511 a column containing several lines of text.
3512
3513 @lilypond[verbatim,quote]
3514 \\markup {
3515   \\line {
3516     \\parenthesize {
3517       \\column {
3518         foo
3519         bar
3520       }
3521     }
3522     \\override #'(angularity . 2) {
3523       \\parenthesize {
3524         \\column {
3525           bah
3526           baz
3527         }
3528       }
3529     }
3530   }
3531 }
3532 @end lilypond"
3533   (let* ((markup (interpret-markup layout props arg))
3534          (scaled-width (* size width))
3535          (scaled-thickness
3536           (* (chain-assoc-get 'line-thickness props 0.1)
3537              thickness))
3538          (half-thickness
3539           (min (* size 0.5 scaled-thickness)
3540                (* (/ 4 3.0) scaled-width)))
3541          (padding (chain-assoc-get 'padding props half-thickness)))
3542     (parenthesize-stencil
3543      markup half-thickness scaled-width angularity padding)))
3544
3545
3546 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3547 ;; Delayed markup evaluation
3548 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3549
3550 (define-markup-command (page-ref layout props label gauge default)
3551   (symbol? markup? markup?)
3552   #:category other
3553   "
3554 @cindex referencing page numbers in text
3555
3556 Reference to a page number.  @var{label} is the label set on the referenced
3557 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
3558 the maximum width of the page number, and @var{default} the value to display
3559 when @var{label} is not found."
3560   (let* ((gauge-stencil (interpret-markup layout props gauge))
3561          (x-ext (ly:stencil-extent gauge-stencil X))
3562          (y-ext (ly:stencil-extent gauge-stencil Y)))
3563     (ly:make-stencil
3564      `(delay-stencil-evaluation
3565        ,(delay (ly:stencil-expr
3566                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
3567                        (page-number (if (list? table)
3568                                         (assoc-get label table)
3569                                         #f))
3570                        (page-markup (if page-number (format #f "~a" page-number) default))
3571                        (page-stencil (interpret-markup layout props page-markup))
3572                        (gap (- (interval-length x-ext)
3573                                (interval-length (ly:stencil-extent page-stencil X)))))
3574                   (interpret-markup layout props
3575                                     (markup #:concat (#:hspace gap page-markup)))))))
3576      x-ext
3577      y-ext)))
3578
3579 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3580 ;; scaling
3581 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3582
3583 (define-markup-command (scale layout props factor-pair arg)
3584   (number-pair? markup?)
3585   #:category graphic
3586   "
3587 @cindex scaling markup
3588 @cindex mirroring markup
3589
3590 Scale @var{arg}.  @var{factor-pair} is a pair of numbers
3591 representing the scaling-factor in the X and Y axes.
3592 Negative values may be used to produce mirror images.
3593
3594 @lilypond[verbatim,quote]
3595 \\markup {
3596   \\line {
3597     \\scale #'(2 . 1)
3598     stretched
3599     \\scale #'(1 . -1)
3600     mirrored
3601   }
3602 }
3603 @end lilypond"
3604   (let ((stil (interpret-markup layout props arg))
3605         (sx (car factor-pair))
3606         (sy (cdr factor-pair)))
3607     (ly:stencil-scale stil sx sy)))
3608
3609 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3610 ;; Repeating
3611 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3612
3613 (define-markup-command (pattern layout props count axis space pattern)
3614   (integer? integer? number? markup?)
3615   #:category other
3616   "
3617 Prints @var{count} times a @var{pattern} markup.
3618 Patterns are spaced apart by @var{space}.
3619 Patterns are distributed on @var{axis}.
3620
3621 @lilypond[verbatim, quote]
3622 \\markup \\column {
3623   \"Horizontally repeated :\"
3624   \\pattern #7 #X #2 \\flat
3625   \\null
3626   \"Vertically repeated :\"
3627   \\pattern #3 #Y #0.5 \\flat
3628 }
3629 @end lilypond"
3630   (let ((pattern-width (interval-length
3631                          (ly:stencil-extent (interpret-markup layout props pattern) X)))
3632         (new-props (prepend-alist-chain 'word-space 0 (prepend-alist-chain 'baseline-skip 0 props))))
3633     (let loop ((i (1- count)) (patterns (markup)))
3634       (if (zero? i)
3635           (interpret-markup
3636             layout
3637             new-props
3638             (if (= axis X)
3639                 (markup patterns pattern)
3640                 (markup #:column (patterns pattern))))
3641           (loop (1- i)
3642             (if (= axis X)
3643                 (markup patterns pattern #:hspace space)
3644                 (markup #:column (patterns pattern #:vspace space))))))))
3645
3646 (define-markup-command (fill-with-pattern layout props space dir pattern left right)
3647   (number? ly:dir? markup? markup? markup?)
3648   #:category align
3649   #:properties ((word-space)
3650                 (line-width))
3651   "
3652 Put @var{left} and @var{right} in a horizontal line of width @code{line-width}
3653 with a line of markups @var{pattern} in between.
3654 Patterns are spaced apart by @var{space}.
3655 Patterns are aligned to the @var{dir} markup.
3656
3657 @lilypond[verbatim, quote]
3658 \\markup \\column {
3659   \"right-aligned :\"
3660   \\fill-with-pattern #1 #RIGHT . first right
3661   \\fill-with-pattern #1 #RIGHT . second right
3662   \\null
3663   \"center-aligned :\"
3664   \\fill-with-pattern #1.5 #CENTER - left right
3665   \\null
3666   \"left-aligned :\"
3667   \\override #'(line-width . 50)
3668   \\fill-with-pattern #2 #LEFT : left first
3669   \\override #'(line-width . 50)
3670   \\fill-with-pattern #2 #LEFT : left second
3671 }
3672 @end lilypond"
3673   (let* ((pattern-x-extent (ly:stencil-extent (interpret-markup layout props pattern) X))
3674          (pattern-width (interval-length pattern-x-extent))
3675          (left-width (interval-length (ly:stencil-extent (interpret-markup layout props left) X)))
3676          (right-width (interval-length (ly:stencil-extent (interpret-markup layout props right) X)))
3677          (middle-width (max 0 (- line-width (+ (+ left-width right-width) (* word-space 2)))))
3678          (period (+ space pattern-width))
3679          (count (truncate (/ (- middle-width pattern-width) period)))
3680          (x-offset (+ (* (- (- middle-width (* count period)) pattern-width) (/ (1+ dir) 2)) (abs (car pattern-x-extent)))))
3681     (interpret-markup layout props
3682                       (markup left
3683                               #:with-dimensions (cons 0 middle-width) '(0 . 0)
3684                               #:translate (cons x-offset 0)
3685                               #:pattern (1+ count) X space pattern
3686                               right))))
3687
3688 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3689 ;; Replacements
3690 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3691
3692 (define-markup-command (replace layout props replacements arg)
3693   (list? markup?)
3694   #:category font
3695   "
3696 Used to automatically replace a string by another in the markup @var{arg}.
3697 Each pair of the alist @var{replacements} specifies what should be replaced.
3698 The @code{key} is the string to be replaced by the @code{value} string.
3699
3700 @lilypond[verbatim, quote]
3701 \\markup \\replace #'((\"thx\" . \"Thanks!\")) thx
3702 @end lilypond"
3703   (interpret-markup
3704    layout
3705    (internal-add-text-replacements
3706     props
3707     replacements)
3708    (markup arg)))
3709
3710 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3711 ;; Markup list commands
3712 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3713
3714 (define-public (space-lines baseline stils)
3715   (let space-stil ((stils stils)
3716                    (result (list)))
3717     (if (null? stils)
3718         (reverse! result)
3719         (let* ((stil (car stils))
3720                (dy-top (max (- (/ baseline 1.5)
3721                                (interval-bound (ly:stencil-extent stil Y) UP))
3722                             0.0))
3723                (dy-bottom (max (+ (/ baseline 3.0)
3724                                   (interval-bound (ly:stencil-extent stil Y) DOWN))
3725                                0.0))
3726                (new-stil (ly:make-stencil
3727                           (ly:stencil-expr stil)
3728                           (ly:stencil-extent stil X)
3729                           (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN)
3730                                    dy-bottom)
3731                                 (+ (interval-bound (ly:stencil-extent stil Y) UP)
3732                                    dy-top)))))
3733           (space-stil (cdr stils) (cons new-stil result))))))
3734
3735 (define-markup-list-command (justified-lines layout props args)
3736   (markup-list?)
3737   #:properties ((baseline-skip)
3738                 wordwrap-internal-markup-list)
3739   "
3740 @cindex justifying lines of text
3741
3742 Like @code{\\justify}, but return a list of lines instead of a single markup.
3743 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
3744 @var{X}@tie{}is the number of staff spaces."
3745   (space-lines baseline-skip
3746                (interpret-markup-list layout props
3747                                       (make-wordwrap-internal-markup-list #t args))))
3748
3749 (define-markup-list-command (wordwrap-lines layout props args)
3750   (markup-list?)
3751   #:properties ((baseline-skip)
3752                 wordwrap-internal-markup-list)
3753   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
3754 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
3755 where @var{X} is the number of staff spaces."
3756   (space-lines baseline-skip
3757                (interpret-markup-list layout props
3758                                       (make-wordwrap-internal-markup-list #f args))))
3759
3760 (define-markup-list-command (column-lines layout props args)
3761   (markup-list?)
3762   #:properties ((baseline-skip))
3763   "Like @code{\\column}, but return a list of lines instead of a single markup.
3764 @code{baseline-skip} determines the space between each markup in @var{args}."
3765   (space-lines baseline-skip
3766                (interpret-markup-list layout props args)))
3767
3768 (define-markup-list-command (override-lines layout props new-prop args)
3769   (pair? markup-list?)
3770   "Like @code{\\override}, for markup lists."
3771   (interpret-markup-list layout (cons (list new-prop) props) args))