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