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