scm/define-markup-commands.scm

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