scm/define-markup-commands.scm

   1 ;;;; define-markup-commands.scm -- markup commands
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 2000--2007  Han-Wen Nienhuys <hanwen@xs4all.nl>
   6 ;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
   7
   8
   9 ;;; markup commands
  10 ;;;  * each markup function should have a doc string with
  11 ;;     syntax, description and example.
  12
  13 (use-modules (ice-9 regex))
  14
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;; utility functions
  17 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18
  19 (define-public empty-stencil (ly:make-stencil '() '(1 . -1) '(1 . -1)))
  20 (define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
  21
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;; geometric shapes
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25
  26 (define-builtin-markup-command (draw-line layout props dest)
  27   (number-pair?)
  28   graphic
  29   ((thickness 1))
  30   "
  31 @cindex drawing lines within text
  32
  33 A simple line.
  34 @lilypond[verbatim,quote]
  35 \\markup {
  36   \\draw-line #'(4 . 4)
  37   \\override #'(thickness . 5)
  38   \\draw-line #'(-3 . 0)
  39 }
  40 @end lilypond"
  41   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
  42                thickness))
  43         (x (car dest))
  44         (y (cdr dest)))
  45     (make-line-stencil th 0 0 x y)))
  46
  47 (define-builtin-markup-command (draw-circle layout props radius thickness fill)
  48   (number? number? boolean?)
  49   graphic
  50   ()
  51   "
  52 @cindex drawing circles within text
  53
  54 A circle of radius @var{radius}, thickness @var{thickness} and
  55 optionally filled.
  56
  57 @lilypond[verbatim,quote]
  58 \\markup {
  59   \\draw-circle #2 #0.5 ##f
  60   \\hspace #2
  61   \\draw-circle #2 #0 ##t
  62 }
  63 @end lilypond"
  64   (make-circle-stencil radius thickness fill))
  65
  66 (define-builtin-markup-command (triangle layout props filled)
  67   (boolean?)
  68   graphic
  69   ((thickness 0.1)
  70    (font-size 0)
  71    (baseline-skip 2))
  72   "
  73 @cindex drawing triangles within text
  74
  75 A triangle, either filled or empty.
  76
  77 @lilypond[verbatim,quote]
  78 \\markup {
  79   \\triangle ##t
  80   \\hspace #2
  81   \\triangle ##f
  82 }
  83 @end lilypond"
  84   (let ((ex (* (magstep font-size) 0.8 baseline-skip)))
  85     (ly:make-stencil
  86      `(polygon '(0.0 0.0
  87                      ,ex 0.0
  88                      ,(* 0.5 ex)
  89                      ,(* 0.86 ex))
  90            ,thickness
  91            ,filled)
  92      (cons 0 ex)
  93      (cons 0 (* .86 ex)))))
  94
  95 (define-builtin-markup-command (circle layout props arg)
  96   (markup?)
  97   graphic
  98   ((thickness 1)
  99    (font-size 0)
 100    (circle-padding 0.2))
 101   "
 102 @cindex circling text
 103
 104 Draw a circle around @var{arg}.  Use @code{thickness},
 105 @code{circle-padding} and @code{font-size} properties to determine line
 106 thickness and padding around the markup.
 107
 108 @lilypond[verbatim,quote]
 109 \\markup {
 110   \\circle {
 111     Hi
 112   }
 113 }
 114 @end lilypond"
 115   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 116                thickness))
 117          (pad (* (magstep font-size) circle-padding))
 118          (m (interpret-markup layout props arg)))
 119     (circle-stencil m th pad)))
 120
 121 (define-builtin-markup-command (with-url layout props url arg)
 122   (string? markup?)
 123   graphic
 124   ()
 125   "
 126 @cindex inserting URL links into text
 127
 128 Add a link to URL @var{url} around @var{arg}.  This only works in
 129 the PDF backend.
 130
 131 @lilypond[verbatim,quote]
 132 \\markup {
 133   \\with-url #\"http://lilypond.org/web/\" {
 134     LilyPond ... \\italic {
 135       music notation for everyone
 136     }
 137   }
 138 }
 139 @end lilypond"
 140   (let* ((stil (interpret-markup layout props arg))
 141          (xextent (ly:stencil-extent stil X))
 142          (yextent (ly:stencil-extent stil Y))
 143          (old-expr (ly:stencil-expr stil))
 144          (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
 145
 146     (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
 147
 148 (define-builtin-markup-command (beam layout props width slope thickness)
 149   (number? number? number?)
 150   graphic
 151   ()
 152   "
 153 @cindex drawing beams within text
 154
 155 Create a beam with the specified parameters.
 156 @lilypond[verbatim,quote]
 157 \\markup {
 158   \\beam #5 #1 #2
 159 }
 160 @end lilypond"
 161   (let* ((y (* slope width))
 162          (yext (cons (min 0 y) (max 0 y)))
 163          (half (/ thickness 2)))
 164
 165     (ly:make-stencil
 166      `(polygon ',(list
 167                   0 (/ thickness -2)
 168                     width (+ (* width slope)  (/ thickness -2))
 169                     width (+ (* width slope)  (/ thickness 2))
 170                     0 (/ thickness 2))
 171                ,(ly:output-def-lookup layout 'blot-diameter)
 172                #t)
 173      (cons 0 width)
 174      (cons (+ (- half) (car yext))
 175            (+ half (cdr yext))))))
 176
 177 (define-builtin-markup-command (underline layout props arg)
 178   (markup?)
 179   font
 180   ((thickness 1))
 181   "
 182 @cindex underlining text
 183
 184 Underline @var{arg}.  Looks at @code{thickness} to determine line
 185 thickness and y offset.
 186
 187 @lilypond[verbatim,quote]
 188 \\markup {
 189   default
 190   \\hspace #2
 191   \\override #'(thickness . 2)
 192   \\underline {
 193     underline
 194   }
 195 }
 196 @end lilypond"
 197   (let* ((thick (* (ly:output-def-lookup layout 'line-thickness)
 198                    thickness))
 199          (markup (interpret-markup layout props arg))
 200          (x1 (car (ly:stencil-extent markup X)))
 201          (x2 (cdr (ly:stencil-extent markup X)))
 202          (y (* thick -2))
 203          (line (make-line-stencil thick x1 y x2 y)))
 204     (ly:stencil-add markup line)))
 205
 206 (define-builtin-markup-command (box layout props arg)
 207   (markup?)
 208   font
 209   ((thickness 1)
 210    (font-size 0)
 211    (box-padding 0.2))
 212   "
 213 @cindex enclosing text within a box
 214
 215 Draw a box round @var{arg}.  Looks at @code{thickness},
 216 @code{box-padding} and @code{font-size} properties to determine line
 217 thickness and padding around the markup.
 218
 219 @lilypond[verbatim,quote]
 220 \\markup {
 221   \\override #'(box-padding . 0.5)
 222   \\box
 223   \\line { V. S. }
 224 }
 225 @end lilypond"
 226   (let* ((th (* (ly:output-def-lookup layout 'line-thickness)
 227                 thickness))
 228          (pad (* (magstep font-size) box-padding))
 229          (m (interpret-markup layout props arg)))
 230     (box-stencil m th pad)))
 231
 232 (define-builtin-markup-command (filled-box layout props xext yext blot)
 233   (number-pair? number-pair? number?)
 234   graphic
 235   ()
 236   "
 237 @cindex drawing solid boxes within text
 238 @cindex drawing boxes with rounded corners
 239
 240 Draw a box with rounded corners of dimensions @var{xext} and
 241 @var{yext}.  For example,
 242 @verbatim
 243 \\filled-box #'(-.3 . 1.8) #'(-.3 . 1.8) #0
 244 @end verbatim
 245 creates a box extending horizontally from -0.3 to 1.8 and
 246 vertically from -0.3 up to 1.8, with corners formed from a
 247 circle of diameter@tie{}0 (i.e. sharp corners).
 248
 249 @lilypond[verbatim,quote]
 250 \\markup {
 251   \\filled-box #'(0 . 4) #'(0 . 4) #0
 252   \\filled-box #'(0 . 2) #'(-4 . 2) #0.4
 253   \\filled-box #'(1 . 8) #'(0 . 7) #0.2
 254   \\with-color #white
 255   \\filled-box #'(-4.5 . -2.5) #'(3.5 . 5.5) #0.7
 256 }
 257 @end lilypond"
 258   (ly:round-filled-box
 259    xext yext blot))
 260
 261 (define-builtin-markup-command (rounded-box layout props arg)
 262   (markup?)
 263   graphic
 264   ((thickness 1)
 265    (corner-radius 1)
 266    (font-size 0)
 267    (box-padding 0.5))
 268   "@cindex enclosing text in a box with rounded corners
 269    @cindex drawing boxes with rounded corners around text
 270 Draw a box with rounded corners around @var{arg}.  Looks at @code{thickness},
 271 @code{box-padding} and @code{font-size} properties to determine line
 272 thickness and padding around the markup; the @code{corner-radius} property
 273 makes it possible to define another shape for the corners (default is 1).
 274
 275 @lilypond[quote,verbatim,relative=2]
 276 c4^\\markup {
 277   \\rounded-box {
 278     Overtura
 279   }
 280 }
 281 c,8. c16 c4 r
 282 @end lilypond"
 283   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 284                thickness))
 285         (pad (* (magstep font-size) box-padding))
 286         (m (interpret-markup layout props arg)))
 287     (ly:stencil-add (rounded-box-stencil m th pad corner-radius)
 288                     m)))
 289
 290 (define-builtin-markup-command (rotate layout props ang arg)
 291   (number? markup?)
 292   align
 293   ()
 294   "
 295 @cindex rotating text
 296
 297 Rotate object with @var{ang} degrees around its center.
 298
 299 @lilypond[verbatim,quote]
 300 \\markup {
 301   default
 302   \\hspace #2
 303   \\rotate #45
 304   \\line {
 305     rotated 45°
 306   }
 307 }
 308 @end lilypond"
 309   (let* ((stil (interpret-markup layout props arg)))
 310     (ly:stencil-rotate stil ang 0 0)))
 311
 312 (define-builtin-markup-command (whiteout layout props arg)
 313   (markup?)
 314   other
 315   ()
 316   "
 317 @cindex adding a white background to text
 318
 319 Provide a white background for @var{arg}.
 320
 321 @lilypond[verbatim,quote]
 322 \\markup {
 323   \\combine
 324     \\filled-box #'(-1 . 10) #'(-3 . 4) #1
 325     \\whiteout whiteout
 326 }
 327 @end lilypond"
 328   (stencil-whiteout (interpret-markup layout props arg)))
 329
 330 (define-builtin-markup-command (pad-markup layout props padding arg)
 331   (number? markup?)
 332   align
 333   ()
 334   "
 335 @cindex padding text
 336 @cindex putting space around text
 337
 338 Add space around a markup object.
 339
 340 @lilypond[verbatim,quote]
 341 \\markup {
 342   \\box {
 343     default
 344   }
 345   \\hspace #2
 346   \\box {
 347     \\pad-around #1 {
 348       padded
 349     }
 350   }
 351 }
 352 @end lilypond"
 353   (let*
 354       ((stil (interpret-markup layout props arg))
 355        (xext (ly:stencil-extent stil X))
 356        (yext (ly:stencil-extent stil Y)))
 357
 358     (ly:make-stencil
 359      (ly:stencil-expr stil)
 360      (interval-widen xext padding)
 361      (interval-widen yext padding))))
 362
 363 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 364 ;; space
 365 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 366
 367 (define-builtin-markup-command (strut layout props)
 368   ()
 369   other
 370   ()
 371   "
 372 @cindex creating vertical spaces in text
 373
 374 Create a box of the same height as the space in the current font."
 375   (let ((m (ly:text-interface::interpret-markup layout props " ")))
 376     (ly:make-stencil (ly:stencil-expr m)
 377                      '(0 . 0)
 378                      (ly:stencil-extent m X)
 379                      )))
 380
 381 ;; todo: fix negative space
 382 (define-builtin-markup-command (hspace layout props amount)
 383   (number?)
 384   align
 385   ()
 386   "
 387 @cindex creating horizontal spaces in text
 388
 389 This produces an invisible object taking horizontal space.  For example,
 390
 391 @example
 392 \\markup @{ A \\hspace #2.0 B @}
 393 @end example
 394
 395 @noindent
 396 puts extra space between A and@tie{}B, on top of the space that is
 397 normally inserted before elements on a line.
 398
 399 @lilypond[verbatim,quote]
 400 \\markup {
 401   one
 402   \\hspace #2
 403   two
 404   \\hspace #8
 405   three
 406 }
 407 @end lilypond"
 408   (if (> amount 0)
 409       (ly:make-stencil "" (cons 0 amount) '(-1 . 1))
 410       (ly:make-stencil "" (cons amount amount) '(-1 . 1))))
 411
 412
 413 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 414 ;; importing graphics.
 415 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 416
 417 (define-builtin-markup-command (stencil layout props stil)
 418   (ly:stencil?)
 419   other
 420   ()
 421   "
 422 @cindex importing stencils into text
 423
 424 Use a stencil as markup.
 425
 426 @lilypond[verbatim,quote]
 427 \\markup {
 428   \\stencil #(make-circle-stencil 2 0 #t)
 429 }
 430 @end lilypond"
 431   stil)
 432
 433 (define bbox-regexp
 434   (make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
 435
 436 (define (get-postscript-bbox string)
 437   "Extract the bbox from STRING, or return #f if not present."
 438   (let*
 439       ((match (regexp-exec bbox-regexp string)))
 440
 441     (if match
 442         (map (lambda (x)
 443                (string->number (match:substring match x)))
 444              (cdr (iota 5)))
 445
 446         #f)))
 447
 448 (define-builtin-markup-command (epsfile layout props axis size file-name)
 449   (number? number? string?)
 450   graphic
 451   ()
 452   "
 453 @cindex inlining an Encapsulated PostScript image
 454
 455 Inline an EPS image.  The image is scaled along @var{axis} to
 456 @var{size}.
 457
 458 @lilypond[verbatim,quote]
 459 \\markup {
 460   \\general-align #Y #DOWN {
 461     \\epsfile #X #20 #\"context-example.eps\"
 462     \\epsfile #Y #20 #\"context-example.eps\"
 463   }
 464 }
 465 @end lilypond"
 466   (if (ly:get-option 'safe)
 467       (interpret-markup layout props "not allowed in safe")
 468       (eps-file->stencil axis size file-name)
 469       ))
 470
 471 (define-builtin-markup-command (postscript layout props str)
 472   (string?)
 473   graphic
 474   ()
 475   "
 476 @cindex inserting PostScript directly into text
 477
 478 This inserts @var{str} directly into the output as a PostScript
 479 command string.  Due to technicalities of the output backends,
 480 different scales should be used for the @TeX{} and PostScript backend,
 481 selected with @code{-f}.
 482
 483 For the @TeX{} backend, the following string prints a rotated text
 484
 485 @example
 486 0 0 moveto /ecrm10 findfont
 487 1.75 scalefont setfont 90 rotate (hello) show
 488 @end example
 489
 490 @noindent
 491 The magical constant 1.75 scales from LilyPond units (staff spaces) to
 492 @TeX{} dimensions.
 493
 494 For the postscript backend, use the following
 495
 496 @example
 497 gsave /ecrm10 findfont
 498  10.0 output-scale div
 499  scalefont setfont 90 rotate (hello) show grestore
 500 @end example
 501
 502 @lilypond[verbatim,quote]
 503 eyeglassesps = #\"
 504   0.15 setlinewidth
 505   -0.9 0 translate
 506   1.1 1.1 scale
 507   1.2 0.7 moveto
 508   0.7 0.7 0.5 0 361 arc
 509   stroke
 510   2.20 0.70 0.50 0 361 arc
 511   stroke
 512   1.45 0.85 0.30 0 180 arc
 513   stroke
 514   0.20 0.70 moveto
 515   0.80 2.00 lineto
 516   0.92 2.26 1.30 2.40 1.15 1.70 curveto
 517   stroke
 518   2.70 0.70 moveto
 519   3.30 2.00 lineto
 520   3.42 2.26 3.80 2.40 3.65 1.70 curveto
 521   stroke\"
 522
 523 eyeglasses = \\markup {
 524   \\with-dimensions #'(0 . 4.4) #'(0 . 2.5)
 525   \\postscript #eyeglassesps
 526 }
 527
 528 \\relative c'' {
 529   c2^\\eyeglasses
 530   a2_\\eyeglasses
 531 }
 532 @end lilypond"
 533   ;; FIXME
 534   (ly:make-stencil
 535    (list 'embedded-ps
 536          (format "
 537 gsave currentpoint translate
 538 0.1 setlinewidth
 539  ~a
 540 grestore
 541 "
 542                  str))
 543    '(0 . 0) '(0 . 0)))
 544
 545 (define-builtin-markup-command (score layout props score)
 546   (ly:score?)
 547   music
 548   ()
 549   "
 550 @cindex inserting music into text
 551
 552 Inline an image of music.
 553
 554 @lilypond[verbatim,quote]
 555 \\markup {
 556   \\score {
 557     \\new PianoStaff <<
 558       \\new Staff \\relative c' {
 559         \\key f \\major
 560         \\time 3/4
 561         \\mark \\markup { Allegro }
 562         f2\\p( a4)
 563         c2( a4)
 564         bes2( g'4)
 565         f8( e) e4 r
 566       }
 567       \\new Staff \\relative c {
 568         \\clef bass
 569         \\key f \\major
 570         \\time 3/4
 571         f8( a c a c a
 572         f c' es c es c)
 573         f,( bes d bes d bes)
 574         f( g bes g bes g)
 575       }
 576     >>
 577     \\layout {
 578       indent = 0.0\\cm
 579       \\context {
 580         \\Score
 581         \\override RehearsalMark #'break-align-symbols =
 582           #'(time-signature key-signature)
 583         \\override RehearsalMark #'self-alignment-X = #LEFT
 584       }
 585       \\context {
 586         \\Staff
 587         \\override TimeSignature #'break-align-anchor-alignment = #LEFT
 588       }
 589     }
 590   }
 591 }
 592 @end lilypond"
 593   (let* ((output (ly:score-embedded-format score layout)))
 594
 595     (if (ly:music-output? output)
 596         (paper-system-stencil
 597          (vector-ref (ly:paper-score-paper-systems output) 0))
 598         (begin
 599           (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
 600           empty-stencil))))
 601
 602 (define-builtin-markup-command (null layout props)
 603   ()
 604   other
 605   ()
 606   "
 607 @cindex creating empty text objects
 608
 609 An empty markup with extents of a single point.
 610
 611 @lilypond[verbatim,quote]
 612 \\markup {
 613   \\null
 614 }
 615 @end lilypond"
 616   point-stencil)
 617
 618 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 619 ;; basic formatting.
 620 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 621
 622 (define-builtin-markup-command (simple layout props str)
 623   (string?)
 624   font
 625   ()
 626   "
 627 @cindex simple text strings
 628
 629 A simple text string; @code{\\markup @{ foo @}} is equivalent with
 630 @code{\\markup @{ \\simple #\"foo\" @}}.
 631
 632 Note: for creating standard text markup or defining new markup commands,
 633 the use of @code{\\simple} is unnecessary.
 634
 635 @lilypond[verbatim,quote]
 636 \\markup {
 637   \\simple #\"simple\"
 638   \\simple #\"text\"
 639   \\simple #\"strings\"
 640 }
 641 @end lilypond"
 642   (interpret-markup layout props str))
 643
 644 (define-builtin-markup-command (tied-lyric layout props str)
 645   (string?)
 646   music
 647   ()
 648   "
 649 @cindex simple text strings with tie characters
 650
 651 Like simple-markup, but use tie characters for @q{~} tilde symbols.
 652
 653 @lilypond[verbatim,quote]
 654 \\markup {
 655   \\tied-lyric #\"Lasciate~i monti\"
 656 }
 657 @end lilypond"
 658   (if (string-contains str "~")
 659       (let*
 660           ((parts (string-split str #\~))
 661            (tie-str (ly:wide-char->utf-8 #x203f))
 662            (joined  (list-join parts tie-str))
 663            (join-stencil (interpret-markup layout props tie-str))
 664            )
 665
 666         (interpret-markup layout
 667                           (prepend-alist-chain
 668                            'word-space
 669                            (/ (interval-length (ly:stencil-extent join-stencil X)) -3.5)
 670                            props)
 671                           (make-line-markup joined)))
 672                            ;(map (lambda (s) (interpret-markup layout props s)) parts))
 673       (interpret-markup layout props str)))
 674
 675 (define-public empty-markup
 676   (make-simple-markup ""))
 677
 678 ;; helper for justifying lines.
 679 (define (get-fill-space word-count line-width text-widths)
 680   "Calculate the necessary paddings between each two adjacent texts.
 681         The lengths of all texts are stored in @var{text-widths}.
 682         The normal formula for the padding between texts a and b is:
 683         padding = line-width/(word-count - 1) - (length(a) + length(b))/2
 684         The first and last padding have to be calculated specially using the
 685         whole length of the first or last text.
 686         Return a list of paddings."
 687   (cond
 688    ((null? text-widths) '())
 689
 690    ;; special case first padding
 691    ((= (length text-widths) word-count)
 692     (cons
 693      (- (- (/ line-width (1- word-count)) (car text-widths))
 694         (/ (car (cdr text-widths)) 2))
 695      (get-fill-space word-count line-width (cdr text-widths))))
 696    ;; special case last padding
 697    ((= (length text-widths) 2)
 698     (list (- (/ line-width (1- word-count))
 699              (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
 700    (else
 701     (cons
 702      (- (/ line-width (1- word-count))
 703         (/ (+ (car text-widths) (car (cdr text-widths))) 2))
 704      (get-fill-space word-count line-width (cdr text-widths))))))
 705
 706 (define-builtin-markup-command (fill-line layout props markups)
 707   (markup-list?)
 708   align
 709   ((text-direction RIGHT)
 710    (word-space 1)
 711    (line-width #f))
 712   "Put @var{markups} in a horizontal line of width @var{line-width}.
 713 The markups are spaced or flushed to fill the entire line.
 714 If there are no arguments, return an empty stencil.
 715
 716 @lilypond[verbatim,quote]
 717 \\markup {
 718   \\column {
 719     \\fill-line {
 720       Words evenly spaced across the page
 721     }
 722     \\null
 723     \\fill-line {
 724       \\line { Text markups }
 725       \\line {
 726         \\italic { evenly spaced }
 727       }
 728       \\line { across the page }
 729     }
 730   }
 731 }
 732 @end lilypond"
 733   (let* ((orig-stencils (interpret-markup-list layout props markups))
 734          (stencils
 735           (map (lambda (stc)
 736                  (if (ly:stencil-empty? stc)
 737                      point-stencil
 738                      stc)) orig-stencils))
 739          (text-widths
 740           (map (lambda (stc)
 741                  (if (ly:stencil-empty? stc)
 742                      0.0
 743                      (interval-length (ly:stencil-extent stc X))))
 744                stencils))
 745          (text-width (apply + text-widths))
 746          (word-count (length stencils))
 747          (prop-line-width (chain-assoc-get 'line-width props #f))
 748          (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
 749          (fill-space
 750                 (cond
 751                         ((= word-count 1)
 752                                 (list
 753                                         (/ (- line-width text-width) 2)
 754                                         (/ (- line-width text-width) 2)))
 755                         ((= word-count 2)
 756                                 (list
 757                                         (- line-width text-width)))
 758                         (else
 759                                 (get-fill-space word-count line-width text-widths))))
 760          (fill-space-normal
 761           (map (lambda (x)
 762                  (if (< x word-space)
 763                      word-space
 764                      x))
 765                fill-space))
 766
 767          (line-stencils (if (= word-count 1)
 768                             (list
 769                              point-stencil
 770                              (car stencils)
 771                              point-stencil)
 772                             stencils)))
 773
 774     (if (= text-direction LEFT)
 775         (set! line-stencils (reverse line-stencils)))
 776
 777     (if (null? (remove ly:stencil-empty? orig-stencils))
 778         empty-stencil
 779         (stack-stencils-padding-list X
 780                                      RIGHT fill-space-normal line-stencils))))
 781
 782 (define-builtin-markup-command (line layout props args)
 783   (markup-list?)
 784   align
 785   ((word-space)
 786    (text-direction RIGHT))
 787   "Put @var{args} in a horizontal line.  The property @code{word-space}
 788 determines the space between each markup in @var{args}.
 789
 790 @lilypond[verbatim,quote]
 791 \\markup {
 792   \\line {
 793     one two three
 794   }
 795 }
 796 @end lilypond"
 797   (let ((stencils (interpret-markup-list layout props args)))
 798     (if (= text-direction LEFT)
 799         (set! stencils (reverse stencils)))
 800     (stack-stencil-line
 801      word-space
 802      (remove ly:stencil-empty? stencils))))
 803
 804 (define-builtin-markup-command (concat layout props args)
 805   (markup-list?)
 806   align
 807   ()
 808   "
 809 @cindex concatenating text
 810 @cindex ligatures in text
 811
 812 Concatenate @var{args} in a horizontal line, without spaces inbetween.
 813 Strings and simple markups are concatenated on the input level, allowing
 814 ligatures.  For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is
 815 equivalent to @code{\"fi\"}.
 816
 817 @lilypond[verbatim,quote]
 818 \\markup {
 819   \\concat {
 820     one
 821     two
 822     three
 823   }
 824 }
 825 @end lilypond"
 826   (define (concat-string-args arg-list)
 827     (fold-right (lambda (arg result-list)
 828                   (let ((result (if (pair? result-list)
 829                                     (car result-list)
 830                                   '())))
 831                     (if (and (pair? arg) (eqv? (car arg) simple-markup))
 832                       (set! arg (cadr arg)))
 833                     (if (and (string? result) (string? arg))
 834                         (cons (string-append arg result) (cdr result-list))
 835                       (cons arg result-list))))
 836                 '()
 837                 arg-list))
 838
 839   (interpret-markup layout
 840                     (prepend-alist-chain 'word-space 0 props)
 841                     (make-line-markup (if (markup-command-list? args)
 842                                           args
 843                                           (concat-string-args args)))))
 844
 845 (define (wordwrap-stencils stencils
 846                            justify base-space line-width text-dir)
 847   "Perform simple wordwrap, return stencil of each line."
 848   (define space (if justify
 849                     ;; justify only stretches lines.
 850                     (* 0.7 base-space)
 851                     base-space))
 852   (define (take-list width space stencils
 853                      accumulator accumulated-width)
 854     "Return (head-list . tail) pair, with head-list fitting into width"
 855     (if (null? stencils)
 856         (cons accumulator stencils)
 857         (let* ((first (car stencils))
 858                (first-wid (cdr (ly:stencil-extent (car stencils) X)))
 859                (newwid (+ space first-wid accumulated-width)))
 860           (if (or (null? accumulator)
 861                   (< newwid width))
 862               (take-list width space
 863                          (cdr stencils)
 864                          (cons first accumulator)
 865                          newwid)
 866               (cons accumulator stencils)))))
 867   (let loop ((lines '())
 868              (todo stencils))
 869     (let* ((line-break (take-list line-width space todo
 870                                   '() 0.0))
 871            (line-stencils (car line-break))
 872            (space-left (- line-width
 873                           (apply + (map (lambda (x) (cdr (ly:stencil-extent x X)))
 874                                         line-stencils))))
 875            (line-word-space (cond ((not justify) space)
 876                                   ;; don't stretch last line of paragraph.
 877                                   ;; hmmm . bug - will overstretch the last line in some case.
 878                                   ((null? (cdr line-break))
 879                                    base-space)
 880                                   ((null? line-stencils) 0.0)
 881                                   ((null? (cdr line-stencils)) 0.0)
 882                                   (else (/ space-left (1- (length line-stencils))))))
 883            (line (stack-stencil-line line-word-space
 884                                      (if (= text-dir RIGHT)
 885                                          (reverse line-stencils)
 886                                          line-stencils))))
 887       (if (pair? (cdr line-break))
 888           (loop (cons line lines)
 889                 (cdr line-break))
 890           (begin
 891             (if (= text-dir LEFT)
 892                 (set! line
 893                       (ly:stencil-translate-axis
 894                        line
 895                        (- line-width (interval-end (ly:stencil-extent line X)))
 896                        X)))
 897             (reverse (cons line lines)))))))
 898
 899 (define-builtin-markup-list-command (wordwrap-internal layout props justify args)
 900   (boolean? markup-list?)
 901   ((line-width #f)
 902    (word-space)
 903    (text-direction RIGHT))
 904   "Internal markup list command used to define @code{\\justify} and @code{\\wordwrap}."
 905   (wordwrap-stencils (remove ly:stencil-empty?
 906                              (interpret-markup-list layout props args))
 907                      justify
 908                      word-space
 909                      (or line-width
 910                          (ly:output-def-lookup layout 'line-width))
 911                      text-direction))
 912
 913 (define-builtin-markup-command (justify layout props args)
 914   (markup-list?)
 915   align
 916   ((baseline-skip)
 917    wordwrap-internal-markup-list)
 918   "
 919 @cindex justifying text
 920
 921 Like wordwrap, but with lines stretched to justify the margins.
 922 Use @code{\\override #'(line-width . @var{X})} to set the line width;
 923 @var{X}@tie{}is the number of staff spaces.
 924
 925 @lilypond[verbatim,quote]
 926 \\markup {
 927   \\justify {
 928     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
 929     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
 930     Ut enim ad minim veniam, quis nostrud exercitation ullamco
 931     laboris nisi ut aliquip ex ea commodo consequat.
 932   }
 933 }
 934 @end lilypond"
 935   (stack-lines DOWN 0.0 baseline-skip
 936                (wordwrap-internal-markup-list layout props #t args)))
 937
 938 (define-builtin-markup-command (wordwrap layout props args)
 939   (markup-list?)
 940   align
 941   ((baseline-skip)
 942    wordwrap-internal-markup-list)
 943   "Simple wordwrap.  Use @code{\\override #'(line-width . @var{X})} to set
 944 the line width, where @var{X} is the number of staff spaces.
 945
 946 @lilypond[verbatim,quote]
 947 \\markup {
 948   \\wordwrap {
 949     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
 950     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
 951     Ut enim ad minim veniam, quis nostrud exercitation ullamco
 952     laboris nisi ut aliquip ex ea commodo consequat.
 953   }
 954 }
 955 @end lilypond"
 956   (stack-lines DOWN 0.0 baseline-skip
 957                (wordwrap-internal-markup-list layout props #f args)))
 958
 959 (define-builtin-markup-list-command (wordwrap-string-internal layout props justify arg)
 960   (boolean? string?)
 961   ((line-width)
 962    (word-space)
 963    (text-direction RIGHT))
 964   "Internal markup list command used to define @code{\\justify-string} and
 965 @code{\\wordwrap-string}."
 966   (let* ((para-strings (regexp-split
 967                         (string-regexp-substitute
 968                          "\r" "\n"
 969                          (string-regexp-substitute "\r\n" "\n" arg))
 970                         "\n[ \t\n]*\n[ \t\n]*"))
 971          (list-para-words (map (lambda (str)
 972                                  (regexp-split str "[ \t\n]+"))
 973                                para-strings))
 974          (para-lines (map (lambda (words)
 975                             (let* ((stencils
 976                                     (remove ly:stencil-empty?
 977                                             (map (lambda (x)
 978                                                    (interpret-markup layout props x))
 979                                                  words))))
 980                               (wordwrap-stencils stencils
 981                                                  justify word-space
 982                                                  line-width text-direction)))
 983                           list-para-words)))
 984     (apply append para-lines)))
 985
 986 (define-builtin-markup-command (wordwrap-string layout props arg)
 987   (string?)
 988   align
 989   ((baseline-skip)
 990    wordwrap-string-internal-markup-list)
 991   "Wordwrap a string.  Paragraphs may be separated with double newlines.
 992
 993 @lilypond[verbatim,quote]
 994 \\markup {
 995   \\override #'(line-width . 40)
 996   \\wordwrap-string #\"Lorem ipsum dolor sit amet, consectetur
 997     adipisicing elit, sed do eiusmod tempor incididunt ut labore
 998     et dolore magna aliqua.
 999
1000
1001     Ut enim ad minim veniam, quis nostrud exercitation ullamco
1002     laboris nisi ut aliquip ex ea commodo consequat.
1003
1004
1005     Excepteur sint occaecat cupidatat non proident, sunt in culpa
1006     qui officia deserunt mollit anim id est laborum\"
1007 }
1008 @end lilypond"
1009   (stack-lines DOWN 0.0 baseline-skip
1010                (wordwrap-string-internal-markup-list layout props #f arg)))
1011
1012 (define-builtin-markup-command (justify-string layout props arg)
1013   (string?)
1014   align
1015   ((baseline-skip)
1016    wordwrap-string-internal-markup-list)
1017   "Justify a string.  Paragraphs may be separated with double newlines
1018
1019 @lilypond[verbatim,quote]
1020 \\markup {
1021   \\override #'(line-width . 40)
1022   \\justify-string #\"Lorem ipsum dolor sit amet, consectetur
1023     adipisicing elit, sed do eiusmod tempor incididunt ut labore
1024     et dolore magna aliqua.
1025
1026
1027     Ut enim ad minim veniam, quis nostrud exercitation ullamco
1028     laboris nisi ut aliquip ex ea commodo consequat.
1029
1030
1031     Excepteur sint occaecat cupidatat non proident, sunt in culpa
1032     qui officia deserunt mollit anim id est laborum\"
1033 }
1034 @end lilypond"
1035   (stack-lines DOWN 0.0 baseline-skip
1036                (wordwrap-string-internal-markup-list layout props #t arg)))
1037
1038 (define-builtin-markup-command (wordwrap-field layout props symbol)
1039   (symbol?)
1040   align
1041   ()
1042   "Wordwrap the data which has been assigned to @var{symbol}.
1043
1044 @lilypond[verbatim,quote]
1045 \\header {
1046   title = \"My title\"
1047   descr = \"Lorem ipsum dolor sit amet, consectetur adipisicing elit,
1048   sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.
1049   Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris
1050   nisi ut aliquip ex ea commodo consequat.\"
1051 }
1052
1053 \\paper {
1054   bookTitleMarkup = \\markup {
1055     \\column {
1056       \\fill-line { \\fromproperty #'header:title }
1057       \\null
1058       \\wordwrap-field #'header:descr
1059     }
1060   }
1061 }
1062
1063 \\markup {
1064   \\null
1065 }
1066 @end lilypond"
1067   (let* ((m (chain-assoc-get symbol props)))
1068     (if (string? m)
1069         (wordwrap-string-markup layout props m)
1070         empty-stencil)))
1071
1072 (define-builtin-markup-command (justify-field layout props symbol)
1073   (symbol?)
1074   align
1075   ()
1076   "Justify the data which has been assigned to @var{symbol}.
1077
1078 @lilypond[verbatim,quote]
1079 \\header {
1080   title = \"My title\"
1081   descr = \"Lorem ipsum dolor sit amet, consectetur adipisicing elit,
1082   sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.
1083   Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris
1084   nisi ut aliquip ex ea commodo consequat.\"
1085 }
1086
1087 \\paper {
1088   bookTitleMarkup = \\markup {
1089     \\column {
1090       \\fill-line { \\fromproperty #'header:title }
1091       \\null
1092       \\justify-field #'header:descr
1093     }
1094   }
1095 }
1096
1097 \\markup {
1098   \\null
1099 }
1100 @end lilypond"
1101   (let* ((m (chain-assoc-get symbol props)))
1102     (if (string? m)
1103         (justify-string-markup layout props m)
1104         empty-stencil)))
1105
1106 (define-builtin-markup-command (combine layout props m1 m2)
1107   (markup? markup?)
1108   align
1109   ()
1110   "
1111 @cindex merging text
1112
1113 Print two markups on top of each other.
1114
1115 Note: @code{\\combine} cannot take a list of markups enclosed in
1116 curly braces as an argument; the follow example will not compile:
1117
1118 @example
1119 \\combine @{ a list @}
1120 @end example
1121
1122 @lilypond[verbatim,quote]
1123 \\markup {
1124   \\fontsize #5
1125   \\override #'(thickness . 2)
1126   \\combine
1127     \\draw-line #'(0 . 4)
1128     \\arrow-head #Y #DOWN ##f
1129 }
1130 @end lilypond"
1131   (let* ((s1 (interpret-markup layout props m1))
1132          (s2 (interpret-markup layout props m2)))
1133     (ly:stencil-add s1 s2)))
1134
1135 ;;
1136 ;; TODO: should extract baseline-skip from each argument somehow..
1137 ;;
1138 (define-builtin-markup-command (column layout props args)
1139   (markup-list?)
1140   align
1141   ((baseline-skip))
1142   "
1143 @cindex stacking text in a column
1144
1145 Stack the markups in @var{args} vertically.  The property
1146 @code{baseline-skip} determines the space between each
1147 markup in @var{args}.
1148
1149 @lilypond[verbatim,quote]
1150 \\markup {
1151   \\column {
1152     one
1153     two
1154     three
1155   }
1156 }
1157 @end lilypond"
1158   (let ((arg-stencils (interpret-markup-list layout props args)))
1159     (stack-lines -1 0.0 baseline-skip
1160                  (remove ly:stencil-empty? arg-stencils))))
1161
1162 (define-builtin-markup-command (dir-column layout props args)
1163   (markup-list?)
1164   align
1165   ((direction)
1166    (baseline-skip))
1167   "
1168 @cindex changing direction of text columns
1169
1170 Make a column of args, going up or down, depending on the setting
1171 of the @code{#'direction} layout property.
1172
1173 @lilypond[verbatim,quote]
1174 \\markup {
1175   \\override #'(direction . 1) {
1176     \\dir-column {
1177       going up
1178     }
1179   }
1180   \\dir-column {
1181     going down
1182   }
1183 }
1184 @end lilypond"
1185   (stack-lines (if (number? direction) direction -1)
1186                0.0
1187                baseline-skip
1188                (interpret-markup-list layout props args)))
1189
1190 (define (general-column align-dir baseline mols)
1191   "Stack @var{mols} vertically, aligned to  @var{align-dir} horizontally."
1192
1193   (let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols)))
1194     (stack-lines -1 0.0 baseline aligned-mols)))
1195
1196 (define-builtin-markup-command (center-column layout props args)
1197   (markup-list?)
1198   align
1199   ((baseline-skip))
1200   "
1201 @cindex centering a column of text
1202
1203 Put @code{args} in a centered column.
1204
1205 @lilypond[verbatim,quote]
1206 \\markup {
1207   \\center-column {
1208     one
1209     two
1210     three
1211   }
1212 }
1213 @end lilypond"
1214   (general-column CENTER baseline-skip (interpret-markup-list layout props args)))
1215
1216 (define-builtin-markup-command (left-column layout props args)
1217   (markup-list?)
1218   align
1219   ((baseline-skip))
1220  "
1221 @cindex text columns, left-aligned
1222
1223 Put @code{args} in a left-aligned column.
1224
1225 @lilypond[verbatim,quote]
1226 \\markup {
1227   \\left-column {
1228     one
1229     two
1230     three
1231   }
1232 }
1233 @end lilypond"
1234   (general-column LEFT baseline-skip (interpret-markup-list layout props args)))
1235
1236 (define-builtin-markup-command (right-column layout props args)
1237   (markup-list?)
1238   align
1239   ((baseline-skip))
1240  "
1241 @cindex text columns, right-aligned
1242
1243 Put @code{args} in a right-aligned column.
1244
1245 @lilypond[verbatim,quote]
1246 \\markup {
1247   \\right-column {
1248     one
1249     two
1250     three
1251   }
1252 }
1253 @end lilypond"
1254   (general-column RIGHT baseline-skip (interpret-markup-list layout props args)))
1255
1256 (define-builtin-markup-command (vcenter layout props arg)
1257   (markup?)
1258   align
1259   ()
1260   "
1261 @cindex vertically centering text
1262
1263 Align @code{arg} to its Y@tie{}center.
1264
1265 @lilypond[verbatim,quote]
1266 \\markup {
1267   one
1268   \\vcenter
1269   two
1270   three
1271 }
1272 @end lilypond"
1273   (let* ((mol (interpret-markup layout props arg)))
1274     (ly:stencil-aligned-to mol Y CENTER)))
1275
1276 (define-builtin-markup-command (center-align layout props arg)
1277   (markup?)
1278   align
1279   ()
1280   "
1281 @cindex horizontally centering text
1282
1283 Align @code{arg} to its X@tie{}center.
1284
1285 @lilypond[verbatim,quote]
1286 \\markup {
1287   \\column {
1288     one
1289     \\center-align
1290     two
1291     three
1292   }
1293 }
1294 @end lilypond"
1295   (let* ((mol (interpret-markup layout props arg)))
1296     (ly:stencil-aligned-to mol X CENTER)))
1297
1298 (define-builtin-markup-command (right-align layout props arg)
1299   (markup?)
1300   align
1301   ()
1302   "
1303 @cindex right aligning text
1304
1305 Align @var{arg} on its right edge.
1306
1307 @lilypond[verbatim,quote]
1308 \\markup {
1309   \\column {
1310     one
1311     \\right-align
1312     two
1313     three
1314   }
1315 }
1316 @end lilypond"
1317   (let* ((m (interpret-markup layout props arg)))
1318     (ly:stencil-aligned-to m X RIGHT)))
1319
1320 (define-builtin-markup-command (left-align layout props arg)
1321   (markup?)
1322   align
1323   ()
1324   "
1325 @cindex left aligning text
1326
1327 Align @var{arg} on its left edge.
1328
1329 @lilypond[verbatim,quote]
1330 \\markup {
1331   \\column {
1332     one
1333     \\left-align
1334     two
1335     three
1336   }
1337 }
1338 @end lilypond"
1339   (let* ((m (interpret-markup layout props arg)))
1340     (ly:stencil-aligned-to m X LEFT)))
1341
1342 (define-builtin-markup-command (general-align layout props axis dir arg)
1343   (integer? number? markup?)
1344   align
1345   ()
1346   "
1347 @cindex controlling general text alignment
1348
1349 Align @var{arg} in @var{axis} direction to the @var{dir} side.
1350
1351 @lilypond[verbatim,quote]
1352 \\markup {
1353   \\column {
1354     one
1355     \\general-align #X #LEFT
1356     two
1357     three
1358     \\null
1359     one
1360     \\general-align #X #CENTER
1361     two
1362     three
1363     \\null
1364     \\line {
1365       one
1366       \\general-align #Y #UP
1367       two
1368       three
1369     }
1370     \\null
1371     \\line {
1372       one
1373       \\general-align #Y #3.2
1374       two
1375       three
1376     }
1377   }
1378 }
1379 @end lilypond"
1380   (let* ((m (interpret-markup layout props arg)))
1381     (ly:stencil-aligned-to m axis dir)))
1382
1383 (define-builtin-markup-command (halign layout props dir arg)
1384   (number? markup?)
1385   align
1386   ()
1387   "
1388 @cindex setting horizontal text alignment
1389
1390 Set horizontal alignment.  If @var{dir} is @code{-1}, then it is
1391 left-aligned, while @code{+1} is right.  Values in between interpolate
1392 alignment accordingly.
1393
1394 @lilypond[verbatim,quote]
1395 \\markup {
1396   \\column {
1397     one
1398     \\halign #LEFT
1399     two
1400     three
1401     \\null
1402     one
1403     \\halign #CENTER
1404     two
1405     three
1406     \\null
1407     one
1408     \\halign #RIGHT
1409     two
1410     three
1411     \\null
1412     one
1413     \\halign #-5
1414     two
1415     three
1416   }
1417 }
1418 @end lilypond"
1419   (let* ((m (interpret-markup layout props arg)))
1420     (ly:stencil-aligned-to m X dir)))
1421
1422 (define-builtin-markup-command (with-dimensions layout props x y arg)
1423   (number-pair? number-pair? markup?)
1424   other
1425   ()
1426   "
1427 @cindex setting extent of text objects
1428
1429 Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}."
1430   (let* ((m (interpret-markup layout props arg)))
1431     (ly:make-stencil (ly:stencil-expr m) x y)))
1432
1433 (define-builtin-markup-command (pad-around layout props amount arg)
1434   (number? markup?)
1435   align
1436   ()
1437   "Add padding @var{amount} all around @var{arg}.
1438
1439 @lilypond[verbatim,quote]
1440 \\markup {
1441   \\box {
1442     default
1443   }
1444   \\hspace #2
1445   \\box {
1446     \\pad-around #0.5 {
1447       padded
1448     }
1449   }
1450 }
1451 @end lilypond"
1452   (let* ((m (interpret-markup layout props arg))
1453          (x (ly:stencil-extent m X))
1454          (y (ly:stencil-extent m Y)))
1455     (ly:make-stencil (ly:stencil-expr m)
1456                      (interval-widen x amount)
1457                      (interval-widen y amount))))
1458
1459 (define-builtin-markup-command (pad-x layout props amount arg)
1460   (number? markup?)
1461   align
1462   ()
1463   "
1464 @cindex padding text horizontally
1465
1466 Add padding @var{amount} around @var{arg} in the X@tie{}direction.
1467
1468 @lilypond[verbatim,quote]
1469 \\markup {
1470   \\box {
1471     default
1472   }
1473   \\hspace #4
1474   \\box {
1475     \\pad-x #2 {
1476       padded
1477     }
1478   }
1479 }
1480 @end lilypond"
1481   (let* ((m (interpret-markup layout props arg))
1482          (x (ly:stencil-extent m X))
1483          (y (ly:stencil-extent m Y)))
1484     (ly:make-stencil (ly:stencil-expr m)
1485                      (interval-widen x amount)
1486                      y)))
1487
1488 (define-builtin-markup-command (put-adjacent layout props axis dir arg1 arg2)
1489   (integer? ly:dir? markup? markup?)
1490   align
1491   ()
1492   "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}."
1493   (let ((m1 (interpret-markup layout props arg1))
1494         (m2 (interpret-markup layout props arg2)))
1495     (ly:stencil-combine-at-edge m1 axis dir m2 0.0)))
1496
1497 (define-builtin-markup-command (transparent layout props arg)
1498   (markup?)
1499   other
1500   ()
1501   "Make the argument transparent.
1502
1503 @lilypond[verbatim,quote]
1504 \\markup {
1505   \\transparent {
1506     invisible text
1507   }
1508 }
1509 @end lilypond"
1510   (let* ((m (interpret-markup layout props arg))
1511          (x (ly:stencil-extent m X))
1512          (y (ly:stencil-extent m Y)))
1513     (ly:make-stencil "" x y)))
1514
1515 (define-builtin-markup-command (pad-to-box layout props x-ext y-ext arg)
1516   (number-pair? number-pair? markup?)
1517   align
1518   ()
1519   "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space.
1520
1521 @lilypond[verbatim,quote]
1522 \\markup {
1523   \\box {
1524     default
1525   }
1526   \\hspace #4
1527   \\box {
1528     \\pad-to-box #'(0 . 10) #'(0 . 3) {
1529       padded
1530     }
1531   }
1532 }
1533 @end lilypond"
1534   (let* ((m (interpret-markup layout props arg))
1535          (x (ly:stencil-extent m X))
1536          (y (ly:stencil-extent m Y)))
1537     (ly:make-stencil (ly:stencil-expr m)
1538                      (interval-union x-ext x)
1539                      (interval-union y-ext y))))
1540
1541 (define-builtin-markup-command (hcenter-in layout props length arg)
1542   (number? markup?)
1543   align
1544   ()
1545   "Center @var{arg} horizontally within a box of extending
1546 @var{length}/2 to the left and right.
1547
1548 @lilypond[quote,verbatim]
1549 \\new StaffGroup <<
1550   \\new Staff {
1551     \\set Staff.instrumentName = \\markup {
1552       \\hcenter-in #12
1553       Oboe
1554     }
1555     c''1
1556   }
1557   \\new Staff {
1558     \\set Staff.instrumentName = \\markup {
1559       \\hcenter-in #12
1560       Bassoon
1561     }
1562     \\clef tenor
1563     c'1
1564   }
1565 >>
1566 @end lilypond"
1567   (interpret-markup layout props
1568                     (make-pad-to-box-markup
1569                      (cons (/ length -2) (/ length 2))
1570                      '(0 . 0)
1571                      (make-center-align-markup arg))))
1572
1573 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1574 ;; property
1575 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1576
1577 (define-builtin-markup-command (fromproperty layout props symbol)
1578   (symbol?)
1579   other
1580   ()
1581   "Read the @var{symbol} from property settings, and produce a stencil
1582 from the markup contained within.  If @var{symbol} is not defined, it
1583 returns an empty markup.
1584
1585 @lilypond[verbatim,quote]
1586 \\header {
1587   myTitle = \"myTitle\"
1588   title = \\markup {
1589     from
1590     \\italic
1591     \\fromproperty #'header:myTitle
1592   }
1593 }
1594 \\markup {
1595   \\null
1596 }
1597 @end lilypond"
1598   (let ((m (chain-assoc-get symbol props)))
1599     (if (markup? m)
1600         (interpret-markup layout props m)
1601         empty-stencil)))
1602
1603 (define-builtin-markup-command (on-the-fly layout props procedure arg)
1604   (symbol? markup?)
1605   other
1606   ()
1607   "Apply the @var{procedure} markup command to @var{arg}.
1608 @var{procedure} should take a single argument."
1609   (let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
1610     (set-object-property! anonymous-with-signature
1611                           'markup-signature
1612                           (list markup?))
1613     (interpret-markup layout props (list anonymous-with-signature arg))))
1614
1615 (define-builtin-markup-command (override layout props new-prop arg)
1616   (pair? markup?)
1617   other
1618   ()
1619   "
1620 @cindex overriding properties within text markup
1621
1622 Add the first argument in to the property list.  Properties may be
1623 any sort of property supported by @rinternals{font-interface} and
1624 @rinternals{text-interface}, for example
1625
1626 @example
1627 \\override #'(font-family . married) \"bla\"
1628 @end example
1629
1630 @lilypond[verbatim,quote]
1631 \\markup {
1632   \\line {
1633     \\column {
1634       default
1635       baseline-skip
1636     }
1637     \\hspace #2
1638     \\override #'(baseline-skip . 4) {
1639       \\column {
1640         increased
1641         baseline-skip
1642       }
1643     }
1644   }
1645 }
1646 @end lilypond"
1647   (interpret-markup layout (cons (list new-prop) props) arg))
1648
1649 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1650 ;; files
1651 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1652
1653 (define-builtin-markup-command (verbatim-file layout props name)
1654   (string?)
1655   other
1656   ()
1657   "Read the contents of a file, and include it verbatim.
1658
1659 @lilypond[verbatim,quote]
1660 \\markup {
1661   \\verbatim-file #\"simple.ly\"
1662 }
1663 @end lilypond"
1664   (interpret-markup layout props
1665                     (if  (ly:get-option 'safe)
1666                          "verbatim-file disabled in safe mode"
1667                          (let* ((str (ly:gulp-file name))
1668                                 (lines (string-split str #\nl)))
1669                            (make-typewriter-markup
1670                             (make-column-markup lines))))))
1671
1672 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1673 ;; fonts.
1674 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1675
1676 (define-builtin-markup-command (bigger layout props arg)
1677   (markup?)
1678   font
1679   ()
1680   "Increase the font size relative to current setting.
1681
1682 @lilypond[verbatim,quote]
1683 \\markup {
1684   \\huge {
1685     huge
1686     \\hspace #2
1687     \\bigger {
1688       bigger
1689     }
1690     \\hspace #2
1691     huge
1692   }
1693 }
1694 @end lilypond"
1695   (interpret-markup layout props
1696    `(,fontsize-markup 1 ,arg)))
1697
1698 (define-builtin-markup-command (smaller layout props arg)
1699   (markup?)
1700   font
1701   ()
1702   "Decrease the font size relative to current setting.
1703
1704 @lilypond[verbatim,quote]
1705 \\markup {
1706   \\fontsize #3.5 {
1707     some large text
1708     \\hspace #2
1709     \\smaller {
1710       a bit smaller
1711     }
1712     \\hspace #2
1713     more large text
1714   }
1715 }
1716 @end lilypond"
1717   (interpret-markup layout props
1718    `(,fontsize-markup -1 ,arg)))
1719
1720 (define-builtin-markup-command (larger layout props arg)
1721   (markup?)
1722   font
1723   ()
1724   "Copy of the @code{\\bigger} command.
1725
1726 @lilypond[verbatim,quote]
1727 \\markup {
1728   default
1729   \\hspace #2
1730   \\larger
1731   larger
1732 }
1733 @end lilypond"
1734   (interpret-markup layout props (make-bigger-markup arg)))
1735
1736 (define-builtin-markup-command (finger layout props arg)
1737   (markup?)
1738   font
1739   ()
1740   "Set the argument as small numbers.
1741 @lilypond[verbatim,quote]
1742 \\markup {
1743   \\finger {
1744     1 2 3 4 5
1745   }
1746 }
1747 @end lilypond"
1748   (interpret-markup layout
1749                     (cons '((font-size . -5) (font-encoding . fetaNumber)) props)
1750                     arg))
1751
1752 (define-builtin-markup-command (abs-fontsize layout props size arg)
1753   (number? markup?)
1754   font
1755   ()
1756   "Use @var{size} as the absolute font size to display @var{arg}.
1757 Adjust baseline skip and word space accordingly.
1758 @lilypond[verbatim,quote]
1759 \\markup {
1760   default text font size
1761   \\hspace #2
1762   \\abs-fontsize #16 { text font size 16 }
1763   \\hspace #2
1764   \\abs-fontsize #12 { text font size 12 }
1765 }
1766 @end lilypond"
1767   (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
1768          (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
1769          (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
1770          (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
1771          (magnification (/ size ref-size)))
1772     (interpret-markup layout
1773                       (cons `((baseline-skip . ,(* magnification ref-baseline))
1774                               (word-space . ,(* magnification ref-word-space))
1775                               (font-size . ,(magnification->font-size magnification)))
1776                             props)
1777                       arg)))
1778
1779 (define-builtin-markup-command (fontsize layout props increment arg)
1780   (number? markup?)
1781   font
1782   ((font-size 0)
1783    (word-space 1)
1784    (baseline-skip 2))
1785   "Add @var{increment} to the font-size.  Adjust baseline skip accordingly.
1786 @lilypond[verbatim,quote]
1787 \\markup {
1788   default
1789   \\hspace #2
1790   \\fontsize #-1.5
1791   smaller
1792 }
1793 @end lilypond"
1794   (let ((entries (list
1795                   (cons 'baseline-skip (* baseline-skip (magstep increment)))
1796                   (cons 'word-space (* word-space (magstep increment)))
1797                   (cons 'font-size (+ font-size increment)))))
1798     (interpret-markup layout (cons entries props) arg)))
1799
1800 (define-builtin-markup-command (magnify layout props sz arg)
1801   (number? markup?)
1802   font
1803   ()
1804   "
1805 @cindex magnifying text
1806
1807 Set the font magnification for its argument.  In the following
1808 example, the middle@tie{}A is 10% larger:
1809
1810 @example
1811 A \\magnify #1.1 @{ A @} A
1812 @end example
1813
1814 Note: Magnification only works if a font name is explicitly selected.
1815 Use @code{\\fontsize} otherwise.
1816
1817 @lilypond[verbatim,quote]
1818 \\markup {
1819   default
1820   \\hspace #2
1821   \\magnify #1.5 {
1822     50% larger
1823   }
1824 }
1825 @end lilypond"
1826   (interpret-markup
1827    layout
1828    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
1829    arg))
1830
1831 (define-builtin-markup-command (bold layout props arg)
1832   (markup?)
1833   font
1834   ()
1835   "Switch to bold font-series.
1836
1837 @lilypond[verbatim,quote]
1838 \\markup {
1839   default
1840   \\hspace #2
1841   \\bold
1842   bold
1843 }
1844 @end lilypond"
1845   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
1846
1847 (define-builtin-markup-command (sans layout props arg)
1848   (markup?)
1849   font
1850   ()
1851   "Switch to the sans serif family.
1852
1853 @lilypond[verbatim,quote]
1854 \\markup {
1855   default
1856   \\hspace #2
1857   \\sans {
1858     sans serif
1859   }
1860 }
1861 @end lilypond"
1862   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
1863
1864 (define-builtin-markup-command (number layout props arg)
1865   (markup?)
1866   font
1867   ()
1868   "Set font family to @code{number}, which yields the font used for
1869 time signatures and fingerings.  This font only contains numbers and
1870 some punctuation.  It doesn't have any letters.
1871
1872 @lilypond[verbatim,quote]
1873 \\markup {
1874   \\number {
1875     0 1 2 3 4 5 6 7 8 9 . ,
1876   }
1877 }
1878 @end lilypond"
1879   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaNumber props) arg))
1880
1881 (define-builtin-markup-command (roman layout props arg)
1882   (markup?)
1883   font
1884   ()
1885   "Set font family to @code{roman}.
1886
1887 @lilypond[verbatim,quote]
1888 \\markup {
1889   \\sans \\bold {
1890     sans serif, bold
1891     \\hspace #2
1892     \\roman {
1893       text in roman font family
1894     }
1895     \\hspace #2
1896     return to sans
1897   }
1898 }
1899 @end lilypond"
1900   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
1901
1902 (define-builtin-markup-command (huge layout props arg)
1903   (markup?)
1904   font
1905   ()
1906   "Set font size to +2.
1907
1908 @lilypond[verbatim,quote]
1909 \\markup {
1910   default
1911   \\hspace #2
1912   \\huge
1913   huge
1914 }
1915 @end lilypond"
1916   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
1917
1918 (define-builtin-markup-command (large layout props arg)
1919   (markup?)
1920   font
1921   ()
1922   "Set font size to +1.
1923
1924 @lilypond[verbatim,quote]
1925 \\markup {
1926   default
1927   \\hspace #2
1928   \\large
1929   large
1930 }
1931 @end lilypond"
1932   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
1933
1934 (define-builtin-markup-command (normalsize layout props arg)
1935   (markup?)
1936   font
1937   ()
1938   "Set font size to default.
1939
1940 @lilypond[verbatim,quote]
1941 \\markup {
1942   \\teeny {
1943     this is very small
1944     \\hspace #2
1945     \\normalsize {
1946       normal size
1947     }
1948     \\hspace #2
1949     teeny again
1950   }
1951 }
1952 @end lilypond"
1953   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
1954
1955 (define-builtin-markup-command (small layout props arg)
1956   (markup?)
1957   font
1958   ()
1959   "Set font size to -1.
1960
1961 @lilypond[verbatim,quote]
1962 \\markup {
1963   default
1964   \\hspace #2
1965   \\small
1966   small
1967 }
1968 @end lilypond"
1969   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
1970
1971 (define-builtin-markup-command (tiny layout props arg)
1972   (markup?)
1973   font
1974   ()
1975   "Set font size to -2.
1976
1977 @lilypond[verbatim,quote]
1978 \\markup {
1979   default
1980   \\hspace #2
1981   \\tiny
1982   tiny
1983 }
1984 @end lilypond"
1985   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
1986
1987 (define-builtin-markup-command (teeny layout props arg)
1988   (markup?)
1989   font
1990   ()
1991   "Set font size to -3.
1992
1993 @lilypond[verbatim,quote]
1994 \\markup {
1995   default
1996   \\hspace #2
1997   \\teeny
1998   teeny
1999 }
2000 @end lilypond"
2001   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
2002
2003 (define-builtin-markup-command (fontCaps layout props arg)
2004   (markup?)
2005   font
2006   ()
2007   "Set @code{font-shape} to @code{caps}
2008
2009 Note: @code{\\fontCaps} requires the installation and selection of
2010 fonts which support the @code{caps} font shape."
2011   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
2012
2013 ;; Poor man's caps
2014 (define-builtin-markup-command (smallCaps layout props text)
2015   (markup?)
2016   font
2017   ()
2018   "Emit @var{arg} as small caps.
2019
2020 Note: @code{\\smallCaps} does not support accented characters.
2021
2022 @lilypond[verbatim,quote]
2023 \\markup {
2024   default
2025   \\hspace #2
2026   \\smallCaps {
2027     Text in small caps
2028   }
2029 }
2030 @end lilypond"
2031   (define (char-list->markup chars lower)
2032     (let ((final-string (string-upcase (reverse-list->string chars))))
2033       (if lower
2034           (markup #:fontsize -2 final-string)
2035           final-string)))
2036   (define (make-small-caps rest-chars currents current-is-lower prev-result)
2037     (if (null? rest-chars)
2038         (make-concat-markup
2039           (reverse! (cons (char-list->markup currents current-is-lower)
2040                           prev-result)))
2041         (let* ((ch (car rest-chars))
2042                (is-lower (char-lower-case? ch)))
2043           (if (or (and current-is-lower is-lower)
2044                   (and (not current-is-lower) (not is-lower)))
2045               (make-small-caps (cdr rest-chars)
2046                                (cons ch currents)
2047                                is-lower
2048                                prev-result)
2049               (make-small-caps (cdr rest-chars)
2050                                (list ch)
2051                                is-lower
2052                                (if (null? currents)
2053                                    prev-result
2054                                    (cons (char-list->markup
2055                                             currents current-is-lower)
2056                                          prev-result)))))))
2057   (interpret-markup layout props
2058     (if (string? text)
2059         (make-small-caps (string->list text) (list) #f (list))
2060         text)))
2061
2062 (define-builtin-markup-command (caps layout props arg)
2063   (markup?)
2064   font
2065   ()
2066   "Copy of the @code{\\smallCaps} command.
2067
2068 @lilypond[verbatim,quote]
2069 \\markup {
2070   default
2071   \\hspace #2
2072   \\caps {
2073     Text in small caps
2074   }
2075 }
2076 @end lilypond"
2077   (interpret-markup layout props (make-smallCaps-markup arg)))
2078
2079 (define-builtin-markup-command (dynamic layout props arg)
2080   (markup?)
2081   font
2082   ()
2083   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
2084 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
2085 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
2086 done in a different font.  The recommended font for this is bold and italic.
2087 @lilypond[verbatim,quote]
2088 \\markup {
2089   \\dynamic {
2090     sfzp
2091   }
2092 }
2093 @end lilypond"
2094   (interpret-markup
2095    layout (prepend-alist-chain 'font-encoding 'fetaDynamic props) arg))
2096
2097 (define-builtin-markup-command (text layout props arg)
2098   (markup?)
2099   font
2100   ()
2101   "Use a text font instead of music symbol or music alphabet font.
2102
2103 @lilypond[verbatim,quote]
2104 \\markup {
2105   \\number {
2106     1, 2,
2107     \\text {
2108       three, four,
2109     }
2110     5
2111   }
2112 }
2113 @end lilypond"
2114
2115   ;; ugh - latin1
2116   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
2117                     arg))
2118
2119 (define-builtin-markup-command (italic layout props arg)
2120   (markup?)
2121   font
2122   ()
2123   "Use italic @code{font-shape} for @var{arg}.
2124
2125 @lilypond[verbatim,quote]
2126 \\markup {
2127   default
2128   \\hspace #2
2129   \\italic
2130   italic
2131 }
2132 @end lilypond"
2133   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
2134
2135 (define-builtin-markup-command (typewriter layout props arg)
2136   (markup?)
2137   font
2138   ()
2139   "Use @code{font-family} typewriter for @var{arg}.
2140
2141 @lilypond[verbatim,quote]
2142 \\markup {
2143   default
2144   \\hspace #2
2145   \\typewriter
2146   typewriter
2147 }
2148 @end lilypond"
2149   (interpret-markup
2150    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
2151
2152 (define-builtin-markup-command (upright layout props arg)
2153   (markup?)
2154   font
2155   ()
2156   "Set font shape to @code{upright}.  This is the opposite of @code{italic}.
2157
2158 @lilypond[verbatim,quote]
2159 \\markup {
2160   \\italic {
2161     italic text
2162     \\hspace #2
2163     \\upright {
2164       upright text
2165     }
2166     \\hspace #2
2167     italic again
2168   }
2169 }
2170 @end lilypond"
2171   (interpret-markup
2172    layout (prepend-alist-chain 'font-shape 'upright props) arg))
2173
2174 (define-builtin-markup-command (medium layout props arg)
2175   (markup?)
2176   font
2177   ()
2178   "Switch to medium font series (in contrast to bold).
2179
2180 @lilypond[verbatim,quote]
2181 \\markup {
2182   \\bold {
2183     some bold text
2184     \\hspace #2
2185     \\medium {
2186       medium font series
2187     }
2188     \\hspace #2
2189     bold again
2190   }
2191 }
2192 @end lilypond"
2193   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
2194                     arg))
2195
2196 (define-builtin-markup-command (normal-text layout props arg)
2197   (markup?)
2198   font
2199   ()
2200   "Set all font related properties (except the size) to get the default
2201 normal text font, no matter what font was used earlier.
2202
2203 @lilypond[verbatim,quote]
2204 \\markup {
2205   \\huge \\bold \\sans \\caps {
2206     Some text with font overrides
2207     \\hspace #2
2208     \\normal-text {
2209       Default text, same font-size
2210     }
2211     \\hspace #2
2212     More text as before
2213   }
2214 }
2215 @end lilypond"
2216   ;; ugh - latin1
2217   (interpret-markup layout
2218                     (cons '((font-family . roman) (font-shape . upright)
2219                             (font-series . medium) (font-encoding . latin1))
2220                           props)
2221                     arg))
2222
2223 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2224 ;; symbols.
2225 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2226
2227 (define-builtin-markup-command (doublesharp layout props)
2228   ()
2229   music
2230   ()
2231   "Draw a double sharp symbol.
2232
2233 @lilypond[verbatim,quote]
2234 \\markup {
2235   \\doublesharp
2236 }
2237 @end lilypond"
2238   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
2239
2240 (define-builtin-markup-command (sesquisharp layout props)
2241   ()
2242   music
2243   ()
2244   "Draw a 3/2 sharp symbol.
2245
2246 @lilypond[verbatim,quote]
2247 \\markup {
2248   \\sesquisharp
2249 }
2250 @end lilypond"
2251   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
2252
2253 (define-builtin-markup-command (sharp layout props)
2254   ()
2255   music
2256   ()
2257   "Draw a sharp symbol.
2258
2259 @lilypond[verbatim,quote]
2260 \\markup {
2261   \\sharp
2262 }
2263 @end lilypond"
2264   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
2265
2266 (define-builtin-markup-command (semisharp layout props)
2267   ()
2268   music
2269   ()
2270   "Draw a semi sharp symbol.
2271
2272 @lilypond[verbatim,quote]
2273 \\markup {
2274   \\semisharp
2275 }
2276 @end lilypond"
2277   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
2278
2279 (define-builtin-markup-command (natural layout props)
2280   ()
2281   music
2282   ()
2283   "Draw a natural symbol.
2284
2285 @lilypond[verbatim,quote]
2286 \\markup {
2287   \\natural
2288 }
2289 @end lilypond"
2290   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
2291
2292 (define-builtin-markup-command (semiflat layout props)
2293   ()
2294   music
2295   ()
2296   "Draw a semiflat symbol.
2297
2298 @lilypond[verbatim,quote]
2299 \\markup {
2300   \\semiflat
2301 }
2302 @end lilypond"
2303   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
2304
2305 (define-builtin-markup-command (flat layout props)
2306   ()
2307   music
2308   ()
2309   "Draw a flat symbol.
2310
2311 @lilypond[verbatim,quote]
2312 \\markup {
2313   \\flat
2314 }
2315 @end lilypond"
2316   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
2317
2318 (define-builtin-markup-command (sesquiflat layout props)
2319   ()
2320   music
2321   ()
2322   "Draw a 3/2 flat symbol.
2323
2324 @lilypond[verbatim,quote]
2325 \\markup {
2326   \\sesquiflat
2327 }
2328 @end lilypond"
2329   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
2330
2331 (define-builtin-markup-command (doubleflat layout props)
2332   ()
2333   music
2334   ()
2335   "Draw a double flat symbol.
2336
2337 @lilypond[verbatim,quote]
2338 \\markup {
2339   \\doubleflat
2340 }
2341 @end lilypond"
2342   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
2343
2344 (define-builtin-markup-command (with-color layout props color arg)
2345   (color? markup?)
2346   other
2347   ()
2348   "
2349 @cindex coloring text
2350
2351 Draw @var{arg} in color specified by @var{color}.
2352
2353 @lilypond[verbatim,quote]
2354 \\markup {
2355   \\with-color #red
2356   red
2357   \\hspace #2
2358   \\with-color #green
2359   green
2360   \\hspace #2
2361   \\with-color #blue
2362   blue
2363 }
2364 @end lilypond"
2365   (let ((stil (interpret-markup layout props arg)))
2366     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
2367                      (ly:stencil-extent stil X)
2368                      (ly:stencil-extent stil Y))))
2369 \f
2370 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2371 ;; glyphs
2372 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2373
2374 (define-builtin-markup-command (arrow-head layout props axis direction filled)
2375   (integer? ly:dir? boolean?)
2376   graphic
2377   ()
2378   "Produce an arrow head in specified direction and axis.
2379 Use the filled head if @var{filled} is specified.
2380 @lilypond[verbatim,quote]
2381 \\markup {
2382   \\fontsize #5 {
2383     \\general-align #Y #DOWN {
2384       \\arrow-head #Y #UP ##t
2385       \\arrow-head #Y #DOWN ##f
2386       \\hspace #2
2387       \\arrow-head #X #RIGHT ##f
2388       \\arrow-head #X #LEFT ##f
2389     }
2390   }
2391 }
2392 @end lilypond"
2393   (let*
2394       ((name (format "arrowheads.~a.~a~a"
2395                      (if filled
2396                          "close"
2397                          "open")
2398                      axis
2399                      direction)))
2400     (ly:font-get-glyph
2401      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2402                                      props))
2403      name)))
2404
2405 (define-builtin-markup-command (musicglyph layout props glyph-name)
2406   (string?)
2407   music
2408   ()
2409   "@var{glyph-name} is converted to a musical symbol; for example,
2410 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2411 the music font.  See @ruser{The Feta font} for a complete listing of
2412 the possible glyphs.
2413
2414 @lilypond[verbatim,quote]
2415 \\markup {
2416   \\musicglyph #\"f\"
2417   \\musicglyph #\"rests.2\"
2418   \\musicglyph #\"clefs.G_change\"
2419 }
2420 @end lilypond"
2421   (let* ((font (ly:paper-get-font layout
2422                                   (cons '((font-encoding . fetaMusic)
2423                                           (font-name . #f))
2424
2425                                                  props)))
2426          (glyph (ly:font-get-glyph font glyph-name)))
2427     (if (null? (ly:stencil-expr glyph))
2428         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2429
2430     glyph))
2431
2432
2433 (define-builtin-markup-command (lookup layout props glyph-name)
2434   (string?)
2435   other
2436   ()
2437   "Lookup a glyph by name.
2438
2439 @lilypond[verbatim,quote]
2440 \\markup {
2441   \\override #'(font-encoding . fetaBraces) {
2442     \\lookup #\"brace200\"
2443     \\hspace #2
2444     \\rotate #180
2445     \\lookup #\"brace180\"
2446   }
2447 }
2448 @end lilypond"
2449   (ly:font-get-glyph (ly:paper-get-font layout props)
2450                      glyph-name))
2451
2452 (define-builtin-markup-command (char layout props num)
2453   (integer?)
2454   other
2455   ()
2456   "Produce a single character.  For example, @code{\\char #65} produces the
2457 letter @q{A}.
2458
2459 @lilypond[verbatim,quote]
2460 \\markup {
2461   \\char #65
2462 }
2463 @end lilypond"
2464   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
2465
2466 (define number->mark-letter-vector (make-vector 25 #\A))
2467
2468 (do ((i 0 (1+ i))
2469      (j 0 (1+ j)))
2470     ((>= i 26))
2471   (if (= i (- (char->integer #\I) (char->integer #\A)))
2472       (set! i (1+ i)))
2473   (vector-set! number->mark-letter-vector j
2474                (integer->char (+ i (char->integer #\A)))))
2475
2476 (define number->mark-alphabet-vector (list->vector
2477   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
2478
2479 (define (number->markletter-string vec n)
2480   "Double letters for big marks."
2481   (let* ((lst (vector-length vec)))
2482
2483     (if (>= n lst)
2484         (string-append (number->markletter-string vec (1- (quotient n lst)))
2485                        (number->markletter-string vec (remainder n lst)))
2486         (make-string 1 (vector-ref vec n)))))
2487
2488 (define-builtin-markup-command (markletter layout props num)
2489   (integer?)
2490   other
2491   ()
2492   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2493 (skipping letter@tie{}I), and continue with double letters.
2494
2495 @lilypond[verbatim,quote]
2496 \\markup {
2497   \\markletter #8
2498   \\hspace #2
2499   \\markletter #26
2500 }
2501 @end lilypond"
2502   (ly:text-interface::interpret-markup layout props
2503     (number->markletter-string number->mark-letter-vector num)))
2504
2505 (define-builtin-markup-command (markalphabet layout props num)
2506   (integer?)
2507   other
2508   ()
2509    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2510 and continue with double letters.
2511
2512 @lilypond[verbatim,quote]
2513 \\markup {
2514   \\markalphabet #8
2515   \\hspace #2
2516   \\markalphabet #26
2517 }
2518 @end lilypond"
2519    (ly:text-interface::interpret-markup layout props
2520      (number->markletter-string number->mark-alphabet-vector num)))
2521
2522 (define-public (horizontal-slash-interval num forward number-interval mag)
2523   (if forward
2524     (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
2525           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2526           (else (interval-widen number-interval (* mag 0.25))))
2527     (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
2528           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2529           (else (interval-widen number-interval (* mag 0.25))))
2530   ))
2531
2532 (define-public (adjust-slash-stencil num forward stencil mag)
2533   (if forward
2534     (cond ((= num 2)
2535               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2536           ((= num 3)
2537               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2538           ;((= num 5)
2539               ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
2540           ;((= num 7)
2541           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2542           (else stencil))
2543     (cond ((= num 6)
2544               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
2545           ;((= num 8)
2546           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2547           (else stencil))
2548   )
2549 )
2550
2551 (define (slashed-digit-internal layout props num forward font-size thickness)
2552   (let* ((mag (magstep font-size))
2553          (thickness (* mag
2554                        (ly:output-def-lookup layout 'line-thickness)
2555                        thickness))
2556          ; backward slashes might use slope and point in the other direction!
2557          (dy (* mag (if forward 0.4 -0.4)))
2558          (number-stencil (interpret-markup layout
2559                                            (prepend-alist-chain 'font-encoding 'fetaNumber props)
2560                                            (number->string num)))
2561          (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
2562          (center (interval-center (ly:stencil-extent number-stencil Y)))
2563          ; Use the real extents of the slash, not the whole number, because we
2564          ; might translate the slash later on!
2565          (num-y (interval-widen (cons center center) (abs dy)))
2566          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
2567          (slash-stencil (if is-sane
2568                             (make-line-stencil thickness
2569                                          (car num-x) (- (interval-center num-y) dy)
2570                                          (cdr num-x) (+ (interval-center num-y) dy))
2571                             #f)))
2572     (if (ly:stencil? slash-stencil)
2573       (begin
2574         ; for some numbers we need to shift the slash/backslash up or down to make
2575         ; the slashed digit look better
2576         (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
2577         (set! number-stencil
2578           (ly:stencil-add number-stencil slash-stencil)))
2579       (ly:warning "Unable to create slashed digit ~a" num))
2580     number-stencil))
2581
2582
2583 (define-builtin-markup-command (slashed-digit layout props num)
2584   (integer?)
2585   other
2586   ((font-size 0)
2587    (thickness 1.6))
2588   "
2589 @cindex slashed digits
2590
2591 A feta number, with slash.  This is for use in the context of
2592 figured bass notation.
2593 @lilypond[verbatim,quote]
2594 \\markup {
2595   \\slashed-digit #5
2596   \\hspace #2
2597   \\override #'(thickness . 3)
2598   \\slashed-digit #7
2599 }
2600 @end lilypond"
2601   (slashed-digit-internal layout props num #t font-size thickness))
2602
2603 (define-builtin-markup-command (backslashed-digit layout props num)
2604   (integer?)
2605   other
2606   ((font-size 0)
2607    (thickness 1.6))
2608   "
2609 @cindex backslashed digits
2610
2611 A feta number, with backslash.  This is for use in the context of
2612 figured bass notation.
2613 @lilypond[verbatim,quote]
2614 \\markup {
2615   \\backslashed-digit #5
2616   \\hspace #2
2617   \\override #'(thickness . 3)
2618   \\backslashed-digit #7
2619 }
2620 @end lilypond"
2621   (slashed-digit-internal layout props num #f font-size thickness))
2622
2623 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2624 ;; the note command.
2625 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2626
2627 ;; TODO: better syntax.
2628
2629 (define-builtin-markup-command (note-by-number layout props log dot-count dir)
2630   (number? number? number?)
2631   music
2632   ((font-size 0)
2633    (style '()))
2634   "
2635 @cindex notes within text by log and dot-count
2636
2637 Construct a note symbol, with stem.  By using fractional values for
2638 @var{dir}, you can obtain longer or shorter stems.
2639
2640 @lilypond[verbatim,quote]
2641 \\markup {
2642   \\note-by-number #3 #0 #DOWN
2643   \\hspace #2
2644   \\note-by-number #1 #2 #0.8
2645 }
2646 @end lilypond"
2647   (define (get-glyph-name-candidates dir log style)
2648     (map (lambda (dir-name)
2649      (format "noteheads.~a~a~a" dir-name (min log 2)
2650              (if (and (symbol? style)
2651                       (not (equal? 'default style)))
2652                  (symbol->string style)
2653                  "")))
2654          (list (if (= dir UP) "u" "d")
2655                "s")))
2656
2657   (define (get-glyph-name font cands)
2658     (if (null? cands)
2659      ""
2660      (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
2661          (get-glyph-name font (cdr cands))
2662          (car cands))))
2663
2664   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props)))
2665          (size-factor (magstep font-size))
2666          (stem-length (*  size-factor (max 3 (- log 1))))
2667          (head-glyph-name (get-glyph-name font (get-glyph-name-candidates (sign dir) log style)))
2668          (head-glyph (ly:font-get-glyph font head-glyph-name))
2669          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
2670          (stem-thickness (* size-factor 0.13))
2671          (stemy (* dir stem-length))
2672          (attach-off (cons (interval-index
2673                             (ly:stencil-extent head-glyph X)
2674                             (* (sign dir) (car attach-indices)))
2675                            (* (sign dir)        ; fixme, this is inconsistent between X & Y.
2676                               (interval-index
2677                                (ly:stencil-extent head-glyph Y)
2678                                (cdr attach-indices)))))
2679          (stem-glyph (and (> log 0)
2680                           (ly:round-filled-box
2681                            (ordered-cons (car attach-off)
2682                                          (+ (car attach-off)  (* (- (sign dir)) stem-thickness)))
2683                            (cons (min stemy (cdr attach-off))
2684                                  (max stemy (cdr attach-off)))
2685                            (/ stem-thickness 3))))
2686
2687          (dot (ly:font-get-glyph font "dots.dot"))
2688          (dotwid (interval-length (ly:stencil-extent dot X)))
2689          (dots (and (> dot-count 0)
2690                     (apply ly:stencil-add
2691                            (map (lambda (x)
2692                                   (ly:stencil-translate-axis
2693                                    dot (* 2 x dotwid) X))
2694                                 (iota dot-count)))))
2695          (flaggl (and (> log 2)
2696                       (ly:stencil-translate
2697                        (ly:font-get-glyph font
2698                                           (string-append "flags."
2699                                                          (if (> dir 0) "u" "d")
2700                                                          (number->string log)))
2701                        (cons (+ (car attach-off) (if (< dir 0) stem-thickness 0)) stemy)))))
2702
2703     ; If there is a flag on an upstem and the stem is short, move the dots to avoid the flag.
2704     ; 16th notes get a special case because their flags hang lower than any other flags.
2705     (if (and dots (> dir 0) (> log 2) (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
2706         (set! dots (ly:stencil-translate-axis dots 0.5 X)))
2707     (if flaggl
2708         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
2709     (if (ly:stencil? stem-glyph)
2710         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
2711         (set! stem-glyph head-glyph))
2712     (if (ly:stencil? dots)
2713         (set! stem-glyph
2714               (ly:stencil-add
2715                (ly:stencil-translate-axis
2716                 dots
2717                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
2718                 X)
2719                stem-glyph)))
2720     stem-glyph))
2721
2722 (define-public log2
2723   (let ((divisor (log 2)))
2724     (lambda (z) (inexact->exact (/ (log z) divisor)))))
2725
2726 (define (parse-simple-duration duration-string)
2727   "Parse the `duration-string', e.g. ''4..'' or ''breve.'', and return a (log dots) list."
2728   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string)))
2729     (if (and match (string=? duration-string (match:substring match 0)))
2730         (let ((len  (match:substring match 1))
2731               (dots (match:substring match 2)))
2732           (list (cond ((string=? len "breve") -1)
2733                       ((string=? len "longa") -2)
2734                       ((string=? len "maxima") -3)
2735                       (else (log2 (string->number len))))
2736                 (if dots (string-length dots) 0)))
2737         (ly:error (_ "not a valid duration string: ~a") duration-string))))
2738
2739 (define-builtin-markup-command (note layout props duration dir)
2740   (string? number?)
2741   music
2742   (note-by-number-markup)
2743   "
2744 @cindex notes within text by string
2745
2746 This produces a note with a stem pointing in @var{dir} direction, with
2747 the @var{duration} for the note head type and augmentation dots.  For
2748 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
2749 a shortened down stem.
2750
2751 @lilypond[verbatim,quote]
2752 \\markup {
2753   \\override #'(style . cross) {
2754     \\note #\"4..\" #UP
2755   }
2756   \\hspace #2
2757   \\note #\"breve\" #0
2758 }
2759 @end lilypond"
2760   (let ((parsed (parse-simple-duration duration)))
2761     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
2762
2763 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2764 ;; translating.
2765 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2766
2767 (define-builtin-markup-command (lower layout props amount arg)
2768   (number? markup?)
2769   align
2770   ()
2771   "
2772 @cindex lowering text
2773
2774 Lower @var{arg} by the distance @var{amount}.
2775 A negative @var{amount} indicates raising; see also @code{\\raise}.
2776
2777 @lilypond[verbatim,quote]
2778 \\markup {
2779   one
2780   \\lower #3
2781   two
2782   three
2783 }
2784 @end lilypond"
2785   (ly:stencil-translate-axis (interpret-markup layout props arg)
2786                              (- amount) Y))
2787
2788 (define-builtin-markup-command (translate-scaled layout props offset arg)
2789   (number-pair? markup?)
2790   align
2791   ((font-size 0))
2792   "
2793 @cindex translating text
2794 @cindex scaling text
2795
2796 Translate @var{arg} by @var{offset}, scaling the offset by the
2797 @code{font-size}.
2798
2799 @lilypond[verbatim,quote]
2800 \\markup {
2801   \\fontsize #5 {
2802     * \\translate #'(2 . 3) translate
2803     \\hspace #2
2804     * \\translate-scaled #'(2 . 3) translate-scaled
2805   }
2806 }
2807 @end lilypond"
2808   (let* ((factor (magstep font-size))
2809          (scaled (cons (* factor (car offset))
2810                        (* factor (cdr offset)))))
2811     (ly:stencil-translate (interpret-markup layout props arg)
2812                           scaled)))
2813
2814 (define-builtin-markup-command (raise layout props amount arg)
2815   (number? markup?)
2816   align
2817   ()
2818   "
2819 @cindex raising text
2820
2821 Raise @var{arg} by the distance @var{amount}.
2822 A negative @var{amount} indicates lowering, see also @code{\\lower}.
2823
2824 The argument to @code{\\raise} is the vertical displacement amount,
2825 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
2826 raise objects in relation to their surrounding markups.
2827
2828 If the text object itself is positioned above or below the staff, then
2829 @code{\\raise} cannot be used to move it, since the mechanism that
2830 positions it next to the staff cancels any shift made with
2831 @code{\\raise}.  For vertical positioning, use the @code{padding}
2832 and/or @code{extra-offset} properties.
2833
2834 @lilypond[verbatim,quote]
2835 \\markup {
2836   C
2837   \\small
2838   \\bold
2839   \\raise #1.0
2840   9/7+
2841 }
2842 @end lilypond"
2843   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
2844
2845 (define-builtin-markup-command (fraction layout props arg1 arg2)
2846   (markup? markup?)
2847   other
2848   ((font-size 0))
2849   "
2850 @cindex creating text fractions
2851
2852 Make a fraction of two markups.
2853 @lilypond[verbatim,quote]
2854 \\markup {
2855   π ≈
2856   \\fraction 355 113
2857 }
2858 @end lilypond"
2859   (let* ((m1 (interpret-markup layout props arg1))
2860          (m2 (interpret-markup layout props arg2))
2861          (factor (magstep font-size))
2862          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
2863          (padding (* factor 0.2))
2864          (baseline (* factor 0.6))
2865          (offset (* factor 0.75)))
2866     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
2867     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
2868     (let* ((x1 (ly:stencil-extent m1 X))
2869            (x2 (ly:stencil-extent m2 X))
2870            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
2871            ;; should stack mols separately, to maintain LINE on baseline
2872            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
2873       (set! stack
2874             (ly:stencil-aligned-to stack Y CENTER))
2875       (set! stack
2876             (ly:stencil-aligned-to stack X LEFT))
2877       ;; should have EX dimension
2878       ;; empirical anyway
2879       (ly:stencil-translate-axis stack offset Y))))
2880
2881 (define-builtin-markup-command (normal-size-super layout props arg)
2882   (markup?)
2883   font
2884   ((baseline-skip))
2885   "
2886 @cindex setting superscript in standard font size
2887
2888 Set @var{arg} in superscript with a normal font size.
2889
2890 @lilypond[verbatim,quote]
2891 \\markup {
2892   default
2893   \\normal-size-super {
2894     superscript in standard size
2895   }
2896 }
2897 @end lilypond"
2898   (ly:stencil-translate-axis
2899    (interpret-markup layout props arg)
2900    (* 0.5 baseline-skip) Y))
2901
2902 (define-builtin-markup-command (super layout props arg)
2903   (markup?)
2904   font
2905   ((font-size 0)
2906    (baseline-skip))
2907   "
2908 @cindex superscript text
2909
2910 Raising and lowering texts can be done with @code{\\super} and
2911 @code{\\sub}:
2912
2913 @lilypond[verbatim,quote]
2914 \\markup {
2915   E =
2916   \\concat {
2917     mc
2918     \\super
2919     2
2920   }
2921 }
2922 @end lilypond"
2923   (ly:stencil-translate-axis
2924    (interpret-markup
2925     layout
2926     (cons `((font-size . ,(- font-size 3))) props)
2927     arg)
2928    (* 0.5 baseline-skip)
2929    Y))
2930
2931 (define-builtin-markup-command (translate layout props offset arg)
2932   (number-pair? markup?)
2933   align
2934   ()
2935   "
2936 @cindex translating text
2937
2938 This translates an object.  Its first argument is a cons of numbers.
2939
2940 @example
2941 A \\translate #(cons 2 -3) @{ B C @} D
2942 @end example
2943
2944 This moves @q{B C} 2@tie{}spaces to the right, and 3 down, relative to its
2945 surroundings.  This command cannot be used to move isolated scripts
2946 vertically, for the same reason that @code{\\raise} cannot be used for
2947 that.
2948
2949 @lilypond[verbatim,quote]
2950 \\markup {
2951   *
2952   \\translate #'(2 . 3)
2953   \\line { translated two spaces right, three up }
2954 }
2955 @end lilypond"
2956   (ly:stencil-translate (interpret-markup layout props arg)
2957                         offset))
2958
2959 (define-builtin-markup-command (sub layout props arg)
2960   (markup?)
2961   font
2962   ((font-size 0)
2963    (baseline-skip))
2964   "
2965 @cindex subscript text
2966
2967 Set @var{arg} in subscript.
2968
2969 @lilypond[verbatim,quote]
2970 \\markup {
2971   \\concat {
2972     H
2973     \\sub {
2974       2
2975     }
2976     O
2977   }
2978 }
2979 @end lilypond"
2980   (ly:stencil-translate-axis
2981    (interpret-markup
2982     layout
2983     (cons `((font-size . ,(- font-size 3))) props)
2984     arg)
2985    (* -0.5 baseline-skip)
2986    Y))
2987
2988 (define-builtin-markup-command (normal-size-sub layout props arg)
2989   (markup?)
2990   font
2991   ((baseline-skip))
2992   "
2993 @cindex setting subscript in standard font size
2994
2995 Set @var{arg} in subscript, in a normal font size.
2996
2997 @lilypond[verbatim,quote]
2998 \\markup {
2999   default
3000   \\normal-size-sub {
3001     subscript in standard size
3002   }
3003 }
3004 @end lilypond"
3005   (ly:stencil-translate-axis
3006    (interpret-markup layout props arg)
3007    (* -0.5 baseline-skip)
3008    Y))
3009 \f
3010 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3011 ;; brackets.
3012 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3013
3014 (define-builtin-markup-command (hbracket layout props arg)
3015   (markup?)
3016   graphic
3017   ()
3018   "
3019 @cindex placing horizontal brackets around text
3020
3021 Draw horizontal brackets around @var{arg}.
3022
3023 @lilypond[verbatim,quote]
3024 \\markup {
3025   \\hbracket {
3026     \\line {
3027       one two three
3028     }
3029   }
3030 }
3031 @end lilypond"
3032   (let ((th 0.1) ;; todo: take from GROB.
3033         (m (interpret-markup layout props arg)))
3034     (bracketify-stencil m X th (* 2.5 th) th)))
3035
3036 (define-builtin-markup-command (bracket layout props arg)
3037   (markup?)
3038   graphic
3039   ()
3040   "
3041 @cindex placing vertical brackets around text
3042
3043 Draw vertical brackets around @var{arg}.
3044
3045 @lilypond[verbatim,quote]
3046 \\markup {
3047   \\bracket {
3048     \\note #\"2.\" #UP
3049   }
3050 }
3051 @end lilypond"
3052   (let ((th 0.1) ;; todo: take from GROB.
3053         (m (interpret-markup layout props arg)))
3054     (bracketify-stencil m Y th (* 2.5 th) th)))
3055 \f
3056 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3057 ;; Delayed markup evaluation
3058 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3059
3060 (define-builtin-markup-command (page-ref layout props label gauge default)
3061   (symbol? markup? markup?)
3062   other
3063   ()
3064   "
3065 @cindex referencing page numbers in text
3066
3067 Reference to a page number. @var{label} is the label set on the referenced
3068 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
3069 the maximum width of the page number, and @var{default} the value to display
3070 when @var{label} is not found."
3071   (let* ((gauge-stencil (interpret-markup layout props gauge))
3072          (x-ext (ly:stencil-extent gauge-stencil X))
3073          (y-ext (ly:stencil-extent gauge-stencil Y)))
3074     (ly:make-stencil
3075      `(delay-stencil-evaluation
3076        ,(delay (ly:stencil-expr
3077                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
3078                        (label-page (and (list? table) (assoc label table)))
3079                        (page-number (and label-page (cdr label-page)))
3080                        (page-markup (if page-number (format "~a" page-number) default))
3081                        (page-stencil (interpret-markup layout props page-markup))
3082                        (gap (- (interval-length x-ext)
3083                                (interval-length (ly:stencil-extent page-stencil X)))))
3084                   (interpret-markup layout props
3085                                     (markup #:concat (#:hspace gap page-markup)))))))
3086      x-ext
3087      y-ext)))
3088 \f
3089 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3090 ;; Markup list commands
3091 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3092
3093 (define-public (space-lines baseline stils)
3094   (let space-stil ((stils stils)
3095                    (result (list)))
3096     (if (null? stils)
3097         (reverse! result)
3098         (let* ((stil (car stils))
3099                (dy-top (max (- (/ baseline 1.5)
3100                                (interval-bound (ly:stencil-extent stil Y) UP))
3101                             0.0))
3102                (dy-bottom (max (+ (/ baseline 3.0)
3103                                   (interval-bound (ly:stencil-extent stil Y) DOWN))
3104                                0.0))
3105                (new-stil (ly:make-stencil
3106                           (ly:stencil-expr stil)
3107                           (ly:stencil-extent stil X)
3108                           (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN)
3109                                    dy-bottom)
3110                                 (+ (interval-bound (ly:stencil-extent stil Y) UP)
3111                                    dy-top)))))
3112           (space-stil (cdr stils) (cons new-stil result))))))
3113
3114 (define-builtin-markup-list-command (justified-lines layout props args)
3115   (markup-list?)
3116   ((baseline-skip)
3117    wordwrap-internal-markup-list)
3118   "
3119 @cindex justifying lines of text
3120
3121 Like @code{\\justify}, but return a list of lines instead of a single markup.
3122 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
3123 @var{X}@tie{}is the number of staff spaces."
3124   (space-lines baseline-skip
3125                (interpret-markup-list layout props
3126                                       (make-wordwrap-internal-markup-list #t args))))
3127
3128 (define-builtin-markup-list-command (wordwrap-lines layout props args)
3129   (markup-list?)
3130   ((baseline-skip)
3131    wordwrap-internal-markup-list)
3132   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
3133 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
3134 where @var{X} is the number of staff spaces."
3135   (space-lines baseline-skip
3136                (interpret-markup-list layout props
3137                                       (make-wordwrap-internal-markup-list #f args))))
3138
3139 (define-builtin-markup-list-command (column-lines layout props args)
3140   (markup-list?)
3141   ((baseline-skip))
3142   "Like @code{\\column}, but return a list of lines instead of a single markup.
3143 @code{baseline-skip} determines the space between each markup in @var{args}."
3144   (space-lines (chain-assoc-get 'baseline-skip props)
3145                (interpret-markup-list layout props args)))
3146
3147 (define-builtin-markup-list-command (override-lines layout props new-prop args)
3148   (pair? markup-list?)
3149   ()
3150   "Like @code{\\override}, for markup lists."
3151   (interpret-markup-list layout (cons (list new-prop) props) args))