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 (abs-fontsize layout props size arg)
1424   (number? markup?)
1425   font
1426   ((word-space 1)
1427    (baseline-skip 2))
1428   "Use @var{size} as the absolute font size to display @var{arg}.
1429 Adjust baseline skip and word space accordingly.
1430 @lilypond[verbatim,quote]
1431 \\markup {
1432   default text font size
1433   \\hspace #2
1434   \\abs-fontsize #16 { text font size 16 }
1435   \\hspace #2
1436   \\abs-fontsize #12 { text font size 12 }
1437 }
1438 @end lilypond"
1439   (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
1440          (magnification (/ size ref-size)))
1441     (interpret-markup layout
1442                       (cons `((baseline-skip . ,(* magnification baseline-skip))
1443                               (word-space . ,(* magnification word-space))
1444                               (font-size . ,(magnification->font-size magnification)))
1445                             props)
1446                       arg)))
1447
1448 (define-builtin-markup-command (fontsize layout props increment arg)
1449   (number? markup?)
1450   font
1451   ((font-size 0)
1452    (word-space 1)
1453    (baseline-skip 2))
1454   "Add @var{increment} to the font-size.  Adjust baseline skip accordingly.
1455 @lilypond[verbatim,quote]
1456 \\markup {
1457   default
1458   \\hspace #2
1459   \\fontsize #-1.5
1460   smaller
1461 }
1462 @end lilypond"
1463   (let ((entries (list
1464                   (cons 'baseline-skip (* baseline-skip (magstep increment)))
1465                   (cons 'word-space (* word-space (magstep increment)))
1466                   (cons 'font-size (+ font-size increment)))))
1467     (interpret-markup layout (cons entries props) arg)))
1468
1469 (define-builtin-markup-command (magnify layout props sz arg)
1470   (number? markup?)
1471   font
1472   ()
1473   "
1474 @cindex magnifying text
1475
1476 Set the font magnification for its argument.  In the following
1477 example, the middle@tie{}A is 10% larger:
1478
1479 @example
1480 A \\magnify #1.1 @{ A @} A
1481 @end example
1482
1483 Note: Magnification only works if a font name is explicitly selected.
1484 Use @code{\\fontsize} otherwise.
1485
1486 @lilypond[verbatim,quote]
1487 \\markup {
1488   default
1489   \\hspace #2
1490   \\magnify #1.5 {
1491     50% larger
1492   }
1493 }
1494 @end lilypond"
1495   (interpret-markup
1496    layout
1497    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
1498    arg))
1499
1500 (define-builtin-markup-command (bold layout props arg)
1501   (markup?)
1502   font
1503   ()
1504   "Switch to bold font-series.
1505
1506 @lilypond[verbatim,quote]
1507 \\markup {
1508   default
1509   \\hspace #2
1510   \\bold
1511   bold
1512 }
1513 @end lilypond"
1514   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
1515
1516 (define-builtin-markup-command (sans layout props arg)
1517   (markup?)
1518   font
1519   ()
1520   "Switch to the sans serif family.
1521
1522 @lilypond[verbatim,quote]
1523 \\markup {
1524   default
1525   \\hspace #2
1526   \\sans {
1527     sans serif
1528   }
1529 }
1530 @end lilypond"
1531   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
1532
1533 (define-builtin-markup-command (number layout props arg)
1534   (markup?)
1535   font
1536   ()
1537   "Set font family to @code{number}, which yields the font used for
1538 time signatures and fingerings.  This font only contains numbers and
1539 some punctuation.  It doesn't have any letters.
1540
1541 @lilypond[verbatim,quote]
1542 \\markup {
1543   \\number {
1544     0 1 2 3 4 5 6 7 8 9 . ,
1545   }
1546 }
1547 @end lilypond"
1548   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaNumber props) arg))
1549
1550 (define-builtin-markup-command (roman layout props arg)
1551   (markup?)
1552   font
1553   ()
1554   "Set font family to @code{roman}.
1555
1556 @lilypond[verbatim,quote]
1557 \\markup {
1558   \\sans \\bold {
1559     sans serif, bold
1560     \\hspace #2
1561     \\roman {
1562       text in roman font family
1563     }
1564     \\hspace #2
1565     return to sans
1566   }
1567 }
1568 @end lilypond"
1569   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
1570
1571 (define-builtin-markup-command (huge layout props arg)
1572   (markup?)
1573   font
1574   ()
1575   "Set font size to +2.
1576
1577 @lilypond[verbatim,quote]
1578 \\markup {
1579   default
1580   \\hspace #2
1581   \\huge
1582   huge
1583 }
1584 @end lilypond"
1585   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
1586
1587 (define-builtin-markup-command (large layout props arg)
1588   (markup?)
1589   font
1590   ()
1591   "Set font size to +1.
1592
1593 @lilypond[verbatim,quote]
1594 \\markup {
1595   default
1596   \\hspace #2
1597   \\large
1598   large
1599 }
1600 @end lilypond"
1601   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
1602
1603 (define-builtin-markup-command (normalsize layout props arg)
1604   (markup?)
1605   font
1606   ()
1607   "Set font size to default.
1608
1609 @lilypond[verbatim,quote]
1610 \\markup {
1611   \\teeny {
1612     this is very small
1613     \\hspace #2
1614     \\normalsize {
1615       normal size
1616     }
1617     \\hspace #2
1618     teeny again
1619   }
1620 }
1621 @end lilypond"
1622   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
1623
1624 (define-builtin-markup-command (small layout props arg)
1625   (markup?)
1626   font
1627   ()
1628   "Set font size to -1.
1629
1630 @lilypond[verbatim,quote]
1631 \\markup {
1632   default
1633   \\hspace #2
1634   \\small
1635   small
1636 }
1637 @end lilypond"
1638   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
1639
1640 (define-builtin-markup-command (tiny layout props arg)
1641   (markup?)
1642   font
1643   ()
1644   "Set font size to -2.
1645
1646 @lilypond[verbatim,quote]
1647 \\markup {
1648   default
1649   \\hspace #2
1650   \\tiny
1651   tiny
1652 }
1653 @end lilypond"
1654   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
1655
1656 (define-builtin-markup-command (teeny layout props arg)
1657   (markup?)
1658   font
1659   ()
1660   "Set font size to -3.
1661
1662 @lilypond[verbatim,quote]
1663 \\markup {
1664   default
1665   \\hspace #2
1666   \\teeny
1667   teeny
1668 }
1669 @end lilypond"
1670   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
1671
1672 (define-builtin-markup-command (fontCaps layout props arg)
1673   (markup?)
1674   font
1675   ()
1676   "Set @code{font-shape} to @code{caps}"
1677   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
1678
1679 ;; Poor man's caps
1680 (define-builtin-markup-command (smallCaps layout props text)
1681   (markup?)
1682   font
1683   ()
1684   "Emit @var{arg} as small caps.
1685
1686 Note: @code{\\smallCaps} does not support accented characters.
1687
1688 @lilypond[verbatim,quote]
1689 \\markup {
1690   default
1691   \\hspace #2
1692   \\smallCaps {
1693     Text in small caps
1694   }
1695 }
1696 @end lilypond"
1697   (define (char-list->markup chars lower)
1698     (let ((final-string (string-upcase (reverse-list->string chars))))
1699       (if lower
1700           (markup #:fontsize -2 final-string)
1701           final-string)))
1702   (define (make-small-caps rest-chars currents current-is-lower prev-result)
1703     (if (null? rest-chars)
1704         (make-concat-markup
1705           (reverse! (cons (char-list->markup currents current-is-lower)
1706                           prev-result)))
1707         (let* ((ch (car rest-chars))
1708                (is-lower (char-lower-case? ch)))
1709           (if (or (and current-is-lower is-lower)
1710                   (and (not current-is-lower) (not is-lower)))
1711               (make-small-caps (cdr rest-chars)
1712                                (cons ch currents)
1713                                is-lower
1714                                prev-result)
1715               (make-small-caps (cdr rest-chars)
1716                                (list ch)
1717                                is-lower
1718                                (if (null? currents)
1719                                    prev-result
1720                                    (cons (char-list->markup
1721                                             currents current-is-lower)
1722                                          prev-result)))))))
1723   (interpret-markup layout props
1724     (if (string? text)
1725         (make-small-caps (string->list text) (list) #f (list))
1726         text)))
1727
1728 (define-builtin-markup-command (caps layout props arg)
1729   (markup?)
1730   font
1731   ()
1732   "Copy of the @code{\\smallCaps} command.
1733
1734 @lilypond[verbatim,quote]
1735 \\markup {
1736   default
1737   \\hspace #2
1738   \\caps {
1739     Text in small caps
1740   }
1741 }
1742 @end lilypond"
1743   (interpret-markup layout props (make-smallCaps-markup arg)))
1744
1745 (define-builtin-markup-command (dynamic layout props arg)
1746   (markup?)
1747   font
1748   ()
1749   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
1750 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
1751 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
1752 done in a different font.  The recommended font for this is bold and italic.
1753 @lilypond[verbatim,quote]
1754 \\markup {
1755   \\dynamic {
1756     sfzp
1757   }
1758 }
1759 @end lilypond"
1760   (interpret-markup
1761    layout (prepend-alist-chain 'font-encoding 'fetaDynamic props) arg))
1762
1763 (define-builtin-markup-command (text layout props arg)
1764   (markup?)
1765   font
1766   ()
1767   "Use a text font instead of music symbol or music alphabet font.
1768
1769 @lilypond[verbatim,quote]
1770 \\markup {
1771   \\number {
1772     1, 2,
1773     \\text {
1774       three, four,
1775     }
1776     5
1777   }
1778 }
1779 @end lilypond"
1780
1781   ;; ugh - latin1
1782   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
1783                     arg))
1784
1785 (define-builtin-markup-command (italic layout props arg)
1786   (markup?)
1787   font
1788   ()
1789   "Use italic @code{font-shape} for @var{arg}.
1790
1791 @lilypond[verbatim,quote]
1792 \\markup {
1793   default
1794   \\hspace #2
1795   \\italic
1796   italic
1797 }
1798 @end lilypond"
1799   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
1800
1801 (define-builtin-markup-command (typewriter layout props arg)
1802   (markup?)
1803   font
1804   ()
1805   "Use @code{font-family} typewriter for @var{arg}.
1806
1807 @lilypond[verbatim,quote]
1808 \\markup {
1809   default
1810   \\hspace #2
1811   \\typewriter
1812   typewriter
1813 }
1814 @end lilypond"
1815   (interpret-markup
1816    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
1817
1818 (define-builtin-markup-command (upright layout props arg)
1819   (markup?)
1820   font
1821   ()
1822   "Set font shape to @code{upright}.  This is the opposite of @code{italic}.
1823
1824 @lilypond[verbatim,quote]
1825 \\markup {
1826   \\italic {
1827     italic text
1828     \\hspace #2
1829     \\upright {
1830       upright text
1831     }
1832     \\hspace #2
1833     italic again
1834   }
1835 }
1836 @end lilypond"
1837   (interpret-markup
1838    layout (prepend-alist-chain 'font-shape 'upright props) arg))
1839
1840 (define-builtin-markup-command (medium layout props arg)
1841   (markup?)
1842   font
1843   ()
1844   "Switch to medium font series (in contrast to bold).
1845
1846 @lilypond[verbatim,quote]
1847 \\markup {
1848   \\bold {
1849     some bold text
1850     \\hspace #2
1851     \\medium {
1852       medium font series
1853     }
1854     \\hspace #2
1855     bold again
1856   }
1857 }
1858 @end lilypond"
1859   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
1860                     arg))
1861
1862 (define-builtin-markup-command (normal-text layout props arg)
1863   (markup?)
1864   font
1865   ()
1866   "Set all font related properties (except the size) to get the default
1867 normal text font, no matter what font was used earlier.
1868
1869 @lilypond[verbatim,quote]
1870 \\markup {
1871   \\huge \\bold \\sans \\caps {
1872     Some text with font overrides
1873     \\hspace #2
1874     \\normal-text {
1875       Default text, same font-size
1876     }
1877     \\hspace #2
1878     More text as before
1879   }
1880 }
1881 @end lilypond"
1882   ;; ugh - latin1
1883   (interpret-markup layout
1884                     (cons '((font-family . roman) (font-shape . upright)
1885                             (font-series . medium) (font-encoding . latin1))
1886                           props)
1887                     arg))
1888
1889 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1890 ;; symbols.
1891 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1892
1893 (define-builtin-markup-command (doublesharp layout props)
1894   ()
1895   music
1896   ()
1897   "Draw a double sharp symbol.
1898
1899 @lilypond[verbatim,quote]
1900 \\markup {
1901   \\doublesharp
1902 }
1903 @end lilypond"
1904   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
1905
1906 (define-builtin-markup-command (sesquisharp layout props)
1907   ()
1908   music
1909   ()
1910   "Draw a 3/2 sharp symbol.
1911
1912 @lilypond[verbatim,quote]
1913 \\markup {
1914   \\sesquisharp
1915 }
1916 @end lilypond"
1917   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
1918
1919 (define-builtin-markup-command (sharp layout props)
1920   ()
1921   music
1922   ()
1923   "Draw a sharp symbol.
1924
1925 @lilypond[verbatim,quote]
1926 \\markup {
1927   \\sharp
1928 }
1929 @end lilypond"
1930   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
1931
1932 (define-builtin-markup-command (semisharp layout props)
1933   ()
1934   music
1935   ()
1936   "Draw a semi sharp symbol.
1937
1938 @lilypond[verbatim,quote]
1939 \\markup {
1940   \\semisharp
1941 }
1942 @end lilypond"
1943   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
1944
1945 (define-builtin-markup-command (natural layout props)
1946   ()
1947   music
1948   ()
1949   "Draw a natural symbol.
1950
1951 @lilypond[verbatim,quote]
1952 \\markup {
1953   \\natural
1954 }
1955 @end lilypond"
1956   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
1957
1958 (define-builtin-markup-command (semiflat layout props)
1959   ()
1960   music
1961   ()
1962   "Draw a semiflat symbol.
1963
1964 @lilypond[verbatim,quote]
1965 \\markup {
1966   \\semiflat
1967 }
1968 @end lilypond"
1969   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
1970
1971 (define-builtin-markup-command (flat layout props)
1972   ()
1973   music
1974   ()
1975   "Draw a flat symbol.
1976
1977 @lilypond[verbatim,quote]
1978 \\markup {
1979   \\flat
1980 }
1981 @end lilypond"
1982   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
1983
1984 (define-builtin-markup-command (sesquiflat layout props)
1985   ()
1986   music
1987   ()
1988   "Draw a 3/2 flat symbol.
1989
1990 @lilypond[verbatim,quote]
1991 \\markup {
1992   \\sesquiflat
1993 }
1994 @end lilypond"
1995   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
1996
1997 (define-builtin-markup-command (doubleflat layout props)
1998   ()
1999   music
2000   ()
2001   "Draw a double flat symbol.
2002
2003 @lilypond[verbatim,quote]
2004 \\markup {
2005   \\doubleflat
2006 }
2007 @end lilypond"
2008   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
2009
2010 (define-builtin-markup-command (with-color layout props color arg)
2011   (color? markup?)
2012   other
2013   ()
2014   "
2015 @cindex coloring text
2016
2017 Draw @var{arg} in color specified by @var{color}."
2018   (let ((stil (interpret-markup layout props arg)))
2019     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
2020                      (ly:stencil-extent stil X)
2021                      (ly:stencil-extent stil Y))))
2022 \f
2023 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2024 ;; glyphs
2025 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2026
2027 (define-builtin-markup-command (arrow-head layout props axis direction filled)
2028   (integer? ly:dir? boolean?)
2029   graphic
2030   ()
2031   "Produce an arrow head in specified direction and axis.
2032 Use the filled head if @var{filled} is specified.
2033 @lilypond[verbatim,quote]
2034 \\markup {
2035   \\fontsize #5 {
2036     \\general-align #Y #DOWN {
2037       \\arrow-head #Y #UP ##t
2038       \\arrow-head #Y #DOWN ##f
2039       \\hspace #2
2040       \\arrow-head #X #RIGHT ##f
2041       \\arrow-head #X #LEFT ##f
2042     }
2043   }
2044 }
2045 @end lilypond"
2046   (let*
2047       ((name (format "arrowheads.~a.~a~a"
2048                      (if filled
2049                          "close"
2050                          "open")
2051                      axis
2052                      direction)))
2053     (ly:font-get-glyph
2054      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2055                                      props))
2056      name)))
2057
2058 (define-builtin-markup-command (musicglyph layout props glyph-name)
2059   (string?)
2060   music
2061   ()
2062   "@var{glyph-name} is converted to a musical symbol; for example,
2063 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2064 the music font.  See @ruser{The Feta font} for a complete listing of
2065 the possible glyphs.
2066
2067 @lilypond[verbatim,quote]
2068 \\markup {
2069   \\musicglyph #\"f\"
2070   \\musicglyph #\"rests.2\"
2071   \\musicglyph #\"clefs.G_change\"
2072 }
2073 @end lilypond"
2074   (let* ((font (ly:paper-get-font layout
2075                                   (cons '((font-encoding . fetaMusic)
2076                                           (font-name . #f))
2077
2078                                                  props)))
2079          (glyph (ly:font-get-glyph font glyph-name)))
2080     (if (null? (ly:stencil-expr glyph))
2081         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2082
2083     glyph))
2084
2085
2086 (define-builtin-markup-command (lookup layout props glyph-name)
2087   (string?)
2088   other
2089   ()
2090   "Lookup a glyph by name.
2091
2092 @lilypond[verbatim,quote]
2093 \\markup {
2094   \\override #'(font-encoding . fetaBraces) {
2095     \\lookup #\"brace200\"
2096     \\hspace #2
2097     \\rotate #180
2098     \\lookup #\"brace180\"
2099   }
2100 }
2101 @end lilypond"
2102   (ly:font-get-glyph (ly:paper-get-font layout props)
2103                      glyph-name))
2104
2105 (define-builtin-markup-command (char layout props num)
2106   (integer?)
2107   other
2108   ()
2109   "Produce a single character.  For example, @code{\\char #65} produces the
2110 letter @q{A}."
2111   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
2112
2113 (define number->mark-letter-vector (make-vector 25 #\A))
2114
2115 (do ((i 0 (1+ i))
2116      (j 0 (1+ j)))
2117     ((>= i 26))
2118   (if (= i (- (char->integer #\I) (char->integer #\A)))
2119       (set! i (1+ i)))
2120   (vector-set! number->mark-letter-vector j
2121                (integer->char (+ i (char->integer #\A)))))
2122
2123 (define number->mark-alphabet-vector (list->vector
2124   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
2125
2126 (define (number->markletter-string vec n)
2127   "Double letters for big marks."
2128   (let* ((lst (vector-length vec)))
2129
2130     (if (>= n lst)
2131         (string-append (number->markletter-string vec (1- (quotient n lst)))
2132                        (number->markletter-string vec (remainder n lst)))
2133         (make-string 1 (vector-ref vec n)))))
2134
2135 (define-builtin-markup-command (markletter layout props num)
2136   (integer?)
2137   other
2138   ()
2139   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2140 (skipping letter@tie{}I), and continue with double letters.
2141
2142 @lilypond[verbatim,quote]
2143 \\markup {
2144   \\markletter #8
2145   \\hspace #2
2146   \\markletter #26
2147 }
2148 @end lilypond"
2149   (ly:text-interface::interpret-markup layout props
2150     (number->markletter-string number->mark-letter-vector num)))
2151
2152 (define-builtin-markup-command (markalphabet layout props num)
2153   (integer?)
2154   other
2155   ()
2156    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2157 and continue with double letters.
2158
2159 @lilypond[verbatim,quote]
2160 \\markup {
2161   \\markalphabet #8
2162   \\hspace #2
2163   \\markalphabet #26
2164 }
2165 @end lilypond"
2166    (ly:text-interface::interpret-markup layout props
2167      (number->markletter-string number->mark-alphabet-vector num)))
2168
2169 (define-public (horizontal-slash-interval num forward number-interval mag)
2170   (ly:message "Mag step: ~a" mag)
2171   (if forward
2172     (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
2173           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2174           (else (interval-widen number-interval (* mag 0.25))))
2175     (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
2176           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2177           (else (interval-widen number-interval (* mag 0.25))))
2178   ))
2179
2180 (define-public (adjust-slash-stencil num forward stencil mag)
2181   (if forward
2182     (cond ((= num 2)
2183               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2184           ((= num 3)
2185               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2186           ;((= num 5)
2187               ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
2188           ;((= num 7)
2189           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2190           (else stencil))
2191     (cond ((= num 6)
2192               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
2193           ;((= num 8)
2194           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2195           (else stencil))
2196   )
2197 )
2198
2199 (define (slashed-digit-internal layout props num forward font-size thickness)
2200   (let* ((mag (magstep font-size))
2201          (thickness (* mag
2202                        (ly:output-def-lookup layout 'line-thickness)
2203                        thickness))
2204          ; backward slashes might use slope and point in the other direction!
2205          (dy (* mag (if forward 0.4 -0.4)))
2206          (number-stencil (interpret-markup layout
2207                                            (prepend-alist-chain 'font-encoding 'fetaNumber props)
2208                                            (number->string num)))
2209          (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
2210          (center (interval-center (ly:stencil-extent number-stencil Y)))
2211          ; Use the real extents of the slash, not the whole number, because we
2212          ; might translate the slash later on!
2213          (num-y (interval-widen (cons center center) (abs dy)))
2214          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
2215          (slash-stencil (if is-sane
2216                             (ly:make-stencil
2217                              `(draw-line ,thickness
2218                                          ,(car num-x) ,(- (interval-center num-y) dy)
2219                                          ,(cdr num-x) ,(+ (interval-center num-y) dy))
2220                              num-x num-y)
2221                             #f)))
2222 (ly:message "Num: ~a, X-interval: ~a" num num-x)
2223     (if (ly:stencil? slash-stencil)
2224       (begin
2225         ; for some numbers we need to shift the slash/backslash up or down to make
2226         ; the slashed digit look better
2227         (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
2228         (set! number-stencil
2229           (ly:stencil-add number-stencil slash-stencil)))
2230       (ly:warning "Unable to create slashed digit ~a" num))
2231     number-stencil))
2232
2233
2234 (define-builtin-markup-command (slashed-digit layout props num)
2235   (integer?)
2236   other
2237   ((font-size 0)
2238    (thickness 1.6))
2239   "
2240 @cindex slashed digits
2241
2242 A feta number, with slash.  This is for use in the context of
2243 figured bass notation.
2244 @lilypond[verbatim,quote]
2245 \\markup {
2246   \\slashed-digit #5
2247   \\hspace #2
2248   \\override #'(thickness . 3)
2249   \\slashed-digit #7
2250 }
2251 @end lilypond"
2252   (slashed-digit-internal layout props num #t font-size thickness))
2253
2254 (define-builtin-markup-command (backslashed-digit layout props num)
2255   (integer?)
2256   other
2257   ((font-size 0)
2258    (thickness 1.6))
2259   "
2260 @cindex backslashed digits
2261
2262 A feta number, with backslash.  This is for use in the context of
2263 figured bass notation.
2264 @lilypond[verbatim,quote]
2265 \\markup {
2266   \\backslashed-digit #5
2267   \\hspace #2
2268   \\override #'(thickness . 3)
2269   \\backslashed-digit #7
2270 }
2271 @end lilypond"
2272   (slashed-digit-internal layout props num #f font-size thickness))
2273
2274 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2275 ;; the note command.
2276 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2277
2278 ;; TODO: better syntax.
2279
2280 (define-builtin-markup-command (note-by-number layout props log dot-count dir)
2281   (number? number? number?)
2282   music
2283   ((font-size 0)
2284    (style '()))
2285   "
2286 @cindex notes within text by log and dot-count
2287
2288 Construct a note symbol, with stem.  By using fractional values for
2289 @var{dir}, you can obtain longer or shorter stems.
2290
2291 @lilypond[verbatim,quote]
2292 \\markup {
2293   \\note-by-number #3 #0 #DOWN
2294   \\hspace #2
2295   \\note-by-number #1 #2 #0.8
2296 }
2297 @end lilypond"
2298   (define (get-glyph-name-candidates dir log style)
2299     (map (lambda (dir-name)
2300      (format "noteheads.~a~a~a" dir-name (min log 2)
2301              (if (and (symbol? style)
2302                       (not (equal? 'default style)))
2303                  (symbol->string style)
2304                  "")))
2305          (list (if (= dir UP) "u" "d")
2306                "s")))
2307
2308   (define (get-glyph-name font cands)
2309     (if (null? cands)
2310      ""
2311      (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
2312          (get-glyph-name font (cdr cands))
2313          (car cands))))
2314
2315   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props)))
2316          (size-factor (magstep font-size))
2317          (stem-length (*  size-factor (max 3 (- log 1))))
2318          (head-glyph-name (get-glyph-name font (get-glyph-name-candidates (sign dir) log style)))
2319          (head-glyph (ly:font-get-glyph font head-glyph-name))
2320          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
2321          (stem-thickness (* size-factor 0.13))
2322          (stemy (* dir stem-length))
2323          (attach-off (cons (interval-index
2324                             (ly:stencil-extent head-glyph X)
2325                             (* (sign dir) (car attach-indices)))
2326                            (* (sign dir)        ; fixme, this is inconsistent between X & Y.
2327                               (interval-index
2328                                (ly:stencil-extent head-glyph Y)
2329                                (cdr attach-indices)))))
2330          (stem-glyph (and (> log 0)
2331                           (ly:round-filled-box
2332                            (ordered-cons (car attach-off)
2333                                          (+ (car attach-off)  (* (- (sign dir)) stem-thickness)))
2334                            (cons (min stemy (cdr attach-off))
2335                                  (max stemy (cdr attach-off)))
2336                            (/ stem-thickness 3))))
2337
2338          (dot (ly:font-get-glyph font "dots.dot"))
2339          (dotwid (interval-length (ly:stencil-extent dot X)))
2340          (dots (and (> dot-count 0)
2341                     (apply ly:stencil-add
2342                            (map (lambda (x)
2343                                   (ly:stencil-translate-axis
2344                                    dot (* 2 x dotwid) X))
2345                                 (iota dot-count)))))
2346          (flaggl (and (> log 2)
2347                       (ly:stencil-translate
2348                        (ly:font-get-glyph font
2349                                           (string-append "flags."
2350                                                          (if (> dir 0) "u" "d")
2351                                                          (number->string log)))
2352                        (cons (+ (car attach-off) (if (< dir 0) stem-thickness 0)) stemy)))))
2353
2354     ; If there is a flag on an upstem and the stem is short, move the dots to avoid the flag.
2355     ; 16th notes get a special case because their flags hang lower than any other flags.
2356     (if (and dots (> dir 0) (> log 2) (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
2357         (set! dots (ly:stencil-translate-axis dots 0.5 X)))
2358     (if flaggl
2359         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
2360     (if (ly:stencil? stem-glyph)
2361         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
2362         (set! stem-glyph head-glyph))
2363     (if (ly:stencil? dots)
2364         (set! stem-glyph
2365               (ly:stencil-add
2366                (ly:stencil-translate-axis
2367                 dots
2368                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
2369                 X)
2370                stem-glyph)))
2371     stem-glyph))
2372
2373 (define-public log2
2374   (let ((divisor (log 2)))
2375     (lambda (z) (inexact->exact (/ (log z) divisor)))))
2376
2377 (define (parse-simple-duration duration-string)
2378   "Parse the `duration-string', e.g. ''4..'' or ''breve.'', and return a (log dots) list."
2379   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string)))
2380     (if (and match (string=? duration-string (match:substring match 0)))
2381         (let ((len  (match:substring match 1))
2382               (dots (match:substring match 2)))
2383           (list (cond ((string=? len "breve") -1)
2384                       ((string=? len "longa") -2)
2385                       ((string=? len "maxima") -3)
2386                       (else (log2 (string->number len))))
2387                 (if dots (string-length dots) 0)))
2388         (ly:error (_ "not a valid duration string: ~a") duration-string))))
2389
2390 (define-builtin-markup-command (note layout props duration dir)
2391   (string? number?)
2392   music
2393   (note-by-number-markup)
2394   "
2395 @cindex notes within text by string
2396
2397 This produces a note with a stem pointing in @var{dir} direction, with
2398 the @var{duration} for the note head type and augmentation dots.  For
2399 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
2400 a shortened down stem.
2401
2402 @lilypond[verbatim,quote]
2403 \\markup {
2404   \\override #'(style . cross) {
2405     \\note #\"4..\" #UP
2406   }
2407   \\hspace #2
2408   \\note #\"breve\" #0
2409 }
2410 @end lilypond"
2411   (let ((parsed (parse-simple-duration duration)))
2412     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
2413 \f
2414 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2415 ;; translating.
2416 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2417
2418 (define-builtin-markup-command (lower layout props amount arg)
2419   (number? markup?)
2420   align
2421   ()
2422   "
2423 @cindex lowering text
2424
2425 Lower @var{arg} by the distance @var{amount}.
2426 A negative @var{amount} indicates raising; see also @code{\\raise}."
2427   (ly:stencil-translate-axis (interpret-markup layout props arg)
2428                              (- amount) Y))
2429
2430 (define-builtin-markup-command (translate-scaled layout props offset arg)
2431   (number-pair? markup?)
2432   other
2433   ((font-size 0))
2434   "
2435 @cindex translating text
2436 @cindex scaling text
2437
2438 Translate @var{arg} by @var{offset}, scaling the offset by the
2439 @code{font-size}."
2440   (let* ((factor (magstep font-size))
2441          (scaled (cons (* factor (car offset))
2442                        (* factor (cdr offset)))))
2443     (ly:stencil-translate (interpret-markup layout props arg)
2444                           scaled)))
2445
2446 (define-builtin-markup-command (raise layout props amount arg)
2447   (number? markup?)
2448   align
2449   ()
2450   "
2451 @cindex raising text
2452
2453 Raise @var{arg} by the distance @var{amount}.
2454 A negative @var{amount} indicates lowering, see also @code{\\lower}.
2455
2456 The argument to @code{\\raise} is the vertical displacement amount,
2457 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
2458 raise objects in relation to their surrounding markups.
2459
2460 If the text object itself is positioned above or below the staff, then
2461 @code{\\raise} cannot be used to move it, since the mechanism that
2462 positions it next to the staff cancels any shift made with
2463 @code{\\raise}.  For vertical positioning, use the @code{padding}
2464 and/or @code{extra-offset} properties.
2465
2466 @lilypond[verbatim,quote]
2467 \\markup {
2468   C
2469   \\small
2470   \\bold
2471   \\raise #1.0
2472   9/7+
2473 }
2474 @end lilypond"
2475   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
2476
2477 (define-builtin-markup-command (fraction layout props arg1 arg2)
2478   (markup? markup?)
2479   other
2480   ((font-size 0))
2481   "
2482 @cindex creating text fractions
2483
2484 Make a fraction of two markups.
2485 @lilypond[verbatim,quote]
2486 \\markup {
2487   π ≈
2488   \\fraction 355 113
2489 }
2490 @end lilypond"
2491   (let* ((m1 (interpret-markup layout props arg1))
2492          (m2 (interpret-markup layout props arg2))
2493          (factor (magstep font-size))
2494          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
2495          (padding (* factor 0.2))
2496          (baseline (* factor 0.6))
2497          (offset (* factor 0.75)))
2498     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
2499     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
2500     (let* ((x1 (ly:stencil-extent m1 X))
2501            (x2 (ly:stencil-extent m2 X))
2502            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
2503            ;; should stack mols separately, to maintain LINE on baseline
2504            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
2505       (set! stack
2506             (ly:stencil-aligned-to stack Y CENTER))
2507       (set! stack
2508             (ly:stencil-aligned-to stack X LEFT))
2509       ;; should have EX dimension
2510       ;; empirical anyway
2511       (ly:stencil-translate-axis stack offset Y))))
2512
2513 (define-builtin-markup-command (normal-size-super layout props arg)
2514   (markup?)
2515   font
2516   ((baseline-skip))
2517   "
2518 @cindex setting superscript in standard font size
2519
2520 Set @var{arg} in superscript with a normal font size.
2521
2522 @lilypond[verbatim,quote]
2523 \\markup {
2524   default
2525   \\normal-size-super {
2526     superscript in standard size
2527   }
2528 }
2529 @end lilypond"
2530   (ly:stencil-translate-axis
2531    (interpret-markup layout props arg)
2532    (* 0.5 baseline-skip) Y))
2533
2534 (define-builtin-markup-command (super layout props arg)
2535   (markup?)
2536   font
2537   ((font-size 0)
2538    (baseline-skip))
2539   "
2540 @cindex superscript text
2541
2542 Raising and lowering texts can be done with @code{\\super} and
2543 @code{\\sub}:
2544
2545 @lilypond[verbatim,quote]
2546 \\markup {
2547   E =
2548   \\concat {
2549     mc
2550     \\super
2551     2
2552   }
2553 }
2554 @end lilypond"
2555   (ly:stencil-translate-axis
2556    (interpret-markup
2557     layout
2558     (cons `((font-size . ,(- font-size 3))) props)
2559     arg)
2560    (* 0.5 baseline-skip)
2561    Y))
2562
2563 (define-builtin-markup-command (translate layout props offset arg)
2564   (number-pair? markup?)
2565   align
2566   ()
2567   "
2568 @cindex translating text
2569
2570 This translates an object.  Its first argument is a cons of numbers.
2571
2572 @example
2573 A \\translate #(cons 2 -3) @{ B C @} D
2574 @end example
2575
2576 This moves @q{B C} 2@tie{}spaces to the right, and 3 down, relative to its
2577 surroundings.  This command cannot be used to move isolated scripts
2578 vertically, for the same reason that @code{\\raise} cannot be used for
2579 that."
2580   (ly:stencil-translate (interpret-markup  layout props arg)
2581                         offset))
2582
2583 (define-builtin-markup-command (sub layout props arg)
2584   (markup?)
2585   font
2586   ((font-size 0)
2587    (baseline-skip))
2588   "
2589 @cindex subscript text
2590
2591 Set @var{arg} in subscript.
2592
2593 @lilypond[verbatim,quote]
2594 \\markup {
2595   \\concat {
2596     H
2597     \\sub {
2598       2
2599     }
2600     O
2601   }
2602 }
2603 @end lilypond"
2604   (ly:stencil-translate-axis
2605    (interpret-markup
2606     layout
2607     (cons `((font-size . ,(- font-size 3))) props)
2608     arg)
2609    (* -0.5 baseline-skip)
2610    Y))
2611
2612 (define-builtin-markup-command (normal-size-sub layout props arg)
2613   (markup?)
2614   font
2615   ((baseline-skip))
2616   "
2617 @cindex setting subscript in standard font size
2618
2619 Set @var{arg} in subscript, in a normal font size.
2620
2621 @lilypond[verbatim,quote]
2622 \\markup {
2623   default
2624   \\normal-size-sub {
2625     subscript in standard size
2626   }
2627 }
2628 @end lilypond"
2629   (ly:stencil-translate-axis
2630    (interpret-markup layout props arg)
2631    (* -0.5 baseline-skip)
2632    Y))
2633 \f
2634 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2635 ;; brackets.
2636 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2637
2638 (define-builtin-markup-command (hbracket layout props arg)
2639   (markup?)
2640   graphic
2641   ()
2642   "
2643 @cindex placing horizontal brackets around text
2644
2645 Draw horizontal brackets around @var{arg}.
2646
2647 @lilypond[verbatim,quote]
2648 \\markup {
2649   \\hbracket {
2650     \\line {
2651       one two three
2652     }
2653   }
2654 }
2655 @end lilypond"
2656   (let ((th 0.1) ;; todo: take from GROB.
2657         (m (interpret-markup layout props arg)))
2658     (bracketify-stencil m X th (* 2.5 th) th)))
2659
2660 (define-builtin-markup-command (bracket layout props arg)
2661   (markup?)
2662   graphic
2663   ()
2664   "
2665 @cindex placing vertical brackets around text
2666
2667 Draw vertical brackets around @var{arg}.
2668
2669 @lilypond[verbatim,quote]
2670 \\markup {
2671   \\bracket {
2672     \\note #\"2.\" #UP
2673   }
2674 }
2675 @end lilypond"
2676   (let ((th 0.1) ;; todo: take from GROB.
2677         (m (interpret-markup layout props arg)))
2678     (bracketify-stencil m Y th (* 2.5 th) th)))
2679 \f
2680 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2681 ;; Delayed markup evaluation
2682 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2683
2684 (define-builtin-markup-command (page-ref layout props label gauge default)
2685   (symbol? markup? markup?)
2686   other
2687   ()
2688   "
2689 @cindex referencing page numbers in text
2690
2691 Reference to a page number. @var{label} is the label set on the referenced
2692 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
2693 the maximum width of the page number, and @var{default} the value to display
2694 when @var{label} is not found."
2695   (let* ((gauge-stencil (interpret-markup layout props gauge))
2696          (x-ext (ly:stencil-extent gauge-stencil X))
2697          (y-ext (ly:stencil-extent gauge-stencil Y)))
2698     (ly:make-stencil
2699      `(delay-stencil-evaluation
2700        ,(delay (ly:stencil-expr
2701                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
2702                        (label-page (and (list? table) (assoc label table)))
2703                        (page-number (and label-page (cdr label-page)))
2704                        (page-markup (if page-number (format "~a" page-number) default))
2705                        (page-stencil (interpret-markup layout props page-markup))
2706                        (gap (- (interval-length x-ext)
2707                                (interval-length (ly:stencil-extent page-stencil X)))))
2708                   (interpret-markup layout props
2709                                     (markup #:concat (#:hspace gap page-markup)))))))
2710      x-ext
2711      y-ext)))
2712 \f
2713 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2714 ;; Markup list commands
2715 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2716
2717 (define-public (space-lines baseline stils)
2718   (let space-stil ((prev-stil #f)
2719                    (stils stils)
2720                    (result (list)))
2721     (cond ((null? stils)
2722            (reverse! result))
2723           ((not prev-stil)
2724            (space-stil (car stils) (cdr stils) (list (car stils))))
2725           (else
2726            (let* ((stil (car stils))
2727                   (dy (max (- baseline
2728                               (+ (- (interval-bound (ly:stencil-extent prev-stil Y) DOWN))
2729                                  (interval-bound (ly:stencil-extent stil Y) UP)))
2730                            0.0))
2731                   (new-stil (ly:make-stencil
2732                              (ly:stencil-expr stil)
2733                              (ly:stencil-extent stil X)
2734                              (cons (interval-bound (ly:stencil-extent stil Y) DOWN)
2735                                    (+ (interval-bound (ly:stencil-extent stil Y) UP) dy)))))
2736              (space-stil stil (cdr stils) (cons new-stil result)))))))
2737
2738 (define-builtin-markup-list-command (justified-lines layout props args)
2739   (markup-list?)
2740   ((baseline-skip)
2741    wordwrap-internal-markup-list)
2742   "
2743 @cindex justifying lines of text
2744
2745 Like @code{\\justify}, but return a list of lines instead of a single markup.
2746 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
2747 @var{X}@tie{}is the number of staff spaces."
2748   (space-lines baseline-skip
2749                (interpret-markup-list layout props
2750                                       (make-wordwrap-internal-markup-list #t args))))
2751
2752 (define-builtin-markup-list-command (wordwrap-lines layout props args)
2753   (markup-list?)
2754   ((baseline-skip)
2755    wordwrap-internal-markup-list)
2756   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
2757 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
2758 where @var{X} is the number of staff spaces."
2759   (space-lines baseline-skip
2760                (interpret-markup-list layout props
2761                                       (make-wordwrap-internal-markup-list #f args))))
2762
2763 (define-builtin-markup-list-command (column-lines layout props args)
2764   (markup-list?)
2765   ((baseline-skip))
2766   "Like @code{\\column}, but return a list of lines instead of a single markup.
2767 @code{baseline-skip} determines the space between each markup in @var{args}."
2768   (space-lines (chain-assoc-get 'baseline-skip props)
2769                (interpret-markup-list layout props args)))
2770
2771 (define-builtin-markup-list-command (override-lines layout props new-prop args)
2772   (pair? markup-list?)
2773   ()
2774   "Like @code{\\override}, for markup lists."
2775   (interpret-markup-list layout (cons (list new-prop) props) args))