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--2005  Han-Wen Nienhuys <hanwen@cs.uu.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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24 ;; geometric shapes
  25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26
  27 (def-markup-command (draw-circle layout props radius thickness fill)
  28   (number? number? boolean?)
  29   "A circle of radius @var{radius}, thickness @var{thickness} and
  30 optionally filled."
  31   (make-circle-stencil radius thickness fill))
  32
  33 (def-markup-command (triangle layout props filled) (boolean?)
  34   "A triangle, filled or not"
  35   (let*
  36       ((th (chain-assoc-get 'thickness props  0.1))
  37        (size (chain-assoc-get 'font-size props 0))
  38        (ex (* (magstep size)
  39               0.8
  40               (chain-assoc-get 'baseline-skip props 2))))
  41
  42     (ly:make-stencil
  43      `(polygon '(0.0 0.0
  44                      ,ex 0.0
  45                      ,(* 0.5 ex)
  46                      ,(* 0.86 ex))
  47            ,th
  48            ,filled)
  49
  50      (cons 0 ex)
  51      (cons 0 (* .86 ex))
  52      )))
  53
  54 (def-markup-command (circle layout props arg) (markup?)
  55   "Draw a circle around @var{arg}.  Use @code{thickness},
  56 @code{circle-padding} and @code{font-size} properties to determine line
  57 thickness and padding around the markup."
  58   (let* ((th (chain-assoc-get 'thickness props  0.1))
  59          (size (chain-assoc-get 'font-size props 0))
  60          (pad
  61           (* (magstep size)
  62              (chain-assoc-get 'circle-padding props 0.2)))
  63          (m (interpret-markup layout props arg)))
  64     (circle-stencil m th pad)))
  65
  66 (def-markup-command (with-url layout props url arg) (string? markup?)
  67   "Add a link to URL @var{url} around @var{arg}. This only works in
  68 the PDF backend."
  69   (let* ((stil (interpret-markup layout props arg))
  70          (xextent (ly:stencil-extent stil X))
  71          (yextent (ly:stencil-extent stil Y))
  72          (old-expr (ly:stencil-expr stil))
  73          (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
  74     (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
  75
  76
  77 (def-markup-command (beam layout props width slope thickness)
  78   (number? number? number?)
  79   "Create a beam with the specified parameters."
  80   (let* ((y (* slope width))
  81          (yext (cons (min 0 y) (max 0 y)))
  82          (half (/ thickness 2)))
  83
  84     (ly:make-stencil
  85      `(polygon ',(list
  86                   0 (/ thickness -2)
  87                     width (+ (* width slope)  (/ thickness -2))
  88                     width (+ (* width slope)  (/ thickness 2))
  89                     0 (/ thickness 2))
  90                ,(ly:output-def-lookup layout 'blotdiameter)
  91                #t)
  92      (cons 0 width)
  93      (cons (+ (- half) (car yext))
  94            (+ half (cdr yext))))))
  95
  96 (def-markup-command (box layout props arg) (markup?)
  97   "Draw a box round @var{arg}.  Looks at @code{thickness},
  98 @code{box-padding} and @code{font-size} properties to determine line
  99 thickness and padding around the markup."
 100   (let* ((th (chain-assoc-get 'thickness props  0.1))
 101          (size (chain-assoc-get 'font-size props 0))
 102          (pad (* (magstep size)
 103                  (chain-assoc-get 'box-padding props 0.2)))
 104          (m (interpret-markup layout props arg)))
 105     (box-stencil m th pad)))
 106
 107 (def-markup-command (filled-box layout props xext yext blot)
 108   (number-pair? number-pair? number?)
 109   "Draw a box with rounded corners of dimensions @var{xext} and @var{yext}."
 110   (ly:round-filled-box
 111    xext yext blot))
 112
 113 (def-markup-command (whiteout layout props arg) (markup?)
 114   "Provide a white underground for @var{arg}"
 115   (let* ((stil (interpret-markup layout props
 116                                  (make-with-color-markup black arg)))
 117          (white
 118           (interpret-markup layout props
 119                             (make-with-color-markup
 120                              white
 121                              (make-filled-box-markup
 122                               (ly:stencil-extent stil X)
 123                               (ly:stencil-extent stil Y)
 124                               0.0)))))
 125
 126     (ly:stencil-add white stil)))
 127
 128 (def-markup-command (pad-markup layout props padding arg) (number? markup?)
 129   "Add space around a markup object."
 130
 131   (let*
 132       ((stil (interpret-markup layout props arg))
 133        (xext (ly:stencil-extent stil X))
 134        (yext (ly:stencil-extent stil Y)))
 135
 136     (ly:make-stencil
 137      (ly:stencil-expr stil)
 138      (interval-widen xext padding)
 139      (interval-widen yext padding))))
 140
 141 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 142 ;; space
 143 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 144
 145 ;;FIXME: is this working?
 146 (def-markup-command (strut layout props) ()
 147   "Create a box of the same height as the space in the current font."
 148   (let ((m (Text_interface::interpret_markup layout props " ")))
 149     (ly:make-stencil (ly:stencil-expr m)
 150                      (ly:stencil-extent m X)
 151                      '(1000 . -1000))))
 152
 153
 154 ;; todo: fix negative space
 155 (def-markup-command (hspace layout props amount) (number?)
 156   "This produces a invisible object taking horizontal space.
 157 @example
 158 \\markup @{ A \\hspace #2.0 B @}
 159 @end example
 160 will put extra space between A and B, on top of the space that is
 161 normally inserted before elements on a line.
 162 "
 163   (if (> amount 0)
 164       (ly:make-stencil "" (cons 0 amount) '(-1 . 1))
 165       (ly:make-stencil "" (cons amount amount) '(-1 . 1))))
 166
 167
 168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 169 ;; importing graphics.
 170 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 171
 172 (def-markup-command (stencil layout props stil) (ly:stencil?)
 173   "Stencil as markup"
 174   stil)
 175
 176 (define bbox-regexp
 177   (make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
 178
 179 (define (get-postscript-bbox string)
 180   "Extract the bbox from STRING, or return #f if not present."
 181   (let*
 182       ((match (regexp-exec bbox-regexp string)))
 183
 184     (if match
 185         (map (lambda (x)
 186                (string->number (match:substring match x)))
 187              (cdr (iota 5)))
 188
 189         #f)))
 190
 191 (def-markup-command (epsfile layout props file-name) (string?)
 192   "Inline an EPS image. The image is scaled such that 10 PS units is
 193 one staff-space."
 194
 195   (if (ly:get-option 'safe)
 196       (interpret-markup layout props "not allowed in safe")
 197       (let*
 198           ((contents (ly:gulp-file file-name))
 199            (bbox (get-postscript-bbox contents))
 200            (scaled-bbox
 201             (if bbox
 202                 (map (lambda (x) (/ x 10)) bbox)
 203                 (begin
 204                   (ly:warning (_ "can't find bounding box of `~a'")
 205                            file-name)
 206                   '()))))
 207
 208
 209         (if bbox
 210
 211             (ly:make-stencil
 212              (list
 213               'embedded-ps
 214               (string-append
 215
 216                ; adobe 5002.
 217                "BeginEPSF "
 218                "0.1 0.1 scale "
 219                (format "\n%%BeginDocument: ~a\n" file-name)
 220                contents
 221                "%%EndDocument\n"
 222                "EndEPSF\n"
 223                ))
 224              (cons (list-ref scaled-bbox 0) (list-ref scaled-bbox 2))
 225              (cons (list-ref scaled-bbox 1) (list-ref scaled-bbox 3)))
 226
 227             (ly:make-stencil "" '(0 . 0) '(0 . 0))))))
 228
 229
 230 (def-markup-command (postscript layout props str) (string?)
 231   "This inserts @var{str} directly into the output as a PostScript
 232 command string.  Due to technicalities of the output backends,
 233 different scales should be used for the @TeX{} and PostScript backend,
 234 selected with @code{-f}.
 235
 236
 237 For the TeX backend, the following string prints a rotated text
 238
 239 @cindex rotated text
 240
 241 @verbatim
 242 0 0 moveto /ecrm10 findfont
 243 1.75 scalefont setfont 90 rotate (hello) show
 244 @end verbatim
 245
 246 @noindent
 247 The magical constant 1.75 scales from LilyPond units (staff spaces) to
 248 TeX dimensions.
 249
 250 For the postscript backend, use the following
 251
 252 @verbatim
 253 gsave /ecrm10 findfont
 254  10.0 output-scale div
 255  scalefont setfont 90 rotate (hello) show grestore
 256 @end verbatim
 257 "
 258   ;; FIXME
 259   (ly:make-stencil
 260    (list 'embedded-ps str)
 261    '(0 . 0) '(0 . 0)))
 262
 263
 264 (def-markup-command (score layout props score) (ly:score?)
 265   "Inline an image of music."
 266   (let* ((output (ly:score-embedded-format score layout)))
 267
 268     (if (ly:music-output? output)
 269         (ly:paper-system-stencil
 270          (vector-ref (ly:paper-score-paper-systems output) 0))
 271         (begin
 272           (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
 273           empty-stencil))))
 274
 275 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 276 ;; basic formatting.
 277 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 278
 279 (def-markup-command (simple layout props str) (string?)
 280   "A simple text string; @code{\\markup @{ foo @}} is equivalent with
 281 @code{\\markup @{ \\simple #\"foo\" @}}."
 282   (interpret-markup layout props str))
 283
 284
 285 ;; TODO: use font recoding.
 286 ;;                    (make-line-markup
 287 ;;                     (map make-word-markup (string-tokenize str)))))
 288
 289 (define-public empty-markup
 290   (make-simple-markup ""))
 291
 292 ;; helper for justifying lines.
 293 (define (get-fill-space word-count line-width text-widths)
 294   "Calculate the necessary paddings between each two adjacent texts.
 295         The lengths of all texts are stored in @var{text-widths}.
 296         The normal formula for the padding between texts a and b is:
 297         padding = line-width/(word-count - 1) - (length(a) + length(b))/2
 298         The first and last padding have to be calculated specially using the
 299         whole length of the first or last text.
 300         Return a list of paddings.
 301 "
 302   (cond
 303    ((null? text-widths) '())
 304
 305    ;; special case first padding
 306    ((= (length text-widths) word-count)
 307     (cons
 308      (- (- (/ line-width (1- word-count)) (car text-widths))
 309         (/ (car (cdr text-widths)) 2))
 310      (get-fill-space word-count line-width (cdr text-widths))))
 311    ;; special case last padding
 312    ((= (length text-widths) 2)
 313     (list (- (/ line-width (1- word-count))
 314              (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
 315    (else
 316     (cons
 317      (- (/ line-width (1- word-count))
 318         (/ (+ (car text-widths) (car (cdr text-widths))) 2))
 319      (get-fill-space word-count line-width (cdr text-widths))))))
 320
 321 (def-markup-command (fill-line layout props markups)
 322   (markup-list?)
 323   "Put @var{markups} in a horizontal line of width @var{line-width}.
 324    The markups are spaced/flushed to fill the entire line.
 325    If there are no arguments, return an empty stencil."
 326
 327   (let* ((orig-stencils
 328           (map (lambda (x) (interpret-markup layout props x))
 329                markups))
 330          (stencils
 331           (map (lambda (stc)
 332                  (if (ly:stencil-empty? stc)
 333                      point-stencil
 334                      stc)) orig-stencils))
 335          (text-widths
 336           (map (lambda (stc)
 337                  (if (ly:stencil-empty? stc)
 338                      0.0
 339                      (interval-length (ly:stencil-extent stc X))))
 340                stencils))
 341          (text-width (apply + text-widths))
 342          (word-count (length stencils))
 343          (word-space (chain-assoc-get 'word-space props))
 344          (line-width (chain-assoc-get 'linewidth props))
 345          (fill-space
 346                 (cond
 347                         ((= word-count 1)
 348                                 (list
 349                                         (/ (- line-width text-width) 2)
 350                                         (/ (- line-width text-width) 2)))
 351                         ((= word-count 2)
 352                                 (list
 353                                         (- line-width text-width)))
 354                         (else
 355                                 (get-fill-space word-count line-width text-widths))))
 356      (fill-space-normal
 357         (map (lambda (x)
 358                 (if (< x word-space)
 359                         word-space
 360                                 x))
 361                         fill-space))
 362
 363          (line-stencils (if (= word-count 1)
 364                             (list
 365                              point-stencil
 366                              (car stencils)
 367                              point-stencil)
 368                             stencils)))
 369
 370     (if (null? (remove ly:stencil-empty? orig-stencils))
 371         empty-stencil
 372         (stack-stencils-padding-list X RIGHT fill-space-normal line-stencils))))
 373
 374 (def-markup-command (line layout props args) (markup-list?)
 375   "Put @var{args} in a horizontal line.  The property @code{word-space}
 376 determines the space between each markup in @var{args}."
 377   (let*
 378       ((stencils (map (lambda (m) (interpret-markup layout props m)) args))
 379        (space    (chain-assoc-get 'word-space props)))
 380
 381   (stack-stencil-line
 382    space
 383    (remove ly:stencil-empty? stencils))))
 384
 385
 386 (define (wordwrap-stencils stencils
 387                            justify base-space line-width)
 388
 389   "Perform simple wordwrap, return stencil of each line."
 390
 391   (define space (if justify
 392
 393                     ;; justify only stretches lines.
 394                     (* 0.7 base-space)
 395                     base-space))
 396
 397   (define (take-list width space stencils
 398                      accumulator accumulated-width)
 399     "Return (head-list . tail) pair, with head-list fitting into width"
 400     (if (null? stencils)
 401         (cons accumulator stencils)
 402         (let*
 403             ((first (car stencils))
 404              (first-wid (cdr (ly:stencil-extent (car stencils) X)))
 405              (newwid (+ space first-wid accumulated-width))
 406              )
 407
 408           (if
 409            (or (null? accumulator)
 410                (< newwid width))
 411
 412            (take-list width space
 413                       (cdr stencils)
 414                       (cons first accumulator)
 415                       newwid)
 416              (cons accumulator stencils))
 417            )))
 418
 419     (let loop
 420         ((lines '())
 421          (todo stencils))
 422
 423       (let*
 424           ((line-break (take-list line-width space todo
 425                                  '() 0.0))
 426            (line-stencils (car line-break))
 427            (space-left (- line-width (apply + (map (lambda (x) (cdr (ly:stencil-extent x X)))
 428                                               line-stencils))))
 429
 430            (line-word-space (cond
 431                              ((not justify) space)
 432
 433                              ;; don't stretch last line of paragraph.
 434                              ;; hmmm . bug - will overstretch the last line in some case.
 435                              ((null? (cdr line-break))
 436                               base-space)
 437                              ((null? line-stencils) 0.0)
 438                              ((null? (cdr line-stencils)) 0.0)
 439                              (else (/ space-left (1- (length line-stencils))))))
 440
 441            (line (stack-stencil-line
 442                   line-word-space
 443                   (reverse line-stencils))))
 444
 445         (if (pair? (cdr line-break))
 446             (loop (cons line lines)
 447                   (cdr line-break))
 448
 449             (reverse (cons line lines))
 450             ))
 451
 452       ))
 453
 454
 455 (define (wordwrap-markups layout props args justify)
 456   (let*
 457       ((baseline-skip (chain-assoc-get 'baseline-skip props))
 458        (line-width (chain-assoc-get 'linewidth props))
 459        (word-space (chain-assoc-get 'word-space props))
 460        (lines (wordwrap-stencils
 461                (remove ly:stencil-empty?
 462                        (map (lambda (m) (interpret-markup layout props m)) args))
 463                justify word-space  line-width)
 464                ))
 465
 466     (stack-lines DOWN 0.0 baseline-skip lines)))
 467
 468 (def-markup-command (justify layout props args) (markup-list?)
 469   "Like wordwrap, but with lines stretched to justify the margins.
 470 Use @code{\\override #'(linewidth . X)} to set linewidth, where X
 471 is the number of staff spaces."
 472
 473   (wordwrap-markups layout props args #t))
 474
 475 (def-markup-command (wordwrap layout props args) (markup-list?)
 476   "Simple wordwrap.  Use @code{\\override #'(linewidth . X)} to set
 477 linewidth, where X is the number of staff spaces."
 478
 479   (wordwrap-markups layout props args #f))
 480
 481 (define (wordwrap-string layout props justify arg)
 482   (let*
 483       ((baseline-skip (chain-assoc-get 'baseline-skip props))
 484        (line-width (chain-assoc-get 'linewidth props))
 485        (word-space (chain-assoc-get 'word-space props))
 486        (para-strings (regexp-split arg "\n[ \t\n]*\n[ \t\n]*"))
 487
 488        (list-para-words (map (lambda (str)
 489                                (regexp-split str "[ \t\n]+"))
 490                              para-strings))
 491        (para-lines (map (lambda (words)
 492                           (let*
 493                               ((stencils
 494                                 (remove
 495                                  ly:stencil-empty? (map
 496                                       (lambda (x)
 497                                         (interpret-markup layout props x))
 498                                       words)))
 499                                (lines (wordwrap-stencils stencils
 500                                                          justify word-space line-width)))
 501
 502                             lines))
 503
 504                         list-para-words)))
 505
 506     (stack-lines DOWN 0.0 baseline-skip (apply append para-lines))))
 507
 508
 509 (def-markup-command (wordwrap-string layout props arg) (string?)
 510   "Wordwrap a string. Paragraphs may be separated with double newlines"
 511   (wordwrap-string layout props  #f arg))
 512
 513 (def-markup-command (justify-string layout props arg) (string?)
 514   "Justify a string. Paragraphs may be separated with double newlines"
 515   (wordwrap-string layout props #t arg))
 516
 517
 518 (def-markup-command (wordwrap-field layout props symbol) (symbol?)
 519    (let* ((m (chain-assoc-get symbol props)))
 520      (if (string? m)
 521       (interpret-markup layout props
 522        (list wordwrap-string-markup m))
 523       (ly:make-stencil '()  '(1 . -1) '(1 . -1)))))
 524
 525 (def-markup-command (justify-field layout props symbol) (symbol?)
 526    (let* ((m (chain-assoc-get symbol props)))
 527      (if (string? m)
 528       (interpret-markup layout props
 529        (list justify-string-markup m))
 530       (ly:make-stencil '()  '(1 . -1) '(1 . -1)))))
 531
 532
 533
 534 (def-markup-command (combine layout props m1 m2) (markup? markup?)
 535   "Print two markups on top of each other."
 536   (let* ((s1 (interpret-markup layout props m1))
 537          (s2 (interpret-markup layout props m2)))
 538     (ly:stencil-add s1 s2)))
 539
 540 ;;
 541 ;; TODO: should extract baseline-skip from each argument somehow..
 542 ;;
 543 (def-markup-command (column layout props args) (markup-list?)
 544   "Stack the markups in @var{args} vertically.  The property
 545 @code{baseline-skip} determines the space between each markup in @var{args}."
 546   (stack-lines
 547    -1 0.0 (chain-assoc-get 'baseline-skip props)
 548    (remove ly:stencil-empty?
 549            (map (lambda (m) (interpret-markup layout props m)) args))))
 550
 551 (def-markup-command (dir-column layout props args) (markup-list?)
 552   "Make a column of args, going up or down, depending on the setting
 553 of the @code{#'direction} layout property."
 554   (let* ((dir (chain-assoc-get 'direction props)))
 555     (stack-lines
 556      (if (number? dir) dir -1)
 557      0.0
 558      (chain-assoc-get 'baseline-skip props)
 559      (map (lambda (x) (interpret-markup layout props x)) args))))
 560
 561 (def-markup-command (center-align layout props args) (markup-list?)
 562   "Put @code{args} in a centered column. "
 563   (let* ((mols (map (lambda (x) (interpret-markup layout props x)) args))
 564          (cmols (map (lambda (x) (ly:stencil-aligned-to x X CENTER)) mols)))
 565     (stack-lines -1 0.0 (chain-assoc-get 'baseline-skip props) cmols)))
 566
 567 (def-markup-command (vcenter layout props arg) (markup?)
 568   "Align @code{arg} to its Y center. "
 569   (let* ((mol (interpret-markup layout props arg)))
 570     (ly:stencil-aligned-to mol Y CENTER)))
 571
 572 (def-markup-command (hcenter layout props arg) (markup?)
 573   "Align @code{arg} to its X center. "
 574   (let* ((mol (interpret-markup layout props arg)))
 575     (ly:stencil-aligned-to mol X CENTER)))
 576
 577 (def-markup-command (right-align layout props arg) (markup?)
 578   "Align @var{arg} on its right edge. "
 579   (let* ((m (interpret-markup layout props arg)))
 580     (ly:stencil-aligned-to m X RIGHT)))
 581
 582 (def-markup-command (left-align layout props arg) (markup?)
 583   "Align @var{arg} on its left edge. "
 584   (let* ((m (interpret-markup layout props arg)))
 585     (ly:stencil-aligned-to m X LEFT)))
 586
 587 (def-markup-command (general-align layout props axis dir arg)  (integer? number? markup?)
 588   "Align @var{arg} in @var{axis} direction to the @var{dir} side."
 589   (let* ((m (interpret-markup layout props arg)))
 590     (ly:stencil-aligned-to m axis dir)))
 591
 592 (def-markup-command (halign layout props dir arg) (number? markup?)
 593   "Set horizontal alignment. If @var{dir} is @code{-1}, then it is
 594 left-aligned, while @code{+1} is right. Values in between interpolate
 595 alignment accordingly."
 596   (let* ((m (interpret-markup layout props arg)))
 597     (ly:stencil-aligned-to m X dir)))
 598
 599
 600 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 601 ;; property
 602 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 603
 604 (def-markup-command (fromproperty layout props symbol) (symbol?)
 605   "Read the @var{symbol} from property settings, and produce a stencil
 606   from the markup contained within. If @var{symbol} is not defined, it
 607   returns an empty markup"
 608   (let* ((m (chain-assoc-get symbol props)))
 609     (if (markup? m)
 610         (interpret-markup layout props m)
 611         (ly:make-stencil '()  '(1 . -1) '(1 . -1)))))
 612
 613
 614 (def-markup-command (on-the-fly layout props procedure arg) (symbol? markup?)
 615   "Apply the @var{procedure} markup command to
 616 @var{arg}. @var{procedure} should take a single argument."
 617   (let* ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
 618     (set-object-property! anonymous-with-signature
 619                           'markup-signature
 620                           (list markup?))
 621     (interpret-markup layout props (list anonymous-with-signature arg))))
 622
 623
 624
 625 (def-markup-command (override layout props new-prop arg) (pair? markup?)
 626   "Add the first argument in to the property list.  Properties may be
 627 any sort of property supported by @internalsref{font-interface} and
 628 @internalsref{text-interface}, for example
 629
 630 @verbatim
 631 \\override #'(font-family . married) \"bla\"
 632 @end verbatim
 633
 634 "
 635   (interpret-markup layout (cons (list new-prop) props) arg))
 636
 637 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 638 ;; fonts.
 639 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 640
 641
 642 (def-markup-command (bigger layout props arg) (markup?)
 643   "Increase the font size relative to current setting"
 644   (interpret-markup layout props
 645    `(,fontsize-markup 1 ,arg)))
 646
 647 (def-markup-command (smaller layout props arg) (markup?)
 648   "Decrease the font size relative to current setting"
 649   (interpret-markup layout props
 650    `(,fontsize-markup -1 ,arg)))
 651
 652 (def-markup-command larger (markup?) bigger-markup)
 653
 654 (def-markup-command (finger layout props arg) (markup?)
 655   "Set the argument as small numbers."
 656   (interpret-markup layout
 657                     (cons '((font-size . -5) (font-encoding . fetaNumber)) props)
 658                     arg))
 659
 660
 661 (def-markup-command (fontsize layout props increment arg) (number? markup?)
 662   "Add @var{increment} to the font-size. Adjust baseline skip accordingly."
 663
 664   (let* ((fs (chain-assoc-get 'font-size props 0))
 665          (bs (chain-assoc-get 'baseline-skip props 2))
 666          (entries (list
 667                    (cons 'baseline-skip (* bs (magstep increment)))
 668                    (cons 'font-size (+ fs increment )))))
 669
 670     (interpret-markup layout (cons entries props) arg)))
 671
 672
 673
 674 ;; FIXME -> should convert to font-size.
 675 (def-markup-command (magnify layout props sz arg) (number? markup?)
 676   "Set the font magnification for the its argument. In the following
 677 example, the middle A will be 10% larger:
 678 @example
 679 A \\magnify #1.1 @{ A @} A
 680 @end example
 681
 682 Note: magnification only works if a font-name is explicitly selected.
 683 Use @code{\\fontsize} otherwise."
 684   (interpret-markup
 685    layout
 686    (prepend-alist-chain 'font-magnification sz props)
 687    arg))
 688
 689 (def-markup-command (bold layout props arg) (markup?)
 690   "Switch to bold font-series"
 691   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
 692
 693 (def-markup-command (sans layout props arg) (markup?)
 694   "Switch to the sans serif family"
 695   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
 696
 697 (def-markup-command (number layout props arg) (markup?)
 698   "Set font family to @code{number}, which yields the font used for
 699 time signatures and fingerings.  This font only contains numbers and
 700 some punctuation. It doesn't have any letters.  "
 701   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaNumber props) arg))
 702
 703 (def-markup-command (roman layout props arg) (markup?)
 704   "Set font family to @code{roman}."
 705   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
 706
 707 (def-markup-command (huge layout props arg) (markup?)
 708   "Set font size to +2."
 709   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
 710
 711 (def-markup-command (large layout props arg) (markup?)
 712   "Set font size to +1."
 713   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
 714
 715 (def-markup-command (normalsize layout props arg) (markup?)
 716   "Set font size to default."
 717   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
 718
 719 (def-markup-command (small layout props arg) (markup?)
 720   "Set font size to -1."
 721   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
 722
 723 (def-markup-command (tiny layout props arg) (markup?)
 724   "Set font size to -2."
 725   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
 726
 727 (def-markup-command (teeny layout props arg) (markup?)
 728   "Set font size to -3."
 729   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
 730
 731 (def-markup-command (caps layout props arg) (markup?)
 732   "Set @code{font-shape} to @code{caps}."
 733   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
 734
 735 (def-markup-command (dynamic layout props arg) (markup?)
 736   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
 737 @b{z}, @b{p}, and @b{r}.  When producing phrases, like ``pi@`{u} @b{f}'', the
 738 normal words (like ``pi@`{u}'') should be done in a different font.  The
 739 recommend font for this is bold and italic"
 740   (interpret-markup
 741    layout (prepend-alist-chain 'font-encoding 'fetaDynamic props) arg))
 742
 743 (def-markup-command (text layout props arg) (markup?)
 744   "Use a text font instead of music symbol or music alphabet font."
 745
 746   ;; ugh - latin1
 747   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
 748                     arg))
 749
 750
 751 (def-markup-command (italic layout props arg) (markup?)
 752   "Use italic @code{font-shape} for @var{arg}. "
 753   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
 754
 755 (def-markup-command (typewriter layout props arg) (markup?)
 756   "Use @code{font-family} typewriter for @var{arg}."
 757   (interpret-markup
 758    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
 759
 760 (def-markup-command (upright layout props arg) (markup?)
 761   "Set font shape to @code{upright}.  This is the opposite of @code{italic}."
 762   (interpret-markup
 763    layout (prepend-alist-chain 'font-shape 'upright props) arg))
 764
 765 (def-markup-command (medium layout props arg) (markup?)
 766   "Switch to medium font-series (in contrast to bold)."
 767   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
 768                     arg))
 769
 770 (def-markup-command (normal-text layout props arg) (markup?)
 771   "Set all font related properties (except the size) to get the default normal text font, no matter what font was used earlier."
 772   ;; ugh - latin1
 773   (interpret-markup layout
 774                     (cons '((font-family . roman) (font-shape . upright)
 775                             (font-series . medium) (font-encoding . latin1))
 776                           props)
 777                     arg))
 778
 779 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 780 ;; symbols.
 781 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 782
 783 (def-markup-command (doublesharp layout props) ()
 784   "Draw a double sharp symbol."
 785
 786   (interpret-markup layout props (markup #:musicglyph "accidentals.4")))
 787
 788 (def-markup-command (sesquisharp layout props) ()
 789   "Draw a 3/2 sharp symbol."
 790   (interpret-markup layout props (markup #:musicglyph "accidentals.3")))
 791
 792 (def-markup-command (sharp layout props) ()
 793   "Draw a sharp symbol."
 794   (interpret-markup layout props (markup #:musicglyph "accidentals.2")))
 795
 796 (def-markup-command (semisharp layout props) ()
 797   "Draw a semi sharp symbol."
 798   (interpret-markup layout props (markup #:musicglyph "accidentals.1")))
 799
 800 (def-markup-command (natural layout props) ()
 801   "Draw a natural symbol."
 802   (interpret-markup layout props (markup #:musicglyph "accidentals.0")))
 803
 804 (def-markup-command (semiflat layout props) ()
 805   "Draw a semiflat."
 806   (interpret-markup layout props (markup #:musicglyph "accidentals.M1")))
 807
 808 (def-markup-command (flat layout props) ()
 809   "Draw a flat symbol."
 810   (interpret-markup layout props (markup #:musicglyph "accidentals.M2")))
 811
 812 (def-markup-command (sesquiflat layout props) ()
 813   "Draw a 3/2 flat symbol."
 814   (interpret-markup layout props (markup #:musicglyph "accidentals.M3")))
 815
 816 (def-markup-command (doubleflat layout props) ()
 817   "Draw a double flat symbol."
 818   (interpret-markup layout props (markup #:musicglyph "accidentals.M4")))
 819
 820 (def-markup-command (with-color layout props color arg) (color? markup?)
 821   "Draw @var{arg} in color specified by @var{color}"
 822
 823   (let* ((stil (interpret-markup layout props arg)))
 824
 825     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
 826                      (ly:stencil-extent stil X)
 827                      (ly:stencil-extent stil Y))))
 828
 829 \f
 830 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 831 ;; glyphs
 832 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 833
 834
 835 (def-markup-command (arrow-head layout props axis direction filled)
 836   (integer? ly:dir? boolean?)
 837   "produce an arrow head in specified direction and axis. Use the filled head if @var{filled} is  specified."
 838   (let*
 839       ((name (format "arrowheads.~a.~a~a"
 840                      (if filled
 841                          "close"
 842                          "open")
 843                      axis
 844                      direction)))
 845     (ly:font-get-glyph
 846      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
 847                                      props))
 848      name)))
 849
 850 (def-markup-command (musicglyph layout props glyph-name) (string?)
 851   "This is converted to a musical symbol, e.g. @code{\\musicglyph
 852 #\"accidentals.0\"} will select the natural sign from the music font.
 853 See @usermanref{The Feta font} for  a complete listing of the possible glyphs."
 854   (ly:font-get-glyph
 855    (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
 856                                    props))
 857    glyph-name))
 858
 859 (def-markup-command (lookup layout props glyph-name) (string?)
 860   "Lookup a glyph by name."
 861   (ly:font-get-glyph (ly:paper-get-font layout props)
 862                      glyph-name))
 863
 864 (def-markup-command (char layout props num) (integer?)
 865   "Produce a single character, e.g. @code{\\char #65} produces the
 866 letter 'A'."
 867   (ly:get-glyph (ly:paper-get-font layout props) num))
 868
 869
 870 (define number->mark-letter-vector (make-vector 25 #\A))
 871
 872 (do ((i 0 (1+ i))
 873      (j 0 (1+ j)))
 874     ((>= i 26))
 875   (if (= i (- (char->integer #\I) (char->integer #\A)))
 876       (set! i (1+ i)))
 877   (vector-set! number->mark-letter-vector j
 878                (integer->char (+ i (char->integer #\A)))))
 879
 880 (define number->mark-alphabet-vector (list->vector
 881   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
 882
 883 (define (number->markletter-string vec n)
 884   "Double letters for big marks."
 885   (let* ((lst (vector-length vec)))
 886
 887     (if (>= n lst)
 888         (string-append (number->markletter-string vec (1- (quotient n lst)))
 889                        (number->markletter-string vec (remainder n lst)))
 890         (make-string 1 (vector-ref vec n)))))
 891
 892 (def-markup-command (markletter layout props num) (integer?)
 893   "Make a markup letter for @var{num}.  The letters start with A to Z
 894  (skipping I), and continues with double letters."
 895   (Text_interface::interpret_markup layout props
 896     (number->markletter-string number->mark-letter-vector num)))
 897
 898 (def-markup-command (markalphabet layout props num) (integer?)
 899    "Make a markup letter for @var{num}.  The letters start with A to Z
 900  and continues with double letters."
 901    (Text_interface::interpret_markup layout props
 902      (number->markletter-string number->mark-alphabet-vector num)))
 903
 904 \f
 905 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 906 ;; the note command.
 907 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 908
 909
 910 ;; TODO: better syntax.
 911
 912 (def-markup-command (note-by-number layout props log dot-count dir) (number? number? number?)
 913   "Construct a note symbol, with stem.  By using fractional values for
 914 @var{dir}, you can obtain longer or shorter stems."
 915   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props)))
 916          (size (chain-assoc-get 'font-size props 0))
 917          (stem-length (* (magstep size) (max 3 (- log 1))))
 918          (head-glyph (ly:font-get-glyph
 919                       font
 920                       (string-append "noteheads.s" (number->string (min log 2)))))
 921          (stem-thickness 0.13)
 922          (stemy (* dir stem-length))
 923          (attachx (if (> dir 0)
 924                       (- (cdr (ly:stencil-extent head-glyph X)) stem-thickness)
 925                       0))
 926          (attachy (* dir 0.28))
 927          (stem-glyph (and (> log 0)
 928                           (ly:round-filled-box
 929                            (cons attachx (+ attachx  stem-thickness))
 930                            (cons (min stemy attachy)
 931                                  (max stemy attachy))
 932                            (/ stem-thickness 3))))
 933          (dot (ly:font-get-glyph font "dots.dot"))
 934          (dotwid (interval-length (ly:stencil-extent dot X)))
 935          (dots (and (> dot-count 0)
 936                     (apply ly:stencil-add
 937                            (map (lambda (x)
 938                                   (ly:stencil-translate-axis
 939                                    dot  (* (+ 1 (* 2 x)) dotwid) X))
 940                                 (iota dot-count 1)))))
 941          (flaggl (and (> log 2)
 942                       (ly:stencil-translate
 943                        (ly:font-get-glyph font
 944                                           (string-append "flags."
 945                                                          (if (> dir 0) "u" "d")
 946                                                          (number->string log)))
 947                        (cons (+ attachx (/ stem-thickness 2)) stemy)))))
 948     (if flaggl
 949         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
 950     (if (ly:stencil? stem-glyph)
 951         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
 952         (set! stem-glyph head-glyph))
 953     (if (ly:stencil? dots)
 954         (set! stem-glyph
 955               (ly:stencil-add
 956                (ly:stencil-translate-axis
 957                 dots
 958                 (+ (if (and (> dir 0) (> log 2))
 959                        (* 1.5 dotwid)
 960                        0)
 961                    ;; huh ? why not necessary?
 962                    ;;(cdr (ly:stencil-extent head-glyph X))
 963                    dotwid)
 964                 X)
 965                stem-glyph)))
 966     stem-glyph))
 967
 968 (define-public log2
 969   (let ((divisor (log 2)))
 970     (lambda (z) (inexact->exact (/ (log z) divisor)))))
 971
 972 (define (parse-simple-duration duration-string)
 973   "Parse the `duration-string', e.g. ''4..'' or ''breve.'', and return a (log dots) list."
 974   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string)))
 975     (if (and match (string=? duration-string (match:substring match 0)))
 976         (let ((len  (match:substring match 1))
 977               (dots (match:substring match 2)))
 978           (list (cond ((string=? len "breve") -1)
 979                       ((string=? len "longa") -2)
 980                       ((string=? len "maxima") -3)
 981                       (else (log2 (string->number len))))
 982                 (if dots (string-length dots) 0)))
 983         (ly:error (_ "not a valid duration string: ~a") duration-string))))
 984
 985 (def-markup-command (note layout props duration dir) (string? number?)
 986   "This produces a note with a stem pointing in @var{dir} direction, with
 987 the @var{duration} for the note head type and augmentation dots. For
 988 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
 989 a shortened down stem."
 990   (let ((parsed (parse-simple-duration duration)))
 991     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
 992
 993 \f
 994 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 995 ;; translating.
 996 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 997
 998 (def-markup-command (lower layout props amount arg) (number? markup?)
 999   "
1000 Lower @var{arg}, by the distance @var{amount}.
1001 A negative @var{amount} indicates raising, see also @code{\raise}.
1002 "
1003   (ly:stencil-translate-axis (interpret-markup layout props arg)
1004                              (- amount) Y))
1005
1006
1007 (def-markup-command (raise layout props amount arg) (number? markup?)
1008   "
1009 Raise @var{arg}, by the distance @var{amount}.
1010 A negative @var{amount} indicates lowering, see also @code{\\lower}.
1011 @c
1012 @lilypond[verbatim,fragment,relative=1]
1013  c1^\\markup { C \\small \\raise #1.0 \\bold { \"9/7+\" }}
1014 @end lilypond
1015 The argument to @code{\\raise} is the vertical displacement amount,
1016 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
1017 raise objects in relation to their surrounding markups.
1018
1019 If the text object itself is positioned above or below the staff, then
1020 @code{\\raise} cannot be used to move it, since the mechanism that
1021 positions it next to the staff cancels any shift made with
1022 @code{\\raise}. For vertical positioning, use the @code{padding}
1023 and/or @code{extra-offset} properties. "
1024   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
1025
1026 (def-markup-command (fraction layout props arg1 arg2) (markup? markup?)
1027   "Make a fraction of two markups."
1028   (let* ((m1 (interpret-markup layout props arg1))
1029          (m2 (interpret-markup layout props arg2)))
1030     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
1031     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
1032     (let* ((x1 (ly:stencil-extent m1 X))
1033            (x2 (ly:stencil-extent m2 X))
1034            (line (ly:round-filled-box (interval-union x1 x2) '(-0.05 . 0.05) 0.0))
1035            ;; should stack mols separately, to maintain LINE on baseline
1036            (stack (stack-lines -1 0.2 0.6 (list m1 line m2))))
1037       (set! stack
1038             (ly:stencil-aligned-to stack Y CENTER))
1039       (set! stack
1040             (ly:stencil-aligned-to stack X LEFT))
1041       ;; should have EX dimension
1042       ;; empirical anyway
1043       (ly:stencil-translate-axis stack 0.75 Y))))
1044
1045
1046
1047
1048
1049 (def-markup-command (normal-size-super layout props arg) (markup?)
1050   "Set @var{arg} in superscript with a normal font size."
1051   (ly:stencil-translate-axis
1052    (interpret-markup layout props arg)
1053    (* 0.5 (chain-assoc-get 'baseline-skip props)) Y))
1054
1055 (def-markup-command (super layout props arg) (markup?)
1056   "
1057 @cindex raising text
1058 @cindex lowering text
1059 @cindex moving text
1060 @cindex translating text
1061
1062 @cindex @code{\\super}
1063
1064
1065 Raising and lowering texts can be done with @code{\\super} and
1066 @code{\\sub}:
1067
1068 @lilypond[verbatim,fragment,relative=1]
1069  c1^\\markup { E \"=\" mc \\super \"2\" }
1070 @end lilypond
1071
1072 "
1073   (ly:stencil-translate-axis
1074    (interpret-markup
1075     layout
1076     (cons `((font-size . ,(- (chain-assoc-get 'font-size props 0) 3))) props)
1077     arg)
1078    (* 0.5 (chain-assoc-get 'baseline-skip props))
1079    Y))
1080
1081 (def-markup-command (translate layout props offset arg) (number-pair? markup?)
1082   "This translates an object. Its first argument is a cons of numbers
1083 @example
1084 A \\translate #(cons 2 -3) @{ B C @} D
1085 @end example
1086 This moves `B C' 2 spaces to the right, and 3 down, relative to its
1087 surroundings. This command cannot be used to move isolated scripts
1088 vertically, for the same reason that @code{\\raise} cannot be used for
1089 that.
1090
1091 "
1092   (ly:stencil-translate (interpret-markup  layout props arg)
1093                         offset))
1094
1095 (def-markup-command (sub layout props arg) (markup?)
1096   "Set @var{arg} in subscript."
1097   (ly:stencil-translate-axis
1098    (interpret-markup
1099     layout
1100     (cons `((font-size . ,(- (chain-assoc-get 'font-size props 0) 3))) props)
1101     arg)
1102    (* -0.5 (chain-assoc-get 'baseline-skip props))
1103    Y))
1104
1105 (def-markup-command (normal-size-sub layout props arg) (markup?)
1106   "Set @var{arg} in subscript, in a normal font size."
1107   (ly:stencil-translate-axis
1108    (interpret-markup layout props arg)
1109    (* -0.5 (chain-assoc-get 'baseline-skip props))
1110    Y))
1111 \f
1112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1113 ;; brackets.
1114 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1115
1116 (def-markup-command (hbracket layout props arg) (markup?)
1117   "Draw horizontal brackets around @var{arg}."
1118   (let ((th 0.1) ;; todo: take from GROB.
1119         (m (interpret-markup layout props arg)))
1120     (bracketify-stencil m X th (* 2.5 th) th)))
1121
1122 (def-markup-command (bracket layout props arg) (markup?)
1123   "Draw vertical brackets around @var{arg}."
1124   (let ((th 0.1) ;; todo: take from GROB.
1125         (m (interpret-markup layout props arg)))
1126     (bracketify-stencil m Y th (* 2.5 th) th)))
1127
1128 (def-markup-command (bracketed-y-column layout props indices args)
1129   (list? markup-list?)
1130   "Make a column of the markups in @var{args}, putting brackets around
1131 the elements marked in @var{indices}, which is a list of numbers."
1132   (define (sublist lst start stop)
1133     (take (drop lst start) (- (1+ stop) start)))
1134
1135   (define (stencil-list-extent ss axis)
1136     (cons
1137      (apply min (map (lambda (x) (car (ly:stencil-extent x axis))) ss))
1138      (apply max (map (lambda (x) (cdr (ly:stencil-extent x axis))) ss))))
1139
1140
1141   (define (stack-stencils-vertically stencils bskip last-stencil)
1142     (cond
1143      ((null? stencils) '())
1144      ((not (ly:stencil? last-stencil))
1145       (cons (car stencils)
1146             (stack-stencils-vertically (cdr stencils) bskip (car stencils))))
1147      (else
1148       (let* ((orig (car stencils))
1149              (dir (chain-assoc-get 'direction  props DOWN))
1150              (new (ly:stencil-moved-to-edge last-stencil Y dir
1151                                             orig
1152                                             0.1 bskip)))
1153
1154         (cons new (stack-stencils-vertically (cdr stencils) bskip new))))))
1155
1156   (define (make-brackets stencils indices acc)
1157     (if (and stencils
1158              (pair? indices)
1159              (pair? (cdr indices)))
1160         (let* ((encl (sublist stencils (car indices) (cadr indices)))
1161                (x-ext (stencil-list-extent encl X))
1162                (y-ext (stencil-list-extent encl Y))
1163                (thick 0.10)
1164                (pad 0.35)
1165                (protusion (* 2.5 thick))
1166                (lb
1167                 (ly:stencil-translate-axis
1168                  (ly:bracket Y y-ext thick protusion)
1169                  (- (car x-ext) pad) X))
1170                (rb (ly:stencil-translate-axis
1171                     (ly:bracket Y y-ext thick (- protusion))
1172                     (+ (cdr x-ext) pad) X)))
1173
1174           (make-brackets
1175            stencils (cddr indices)
1176            (append
1177             (list lb rb)
1178             acc)))
1179         acc))
1180
1181   (let* ((stencils
1182           (map (lambda (x)
1183                  (interpret-markup
1184                   layout
1185                   props
1186                   x)) args))
1187          (leading
1188           (chain-assoc-get 'baseline-skip props))
1189          (stacked (stack-stencils-vertically
1190                    (remove ly:stencil-empty? stencils) 1.25 #f))
1191          (brackets (make-brackets stacked indices '())))
1192
1193     (apply ly:stencil-add
1194            (append stacked brackets))))