scm/define-markup-commands.scm

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