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