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